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.
: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)
?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
(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
(goto-char (event-point event))
(funcall (event-function response) (event-object response))))
-(defun gnus-group-add-icon ()
- "Add an icon to the current line according to `gnus-group-icon-list'."
- (let* ((p (point))
- (end (point-at-eol))
- ;; now find out where the line starts and leave point there.
- (beg (progn (beginning-of-line) (point))))
- (save-restriction
- (narrow-to-region beg end)
- (goto-char beg)
- (when (search-forward "==&&==" nil t)
- (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)
- (mystart (match-beginning 0))
- (myend (match-end 0)))
- (goto-char (point-min))
- (while (and list
- (not (eval (caar list))))
- (setq list (cdr list)))
- (if list
- (let* ((file (cdar list))
- (glyph (gnus-group-icon-create-glyph
- (buffer-substring mystart myend)
- file)))
- (if glyph
- (progn
- (mapc 'delete-annotation (annotations-at myend))
- (let ((ext (make-extent mystart myend))
- (ant (make-annotation glyph myend 'text)))
- ;; set text extent params
- (set-extent-property ext 'end-open t)
- (set-extent-property ext 'start-open t)
- (set-extent-property ext 'invisible t)))
- (delete-region mystart myend)))
- (delete-region mystart myend))))
- (widen))
- (goto-char p)))
-
-(defun gnus-group-icon-create-glyph (substring pixmap)
- "Create a glyph for insertion into a group line."
- (or
- (cdr-safe (assoc pixmap gnus-group-icon-cache))
- (let* ((glyph (make-glyph
- (list
- (cons 'x
- (expand-file-name pixmap gnus-xmas-glyph-directory))
- (cons 'tty substring)))))
- (setq gnus-group-icon-cache
- (cons (cons pixmap glyph) gnus-group-icon-cache))
- (set-glyph-face glyph 'default)
- glyph)))
-
(defun gnus-xmas-mailing-list-menu-add ()
(gnus-xmas-menu-add mailing-list
gnus-mailing-list-menu))
projects / gnus / commitdiff