* [PATCH] Remove gnus-group-highlight-line from the default hook list
@ 2010-09-22 21:11 Julien Danjou
2010-09-22 21:18 ` Lars Magne Ingebrigtsen
2010-09-23 6:42 ` Reiner Steib
0 siblings, 2 replies; 4+ messages in thread
From: Julien Danjou @ 2010-09-22 21:11 UTC (permalink / raw)
To: ding; +Cc: Julien Danjou
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
^ permalink raw reply [flat|nested] 4+ messages in thread
* Re: [PATCH] Remove gnus-group-highlight-line from the default hook list
2010-09-22 21:11 [PATCH] Remove gnus-group-highlight-line from the default hook list Julien Danjou
@ 2010-09-22 21:18 ` Lars Magne Ingebrigtsen
2010-09-23 6:42 ` Reiner Steib
1 sibling, 0 replies; 4+ messages in thread
From: Lars Magne Ingebrigtsen @ 2010-09-22 21:18 UTC (permalink / raw)
To: ding
Julien Danjou <julien@danjou.info> writes:
> 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?
Looks nice to me. Please go ahead.
--
(domestic pets only, the antidote for overdose, milk.)
larsi@gnus.org * Lars Magne Ingebrigtsen
^ permalink raw reply [flat|nested] 4+ messages in thread
* Re: [PATCH] Remove gnus-group-highlight-line from the default hook list
2010-09-22 21:11 [PATCH] Remove gnus-group-highlight-line from the default hook list Julien Danjou
2010-09-22 21:18 ` Lars Magne Ingebrigtsen
@ 2010-09-23 6:42 ` Reiner Steib
2010-09-23 7:13 ` Julien Danjou
1 sibling, 1 reply; 4+ messages in thread
From: Reiner Steib @ 2010-09-23 6:42 UTC (permalink / raw)
To: Julien Danjou; +Cc: ding
On Wed, Sep 22 2010, Julien Danjou wrote:
> -(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)
Please add a :version tag when changing the defaults or introducing
new customizable variables.
--8<---------------cut here---------------start------------->8---
--- a/lisp/gnus-group.el
+++ b/lisp/gnus-group.el
@@ -295,6 +295,7 @@ If you want to modify the group buffer, you can use this hook."
(defcustom gnus-group-update-hook nil
"Hook called when a group line is changed."
:group 'gnus-group-visual
+ :version "24.1"
:type 'hook)
(defcustom gnus-useful-groups
--8<---------------cut here---------------end--------------->8---
Bye, Reiner.
--
,,,
(o o)
---ooO-(_)-Ooo--- | PGP key available | http://rsteib.home.pages.de/
^ permalink raw reply [flat|nested] 4+ messages in thread
* Re: [PATCH] Remove gnus-group-highlight-line from the default hook list
2010-09-23 6:42 ` Reiner Steib
@ 2010-09-23 7:13 ` Julien Danjou
0 siblings, 0 replies; 4+ messages in thread
From: Julien Danjou @ 2010-09-23 7:13 UTC (permalink / raw)
To: ding
[-- Attachment #1: Type: text/plain, Size: 294 bytes --]
On Thu, Sep 23 2010, Reiner Steib wrote:
> Please add a :version tag when changing the defaults or introducing
> new customizable variables.
Thanks for the reminder, I'm not used to it yet.
Fixed in git.
--
Julien Danjou
// ᐰ <julien@danjou.info> http://julien.danjou.info
[-- Attachment #2: Type: application/pgp-signature, Size: 197 bytes --]
^ permalink raw reply [flat|nested] 4+ messages in thread
end of thread, other threads:[~2010-09-23 7:13 UTC | newest]
Thread overview: 4+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2010-09-22 21:11 [PATCH] Remove gnus-group-highlight-line from the default hook list Julien Danjou
2010-09-22 21:18 ` Lars Magne Ingebrigtsen
2010-09-23 6:42 ` Reiner Steib
2010-09-23 7:13 ` Julien Danjou
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).