From c833671c9d32c73eb7ff7d40e2f99bd9a570bc4e Mon Sep 17 00:00:00 2001 From: Julien Danjou Date: Wed, 22 Sep 2010 22:06:07 +0200 Subject: [PATCH] gnus-group-insert-group-line: Compute icon to return Signed-off-by: Julien Danjou --- lisp/ChangeLog | 4 +++ lisp/gnus-group.el | 80 ++++++++++++++++++++-------------------------- 2 files changed, 38 insertions(+), 46 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 747edfdde..bfba2059a 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -5,6 +5,10 @@ 2010-09-22 Julien Danjou + * gnus-group.el (gnus-group-get-icon): Renamed gnus-group-add-icon that + Only return an icon. + (gnus-group-insert-group-line): Compute icon to return. + * gnus-html.el (gnus-html-image-automatic-caching): Add custom variable. (gnus-html-image-fetched): Only cache if diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el index 5934a19ae..a940bc068 100644 --- a/lisp/gnus-group.el +++ b/lisp/gnus-group.el @@ -292,14 +292,12 @@ 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 gnus-group-add-icon) +(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 functions `gnus-group-highlight-line' will highlight -the line according to the `gnus-group-highlight' variable, and -`gnus-group-add-icon' will add an icon according to -`gnus-group-icon-list'" +The default function `gnus-group-highlight-line' will highlight +the line according to the `gnus-group-highlight' variable." :group 'gnus-group-visual :type 'hook) @@ -1579,7 +1577,7 @@ if it is a string, only list groups matching REGEXP." ?m ? )) (gnus-tmp-moderated-string (if (eq gnus-tmp-moderated ?m) "(m)" "")) - (gnus-tmp-group-icon (propertize " " 'gnus-group-icon t)) + (gnus-tmp-group-icon (gnus-group-get-icon gnus-tmp-qualified-group)) (gnus-tmp-news-server (or (cadr gnus-tmp-method) "")) (gnus-tmp-news-method (or (car gnus-tmp-method) "")) (gnus-tmp-news-method-string @@ -1688,46 +1686,36 @@ if it is a string, only list groups matching REGEXP." (gnus-extent-start-open beg))) (goto-char p))) -(defun gnus-group-add-icon () - "Add an icon to the current line according to `gnus-group-icon-list'." - (save-excursion - (let* ((end (line-end-position)) - ;; now find out where the line starts and leave point there. - (beg (line-beginning-position))) - (save-restriction - (narrow-to-region beg end) - (goto-char beg) - (let ((mystart (text-property-any beg end 'gnus-group-icon t))) - (when mystart - (let* ((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 (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) - (myend (next-single-property-change - mystart 'gnus-group-icon))) - (while (and list - (not (eval (caar list)))) - (setq list (cdr list))) - (when list - (put-text-property - mystart myend - 'display - (append - (gnus-create-image (expand-file-name (cdar list))) - '(:ascent center))))))))))) +(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 + (propertize " " + 'display + (append + (gnus-create-image (expand-file-name (cdar list))) + '(:ascent center))) + " ")) + " ")) (defun gnus-group-update-group (group &optional visible-only) "Update all lines where GROUP appear. -- 2.25.1