* gnus-picon.el (gnus-treat-newsgroups-picon): New function.
(gnus-picon-transform-newsgroups): New function.
* ietf-drums.el (ietf-drums-parse-addresses): Accept a nil
string.
* gnus-picon.el (gnus-treat-mail-picon): Renamed.
* gnus-art.el (gnus-treat-cc-picon): New variable.
(gnus-treat-mail-picon): Renamed.
* gnus-picon.el: New implementation.
(gnus-picon-find-face): Renamed.
(gnus-treat-from-picon): Use it.
(gnus-picon-transform-address): Renamed.
(gnus-treat-from-picon): Use it.
(gnus-picon-create-glyph): Renamed.
(gnus-picon-transform-address): Use it.
(gnus-treat-cc-picon): New command.
* gnus-art.el (gnus-treat-display-picons): Simplify.
(gnus-treat-from-picon): Renamed.
* gnus-art.el (gnus-article-treat-unfold-headers): Doc fix.
(gnus-with-article-headers): New macro.
(gnus-article-goto-header): New function.
2001-12-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
+ * gnus-art.el (gnus-treat-newsgroups-picon): New variable.
+
+ * gnus-picon.el (gnus-treat-newsgroups-picon): New function.
+ (gnus-picon-transform-newsgroups): New function.
+
+ * ietf-drums.el (ietf-drums-parse-addresses): Accept a nil
+ string.
+
+ * gnus-picon.el (gnus-treat-mail-picon): Renamed.
+
+ * gnus-art.el (gnus-treat-cc-picon): New variable.
+ (gnus-treat-mail-picon): Renamed.
+
* gnus-picon.el: New implementation.
+ (gnus-picon-find-face): Renamed.
+ (gnus-treat-from-picon): Use it.
+ (gnus-picon-transform-address): Renamed.
+ (gnus-treat-from-picon): Use it.
+ (gnus-picon-create-glyph): Renamed.
+ (gnus-picon-transform-address): Use it.
+ (gnus-treat-cc-picon): New command.
* mm-decode.el (mm-create-image-xemacs): Separated out into
function.
:type gnus-article-treat-head-custom)
(put 'gnus-treat-from-picon 'highlight t)
+(defcustom gnus-treat-mail-picon
+ (if (gnus-image-type-available-p 'xpm)
+ 'head nil)
+ "Display picons.
+Valid values are nil, t, `head', `last', an integer or a predicate.
+See the manual for details."
+ :group 'gnus-article-treat
+ :type gnus-article-treat-head-custom)
+(put 'gnus-treat-mail-picon 'highlight t)
+
+(defcustom gnus-treat-newsgroups-picon
+ (if (gnus-image-type-available-p 'xpm)
+ 'head nil)
+ "Display picons.
+Valid values are nil, t, `head', `last', an integer or a predicate.
+See the manual for details."
+ :group 'gnus-article-treat
+ :type gnus-article-treat-head-custom)
+(put 'gnus-treat-newsgroups-picon 'highlight t)
+
(defcustom gnus-treat-capitalize-sentences nil
"Capitalize sentence-starting words.
Valid values are nil, t, `head', `last', an integer or a predicate.
(gnus-treat-buttonize-head gnus-article-add-buttons-to-head)
(gnus-treat-display-smileys gnus-smiley-display)
(gnus-treat-capitalize-sentences gnus-article-capitalize-sentences)
- (gnus-treat-from-picon gnus-treat-from-picon)
(gnus-treat-emphasize gnus-article-emphasize)
+ (gnus-treat-from-picon gnus-treat-from-picon)
+ (gnus-treat-mail-picon gnus-treat-mail-picon)
+ (gnus-treat-newsgroups-picon gnus-treat-newsgroups-picon)
(gnus-treat-play-sounds gnus-earcon-display)))
(defvar gnus-article-mime-handle-alist nil)
;;; Functions:
-(defun gnus-picon-find-user (address directories &optional exact)
+(defun gnus-picon-find-face (address directories &optional exact)
(let* ((databases gnus-picon-databases)
(address (split-string address "[.@]"))
(user (pop address))
file
nil)))
-(defun gnus-treat-from-picon ()
+(defun gnus-picon-insert-glyph (glyph)
+ "Insert GLYPH into the buffer.
+GLYPH can be either a glyph or a string."
+ (if (stringp glyph)
+ (insert glyph)
+ (gnus-put-image glyph)))
+
+(defun gnus-picon-create-glyph (file)
+ (gnus-create-image file))
+
+;;; Functions that does picon transformations:
+
+(defun gnus-picon-transform-address (header)
(interactive)
(gnus-with-article-headers
- (let ((address
- (car (mail-header-parse-address (mail-fetch-field "from"))))
+ (let ((addresses
+ (mail-header-parse-addresses (mail-fetch-field header)))
(first t)
spec file)
- (when address
+ (dolist (address addresses)
+ (setq address (car address))
(setq spec (split-string address "[.@]"))
- (when (setq file (gnus-picon-find-user
+ (when (setq file (gnus-picon-find-face
address gnus-picon-user-directories))
- (setcar spec (gnus-picon-find-glyph file)))
+ (setcar spec (gnus-picon-create-glyph file)))
(dotimes (i (1- (length spec)))
- (when (setq file (gnus-picon-find-user
+ (when (setq file (gnus-picon-find-face
(concat "unknown@"
(mapconcat
'identity (nthcdr (1+ i) spec) "."))
gnus-picon-domain-directories t))
- (setcar (nthcdr (1+ i) spec) (gnus-picon-find-glyph file))))
+ (setcar (nthcdr (1+ i) spec) (gnus-picon-create-glyph file))))
- (gnus-article-goto-header "from")
+ (gnus-article-goto-header header)
(mail-header-narrow-to-field)
(when (search-forward address nil t)
(delete-region (match-beginning 0) (match-end 0))
(insert "@")
(setq first nil)))))))))
-(defun gnus-picon-insert-glyph (glyph)
- "Insert GLYPH into the buffer.
-GLYPH can be either a glyph or a string."
- (if (stringp glyph)
- (insert glyph)
- (gnus-put-image glyph)))
+(defun gnus-picon-transform-newsgroups (header)
+ (interactive)
+ (gnus-with-article-headers
+ (let ((groups
+ (sort
+ (message-tokenize-header (mail-fetch-field header))
+ (lambda (g1 g2) (> (length g1) (length g2)))))
+ spec file)
+ (dolist (group groups)
+ (setq spec (nreverse (split-string group "[.]")))
+ (dotimes (i (length spec))
+ (when (setq file (gnus-picon-find-face
+ (concat "unknown@"
+ (mapconcat
+ 'identity (nthcdr i spec) "."))
+ gnus-picon-news-directories t))
+ (setcar (nthcdr i spec) (gnus-picon-create-glyph file))))
+
+ (gnus-article-goto-header header)
+ (mail-header-narrow-to-field)
+ (when (search-forward group nil t)
+ (delete-region (match-beginning 0) (match-end 0))
+ (setq spec (nreverse spec))
+ (while spec
+ (gnus-picon-insert-glyph (pop spec))
+ (when spec
+ (insert "."))))))))
-(defun gnus-picon-find-glyph (file)
- (gnus-create-image file))
+;;; Commands:
+
+(defun gnus-treat-from-picon ()
+ (interactive)
+ (gnus-picon-transform-address "from"))
+
+(defun gnus-treat-mail-picon ()
+ (interactive)
+ (gnus-picon-transform-address "cc")
+ (gnus-picon-transform-address "to"))
+
+(defun gnus-treat-newsgroups-picon ()
+ (interactive)
+ (gnus-picon-transform-newsgroups "newsgroups")
+ (gnus-picon-transform-newsgroups "followup-to"))
(provide 'gnus-picon)
(defun ietf-drums-parse-addresses (string)
"Parse STRING and return a list of MAILBOX / DISPLAY-NAME pairs."
- (with-temp-buffer
- (ietf-drums-init string)
- (let ((beg (point))
- pairs c)
- (while (not (eobp))
- (setq c (char-after))
- (cond
- ((memq c '(?\" ?< ?\())
- (forward-sexp 1))
- ((eq c ?,)
- (push (ietf-drums-parse-address (buffer-substring beg (point)))
- pairs)
- (forward-char 1)
- (setq beg (point)))
- (t
- (forward-char 1))))
- (push (ietf-drums-parse-address (buffer-substring beg (point)))
- pairs)
- (nreverse pairs))))
+ (if (null string)
+ nil
+ (with-temp-buffer
+ (ietf-drums-init string)
+ (let ((beg (point))
+ pairs c)
+ (while (not (eobp))
+ (setq c (char-after))
+ (cond
+ ((memq c '(?\" ?< ?\())
+ (forward-sexp 1))
+ ((eq c ?,)
+ (push (ietf-drums-parse-address (buffer-substring beg (point)))
+ pairs)
+ (forward-char 1)
+ (setq beg (point)))
+ (t
+ (forward-char 1))))
+ (push (ietf-drums-parse-address (buffer-substring beg (point)))
+ pairs)
+ (nreverse pairs)))))
(defun ietf-drums-unfold-fws ()
"Unfold folding white space in the current buffer."
(goto-char p)
(if (search-forward "\nreferences:" nil t)
(nnheader-header-value)
- ;; Get the references from the in-reply-to header if there
+ ;; Get the references from the in-reply-to header if there
;; were no references and the in-reply-to header looks
;; promising.
(if (and (search-forward "\nin-reply-to:" nil t)
projects / gnus / commitdiff