From mboxrd@z Thu Jan 1 00:00:00 1970 X-Msuck: nntp://news.gmane.io/gmane.emacs.gnus.general/71478 Path: news.gmane.org!not-for-mail From: Julien Danjou Newsgroups: gmane.emacs.gnus.general Subject: [PATCH] Remove gnus-group-highlight-line from the default hook list Date: Wed, 22 Sep 2010 23:11:12 +0200 Message-ID: <1285189872-23393-1-git-send-email-julien@danjou.info> NNTP-Posting-Host: lo.gmane.org X-Trace: dough.gmane.org 1285189932 4331 80.91.229.12 (22 Sep 2010 21:12:12 GMT) X-Complaints-To: usenet@dough.gmane.org NNTP-Posting-Date: Wed, 22 Sep 2010 21:12:12 +0000 (UTC) Cc: Julien Danjou To: ding@gnus.org Original-X-From: ding-owner+M19851@lists.math.uh.edu Wed Sep 22 23:12:11 2010 Return-path: Envelope-to: ding-account@gmane.org Original-Received: from util0.math.uh.edu ([129.7.128.18]) by lo.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1OyWbm-0006ON-Ij for ding-account@gmane.org; Wed, 22 Sep 2010 23:12:07 +0200 Original-Received: from localhost ([127.0.0.1] helo=lists.math.uh.edu) by util0.math.uh.edu with smtp (Exim 4.63) (envelope-from ) id 1OyWbf-00075I-43; Wed, 22 Sep 2010 16:11:59 -0500 Original-Received: from mx2.math.uh.edu ([129.7.128.33]) by util0.math.uh.edu with esmtps (TLSv1:AES256-SHA:256) (Exim 4.63) (envelope-from ) id 1OyWbd-000754-E5 for ding@lists.math.uh.edu; Wed, 22 Sep 2010 16:11:57 -0500 Original-Received: from quimby.gnus.org ([80.91.231.51]) by mx2.math.uh.edu with esmtp (Exim 4.72) (envelope-from ) id 1OyWbZ-0004lj-3G for ding@lists.math.uh.edu; Wed, 22 Sep 2010 16:11:57 -0500 Original-Received: from prometheus.naquadah.org ([212.85.154.174] helo=mx1.naquadah.org) by quimby.gnus.org with esmtp (Exim 3.36 #1 (Debian)) id 1OyWbY-0007F9-00 for ; Wed, 22 Sep 2010 23:11:52 +0200 Original-Received: by mx1.naquadah.org (Postfix, from userid 8) id 36F745C0E7; Wed, 22 Sep 2010 23:11:21 +0200 (CEST) X-Spam-Checker-Version: SpamAssassin 3.3.1 (2010-03-16) on prometheus.naquadah.org X-Spam-Level: X-Spam-Status: No, score=-2.9 required=4.5 tests=ALL_TRUSTED,BAYES_00 autolearn=ham version=3.3.1 Original-Received: from keller.adm.naquadah.org (unknown [IPv6:2a01:e35:2e39:e900:222:faff:fe9d:ce44]) (using TLSv1 with cipher AES256-SHA (256/256 bits)) (No client certificate requested) by mx1.naquadah.org (Postfix) with ESMTPSA id 9AC9C5C09C; Wed, 22 Sep 2010 23:11:16 +0200 (CEST) Original-Received: from jd by keller.adm.naquadah.org with local (Exim 4.72) (envelope-from ) id 1OyWay-00067L-0M; Wed, 22 Sep 2010 23:11:16 +0200 X-Mailer: git-send-email 1.7.1 X-Spam-Score: -1.9 (-) List-ID: Precedence: bulk Xref: news.gmane.org gmane.emacs.gnus.general:71478 Archived-At: Signed-off-by: Julien Danjou --- 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 + + * 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 * 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: - ;; - ;; [...] - ;; 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: + ;; + ;; [...] + ;; 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