GNU bug report logs - #18830
gnus-summary-line-format text face

Previous Next

Full log

Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):

From: Zhitao Gong <zzg0009 <at> auburn.edu>
To: The Gnus Bugfixing Girls + Boys <submit <at> debbugs.gnu.org>
Subject: gnus-summary-line-format text face
Date: Sat, 25 Oct 2014 08:44:05 -0500

I'm setting the date face according to how old the date is with the
following code:

--- code begins ---

(defun header-age-level (header)
  "Return the age of the header

The age are divided into three levels:
0: no more than one day old
1: no more than one week old
2: otherwise

Based on the age of the header, I set different foreground color
for the header string.
"
  (let* ((now (time-to-day-in-year (current-time)))
         (header-date-time
          (time-to-day-in-year (safe-date-to-time
                                (mail-header-date header))))
         (mail-age (- now header-date-time)))
    (cond
     ((< mail-age 1) 0)
     ((< mail-age 7) 1)
     (t 2))))

(defface my-date-one-day-old-face
  '((default (:foreground "#ADFF2F")))
  "...")
(defface my-date-one-week-old-face
  '((default (:foreground "#79B221")))
  "...")
(defface my-date-more-than-one-week-old-face
  '((default (:foreground "#456613")))
  "...")

(defun gnus-user-format-function-color-date (header)
  (let ((header-date-time-string
         (format-time-string
          "%Y-%m-%d %H:%M" (safe-date-to-time (mail-header-date header))))
        (age-level (header-age-level header)))
    (cond
      ((= 0 age-level)
       (propertize header-date-time-string
		   'face 'my-date-one-day-old-face
		   'gnus-face t
                   ))
      ((= 1 age-level)
       (propertize header-date-time-string
		   'face 'my-date-one-week-old-face
		   'gnus-face t))
      (t
       (propertize header-date-time-string
                   'face 'my-date-more-than-one-week-old-face
                   'gnus-face t)))))

(setq-default
 gnus-summary-line-format "%U%R%z %(%u&color-date;  %-30,30f  %B%s%)\n")
                                        ^---- this is my function

--- code ends ---

This works fine in Emacs24, however, when I upgrade to the new version,
emacs-25.x.x, I got the following error (please see the backtrace
information).

I've identified the source of this error

--- code begins ---

(defun gnus-put-text-property-excluding-characters-with-faces (beg end prop val)
  "The same as `put-text-property', except where `gnus-face' is set.
If so, and PROP is `face', set the second element of its value to VAL.
Otherwise, do nothing."
  (while (< beg end)
    ;; Property values are compared with `eq'.
    (let ((stop (next-single-property-change beg 'face nil end)))
      (if (get-text-property beg 'gnus-face)
	  (when (eq prop 'face)
	    (setcar (cdr (get-text-property beg 'face)) (or val  'default)))   ;; <- !!! THIS LINE !!!
	(inline
	  (gnus-put-text-property beg stop prop val)))
      (setq beg stop))))

--- code ends ---

The `(get-text-property beg 'face)` returns a face object, say,
`my-date-one-day-old-face`, which is NOT a list object, so `cdr` throws
the error "wrong-type-argument listp
my-date-more-than-one-week-old-face"

Hope this helps!

The backtrace:

Debugger entered--Lisp error: (wrong-type-argument listp my-date-more-than-one-week-old-face)
  gnus-put-text-property-excluding-characters-with-faces(1 55 face gnus-summary-normal-unread)
  gnus-summary-highlight-line()
  gnus-summary-insert-line([0 "" "" "05 Apr 2001 23:33:09 +0400" "" "" 0 0 "" nil] 0 nil t 90 t nil "" nil 1)
  gnus-update-summary-mark-positions()
  gnus-summary-mode("Tiger/INBOX")
  gnus-summary-setup-buffer("Tiger/INBOX")
  gnus-summary-read-group-1("Tiger/INBOX" t t nil nil nil)
  gnus-summary-read-group("Tiger/INBOX" t t nil nil nil nil)
  gnus-group-read-group(nil t)
  gnus-group-select-group(nil)
  funcall-interactively(gnus-group-select-group nil)
  call-interactively(gnus-group-select-group nil nil)
  command-execute(gnus-group-select-group)

Gnus v5.13
GNU Emacs 25.0.50.1 (x86_64-pc-linux-gnu, GTK+ Version 3.12.2)
 of 2014-10-24 on lgw01-26

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.