Remove gnus-group-highlight-line from the default hook list

Signed-off-by: Julien Danjou <julien@danjou.info>

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 1be226b..f7ea76e 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -9,6 +9,16 @@
        * time-date.el (date-to-time): Try using parse-time-string first before
        using the slower timezone-make-date-arpa-standard.
 
+2010-09-22  Julien Danjou  <julien@danjou.info>
+
+       * gnus-group.el (gnus-group-insert-group-line): Call
+       gnus-group-highlight-line.
+       (gnus-group-update-hook): Remove gnus-group-highlight-line from the
+       default hook list.
+       (gnus-group-update-eval-form): Add new function.
+       (gnus-group-highlight-line): Use gnus-group-update-eval-form.
+       (gnus-group-get-icon): Use gnus-group-update-eval-form.
+
 2010-09-22  Lars Magne Ingebrigtsen  <larsi@gnus.org>
 
        * nnimap.el (nnimap-request-expire-articles): If nnmail-expiry-wait is

diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el
index 7ce9a7b..5e261cc 100644 (file)
--- a/lisp/gnus-group.el
+++ b/lisp/gnus-group.el
@@ -292,12 +292,8 @@ If you want to modify the group buffer, you can use this hook."
   :group 'gnus-exit
   :type 'hook)
 
