aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--lisp/gnus/ChangeLog4
-rw-r--r--lisp/gnus/gnus-group.el52
2 files changed, 51 insertions, 5 deletions
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 8851f19ed8d..4b7d393cd21 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,5 +1,9 @@
12010-09-22 Julien Danjou <julien@danjou.info> 12010-09-22 Julien Danjou <julien@danjou.info>
2 2
3 * gnus-group.el (gnus-group-update-hook): Call gnus-group-add-icon by
4 default.
5 (gnus-group-add-icon): Move to gnus-group.el, and rewrite so it works.
6
3 * gnus-html.el (gnus-html-wash-images): Use xml-substitute-special on 7 * gnus-html.el (gnus-html-wash-images): Use xml-substitute-special on
4 images alt-text. 8 images alt-text.
5 (gnus-html-put-image): Put alt-text as help-echo. 9 (gnus-html-put-image): Put alt-text as help-echo.
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el
index 80cf580b84a..5934a19ae2d 100644
--- a/lisp/gnus/gnus-group.el
+++ b/lisp/gnus/gnus-group.el
@@ -292,13 +292,14 @@ If you want to modify the group buffer, you can use this hook."
292 :group 'gnus-exit 292 :group 'gnus-exit
293 :type 'hook) 293 :type 'hook)
294 294
295(defcustom gnus-group-update-hook '(gnus-group-highlight-line) 295(defcustom gnus-group-update-hook '(gnus-group-highlight-line gnus-group-add-icon)
296 "Hook called when a group line is changed. 296 "Hook called when a group line is changed.
297The hook will not be called if `gnus-visual' is nil. 297The hook will not be called if `gnus-visual' is nil.
298 298
299The default function `gnus-group-highlight-line' will 299The default functions `gnus-group-highlight-line' will highlight
300highlight the line according to the `gnus-group-highlight' 300the line according to the `gnus-group-highlight' variable, and
301variable." 301`gnus-group-add-icon' will add an icon according to
302`gnus-group-icon-list'"
302 :group 'gnus-group-visual 303 :group 'gnus-group-visual
303 :type 'hook) 304 :type 'hook)
304 305
@@ -1578,7 +1579,7 @@ if it is a string, only list groups matching REGEXP."
1578 ?m ? )) 1579 ?m ? ))
1579 (gnus-tmp-moderated-string 1580 (gnus-tmp-moderated-string
1580 (if (eq gnus-tmp-moderated ?m) "(m)" "")) 1581 (if (eq gnus-tmp-moderated ?m) "(m)" ""))
1581 (gnus-tmp-group-icon "==&&==") 1582 (gnus-tmp-group-icon (propertize " " 'gnus-group-icon t))
1582 (gnus-tmp-news-server (or (cadr gnus-tmp-method) "")) 1583 (gnus-tmp-news-server (or (cadr gnus-tmp-method) ""))
1583 (gnus-tmp-news-method (or (car gnus-tmp-method) "")) 1584 (gnus-tmp-news-method (or (car gnus-tmp-method) ""))
1584 (gnus-tmp-news-method-string 1585 (gnus-tmp-news-method-string
@@ -1687,6 +1688,47 @@ if it is a string, only list groups matching REGEXP."
1687 (gnus-extent-start-open beg))) 1688 (gnus-extent-start-open beg)))
1688 (goto-char p))) 1689 (goto-char p)))
1689 1690
1691(defun gnus-group-add-icon ()
1692 "Add an icon to the current line according to `gnus-group-icon-list'."
1693 (save-excursion
1694 (let* ((end (line-end-position))
1695 ;; now find out where the line starts and leave point there.
1696 (beg (line-beginning-position)))
1697 (save-restriction
1698 (narrow-to-region beg end)
1699 (goto-char beg)
1700 (let ((mystart (text-property-any beg end 'gnus-group-icon t)))
1701 (when mystart
1702 (let* ((group (gnus-group-group-name))
1703 (entry (gnus-group-entry group))
1704 (unread (if (numberp (car entry)) (car entry) 0))
1705 (active (gnus-active group))
1706 (total (if active (1+ (- (cdr active) (car active))) 0))
1707 (info (nth 2 entry))
1708 (method (gnus-server-get-method group (gnus-info-method info)))
1709 (marked (gnus-info-marks info))
1710 (mailp (memq 'mail (assoc (symbol-name
1711 (car (or method gnus-select-method)))
1712 gnus-valid-select-methods)))
1713 (level (or (gnus-info-level info) gnus-level-killed))
1714 (score (or (gnus-info-score info) 0))
1715 (ticked (gnus-range-length (cdr (assq 'tick marked))))
1716 (group-age (gnus-group-timestamp-delta group))
1717 (inhibit-read-only t)
1718 (list gnus-group-icon-list)
1719 (myend (next-single-property-change
1720 mystart 'gnus-group-icon)))
1721 (while (and list
1722 (not (eval (caar list))))
1723 (setq list (cdr list)))
1724 (when list
1725 (put-text-property
1726 mystart myend
1727 'display
1728 (append
1729 (gnus-create-image (expand-file-name (cdar list)))
1730 '(:ascent center)))))))))))
1731
1690(defun gnus-group-update-group (group &optional visible-only) 1732(defun gnus-group-update-group (group &optional visible-only)
1691 "Update all lines where GROUP appear. 1733 "Update all lines where GROUP appear.
1692If VISIBLE-ONLY is non-nil, the group won't be displayed if it isn't 1734If VISIBLE-ONLY is non-nil, the group won't be displayed if it isn't