From: Julien Danjou <julien@danjou.info>
To: ding@gnus.org
Cc: Julien Danjou <julien@danjou.info>
Subject: [PATCH] Remove gnus-group-highlight-line from the default hook list
Date: Wed, 22 Sep 2010 23:11:12 +0200 [thread overview]
Message-ID: <1285189872-23393-1-git-send-email-julien@danjou.info> (raw)
Signed-off-by: Julien Danjou <julien@danjou.info>
---
Hi,
I'm sending this one here so Lars can review it. Seems to work for me :) and
should be faster than the current code, with less SLOC.
Lars, WDYT?
lisp/ChangeLog | 10 ++++
lisp/gnus-group.el | 151 +++++++++++++++++++++++-----------------------------
texi/gnus.texi | 3 +-
3 files changed, 78 insertions(+), 86 deletions(-)
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index bfba205..3a4fe61 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,13 @@
+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
--- 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
--- 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
--
1.7.1
next reply other threads:[~2010-09-22 21:11 UTC|newest]
Thread overview: 4+ messages / expand[flat|nested] mbox.gz Atom feed top
2010-09-22 21:11 Julien Danjou [this message]
2010-09-22 21:18 ` Lars Magne Ingebrigtsen
2010-09-23 6:42 ` Reiner Steib
2010-09-23 7:13 ` Julien Danjou
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=1285189872-23393-1-git-send-email-julien@danjou.info \
--to=julien@danjou.info \
--cc=ding@gnus.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for NNTP newsgroup(s).