-(defcustom gnus-group-update-hook '(gnus-group-highlight-line)
-  "Hook called when a group line is changed.
-The hook will not be called if `gnus-visual' is nil.
-
-The default function `gnus-group-highlight-line' will highlight
-the line according to the `gnus-group-highlight' variable."
+(defcustom gnus-group-update-hook nil
+  "Hook called when a group line is changed."
   :group 'gnus-group-visual
   :type 'hook)
 
@@ -1623,95 +1619,82 @@ if it is a string, only list groups matching REGEXP."
                              'gnus-tool-bar-update))
     (forward-line -1)
     (when (inline (gnus-visual-p 'group-highlight 'highlight))
-      (gnus-run-hooks 'gnus-group-update-hook))
+      (gnus-group-highlight-line gnus-tmp-qualified-group beg end))
+    (gnus-run-hooks 'gnus-group-update-hook)
     (forward-line)
     ;; Allow XEmacs to remove front-sticky text properties.
     (gnus-group-remove-excess-properties)))
 
-(defun gnus-group-highlight-line ()
-  "Highlight the current line according to `gnus-group-highlight'."
-  (let* ((list gnus-group-highlight)
-        (p (point))
-        (end (point-at-eol))
-        ;; now find out where the line starts and leave point there.
-        (beg (progn (beginning-of-line) (point)))
-        (group (gnus-group-group-name))
-        (entry (gnus-group-entry group))
-        (unread (if (numberp (car entry)) (car entry) 0))
-        (active (gnus-active group))
-        (total (if active (1+ (- (cdr active) (car active))) 0))
-        (info (nth 2 entry))
-        (method (inline (gnus-server-get-method group (gnus-info-method info))))
-        (marked (gnus-info-marks info))
-        (mailp (apply 'append
-                      (mapcar
-                       (lambda (x)
-                         (memq x (assoc (symbol-name
-                                         (car (or method gnus-select-method)))
-                                        gnus-valid-select-methods)))
-                       '(mail post-mail))))
-        (level (or (gnus-info-level info) gnus-level-killed))
-        (score (or (gnus-info-score info) 0))
-        (ticked (gnus-range-length (cdr (assq 'tick marked))))
-        (group-age (gnus-group-timestamp-delta group))
-        (inhibit-read-only t))
-    ;; FIXME: http://thread.gmane.org/gmane.emacs.gnus.general/65451/focus=65465
-    ;; ======================================================================
-    ;; From: Richard Stallman
-    ;; Subject: Re: Rewriting gnus-group-highlight-line (was: [...])
-    ;; Cc: ding@gnus.org
-    ;; Date: Sat, 27 Oct 2007 19:41:20 -0400
-    ;; Message-ID: <E1IlvHM-0006TS-7t@fencepost.gnu.org>
-    ;;
-    ;; [...]
-    ;; The kludge is that the alist elements contain expressions that refer
-    ;; to local variables with short names.  Perhaps write your own tiny
-    ;; evaluator that handles just `and', `or', and numeric comparisons
-    ;; and just a few specific variables.
-    ;; ======================================================================
-    ;;
-    ;; Similar for other evaluated variables.  Grep for risky-local-variable
-    ;; to find them!  -- rsteib
-    ;;
-    ;; Eval the cars of the lists until we find a match.
-    (while (and list
-               (not (eval (caar list))))
-      (setq list (cdr list)))
-    (let ((face (cdar list)))
-      (unless (eq face (get-text-property beg 'face))
-       (gnus-put-text-property-excluding-characters-with-faces
-        beg end 'face
-        (setq face (if (boundp face) (symbol-value face) face)))
-       (gnus-extent-start-open beg)))
-    (goto-char p)))
+(defun gnus-group-update-eval-form (group list)
+  "Eval `car' of each element of LIST, and return the first that return t.
+Some value are bound so the form can use them."
+  (when list
+    (let* ((entry (gnus-group-entry group))
+           (unread (if (numberp (car entry)) (car entry) 0))
+           (active (gnus-active group))
+           (total (if active (1+ (- (cdr active) (car active))) 0))
+           (info (nth 2 entry))
+           (method (inline (gnus-server-get-method group (gnus-info-method info))))
+           (marked (gnus-info-marks info))
+           (mailp (apply 'append
+                         (mapcar
+                          (lambda (x)
+                            (memq x (assoc (symbol-name
+                                            (car (or method gnus-select-method)))
+                                           gnus-valid-select-methods)))
+                          '(mail post-mail))))
+           (level (or (gnus-info-level info) gnus-level-killed))
+           (score (or (gnus-info-score info) 0))
+           (ticked (gnus-range-length (cdr (assq 'tick marked))))
+           (group-age (gnus-group-timestamp-delta group)))
+      ;; FIXME: http://thread.gmane.org/gmane.emacs.gnus.general/65451/focus=65465
+      ;; ======================================================================
+      ;; From: Richard Stallman
+      ;; Subject: Re: Rewriting gnus-group-highlight-line (was: [...])
+      ;; Cc: ding@gnus.org
+      ;; Date: Sat, 27 Oct 2007 19:41:20 -0400
+      ;; Message-ID: <E1IlvHM-0006TS-7t@fencepost.gnu.org>
+      ;;
+      ;; [...]
+      ;; The kludge is that the alist elements contain expressions that refer
+      ;; to local variables with short names.  Perhaps write your own tiny
+      ;; evaluator that handles just `and', `or', and numeric comparisons
+      ;; and just a few specific variables.
+      ;; ======================================================================
+      ;;
+      ;; Similar for other evaluated variables.  Grep for risky-local-variable
+      ;; to find them!  -- rsteib
+      ;;
+      ;; Eval the cars of the lists until we find a match.
+      (while (and list
+                  (not (eval (caar list))))
+        (setq list (cdr list)))
+      list)))
+
+(defun gnus-group-highlight-line (group start end)
+  "Highlight the current line according to `gnus-group-highlight'.
+GROUP is current group, and the line to highlight starts at START
+and ends at END."
+  (let ((face (cdar (gnus-group-update-eval-form
+                      group
+                      gnus-group-highlight))))
+    (unless (eq face (get-text-property beg 'face))
+      (let ((inhibit-read-only t))
+        (gnus-put-text-property-excluding-characters-with-faces
+         start end 'face
+         (if (boundp face) (symbol-value face) face)))
+      (gnus-extent-start-open start))))
 
 (defun gnus-group-get-icon (group)
   "Return an icon for GROUP according to `gnus-group-icon-list'."
   (if gnus-group-icon-list
-      (let* ((entry (gnus-group-entry group))
-             (unread (if (numberp (car entry)) (car entry) 0))
-             (active (gnus-active group))
-             (total (if active (1+ (- (cdr active) (car active))) 0))
-             (info (nth 2 entry))
-             (method (gnus-server-get-method group (gnus-info-method info)))
-             (marked (gnus-info-marks info))
-             (mailp (memq 'mail (assoc (symbol-name
-                                        (car (or method gnus-select-method)))
-                                       gnus-valid-select-methods)))
-             (level (or (gnus-info-level info) gnus-level-killed))
-             (score (or (gnus-info-score info) 0))
-             (ticked (gnus-range-length (cdr (assq 'tick marked))))
-             (group-age (gnus-group-timestamp-delta group))
-             (inhibit-read-only t)
-             (list gnus-group-icon-list))
-        (while (and list
-                    (not (eval (caar list))))
-          (setq list (cdr list)))
-        (if list
+      (let ((image-path
+             (cdar (gnus-group-update-eval-form group gnus-group-icon-list))))
+        (if image-path
             (propertize " "
                         'display
                         (append
-                         (gnus-create-image (expand-file-name (cdar list)))
+                         (gnus-create-image (expand-file-name image-path))
                          '(:ascent center)))
           " "))
     " "))

diff --git a/texi/gnus.texi b/texi/gnus.texi
index 04cea2e..202b57d 100644 (file)
--- a/texi/gnus.texi
+++ b/texi/gnus.texi
@@ -1996,8 +1996,7 @@ functions for snarfing info on the group.
 @vindex gnus-group-update-hook
 @findex gnus-group-highlight-line
 @code{gnus-group-update-hook} is called when a group line is changed.
-It will not be called when @code{gnus-visual} is @code{nil}.  This hook
-calls @code{gnus-group-highlight-line} by default.
+It will not be called when @code{gnus-visual} is @code{nil}.
 
 
 @node Group Maneuvering