mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-02-16 13:11:14 -08:00
Code Issues Projects Releases Wiki Activity

Make gnus-group-add-icon work.

Browse source
This commit is contained in:
Julien Danjou 2010-09-22 12:49:48 +00:00 • committed by Katsumi Yamaoka
parent b4e64499e2
commit c7e2ef4e2b
2 changed files with 51 additions and 5 deletions
Download patch file Download diff file Expand all files Collapse all files

4
lisp/gnus/ChangeLog
View file

@ -1,5 +1,9 @@
2010-09-22 Julien Danjou <julien@danjou.info>
* gnus-group.el (gnus-group-update-hook): Call gnus-group-add-icon by
default.
(gnus-group-add-icon): Move to gnus-group.el, and rewrite so it works.
* gnus-html.el (gnus-html-wash-images): Use xml-substitute-special on
images alt-text.
(gnus-html-put-image): Put alt-text as help-echo.

52
lisp/gnus/gnus-group.el
View file

@ -292,13 +292,14 @@ 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)
(defcustom gnus-group-update-hook '(gnus-group-highlight-line gnus-group-add-icon)
"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."
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'"
:group 'gnus-group-visual
:type 'hook)
@ -1578,7 +1579,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 "==&&==")
(gnus-tmp-group-icon (propertize " " 'gnus-group-icon t))
(gnus-tmp-news-server (or (cadr gnus-tmp-method) ""))
(gnus-tmp-news-method (or (car gnus-tmp-method) ""))
(gnus-tmp-news-method-string
@ -1687,6 +1688,47 @@ 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-update-group (group &optional visible-only)
"Update all lines where GROUP appear.
If VISIBLE-ONLY is non-nil, the group won't be displayed if it isn't