diff options
| -rw-r--r-- | lisp/gnus/ChangeLog | 4 | ||||
| -rw-r--r-- | lisp/gnus/gnus-group.el | 52 |
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 @@ | |||
| 1 | 2010-09-22 Julien Danjou <julien@danjou.info> | 1 | 2010-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. |
| 297 | The hook will not be called if `gnus-visual' is nil. | 297 | The hook will not be called if `gnus-visual' is nil. |
| 298 | 298 | ||
| 299 | The default function `gnus-group-highlight-line' will | 299 | The default functions `gnus-group-highlight-line' will highlight |
| 300 | highlight the line according to the `gnus-group-highlight' | 300 | the line according to the `gnus-group-highlight' variable, and |
| 301 | variable." | 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. |
| 1692 | If VISIBLE-ONLY is non-nil, the group won't be displayed if it isn't | 1734 | If VISIBLE-ONLY is non-nil, the group won't be displayed if it isn't |