Mercurial > hg > xemacs-beta

comparison lisp/gnus/gnus-picon.el @ 140:585fb297b004 r20-2b4

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-2b4
author cvs
date Mon, 13 Aug 2007 09:32:43 +0200
parents b980b6286996
children 1856695b1fa9
comparison
equal deleted inserted replaced
139:2b5203979d01 140:585fb297b004
61 (defcustom gnus-picons-news-directory "news" 61 (defcustom gnus-picons-news-directory "news"
62 "Sub-directory of the faces database containing the icons for newsgroups." 62 "Sub-directory of the faces database containing the icons for newsgroups."
63 :type 'string 63 :type 'string
64 :group 'picons) 64 :group 'picons)
65 65
66 (defcustom gnus-picons-user-directories '("local" "users" "usenix" "misc/MISC") 66 (defcustom gnus-picons-user-directories '("local" "users" "usenix" "misc")
67 "List of directories to search for user faces." 67 "List of directories to search for user faces."
68 :type '(repeat string) 68 :type '(repeat string)
69 :group 'picons) 69 :group 'picons)
70 70
71 (defcustom gnus-picons-domain-directories '("domains") 71 (defcustom gnus-picons-domain-directories '("domains")
107 :type '(repeat string) 107 :type '(repeat string)
108 :group 'picons) 108 :group 'picons)
109 109
110 (defcustom gnus-picons-display-article-move-p t 110 (defcustom gnus-picons-display-article-move-p t
111 "*Whether to move point to first empty line when displaying picons. 111 "*Whether to move point to first empty line when displaying picons.
112 This has only an effect if `gnus-picons-display-where' hs value article." 112 This has only an effect if `gnus-picons-display-where' has value `article'."
113 :type 'boolean 113 :type 'boolean
114 :group 'picons) 114 :group 'picons)
115 115
116 (defvar gnus-picons-map (make-sparse-keymap "gnus-picons-keys") 116 (defvar gnus-picons-map (make-sparse-keymap "gnus-picons-keys")
117 "keymap to hide/show picon glyphs") 117 "keymap to hide/show picon glyphs")
118 118
119 (define-key gnus-picons-map [(button2)] 'gnus-picons-toggle-extent) 119 (define-key gnus-picons-map [(button2)] 'gnus-picons-toggle-extent)
120 120
121 ;;; Internal variables. 121 ;;; Internal variables.
122 122
123 (defvar gnus-group-annotations nil) 123 (defvar gnus-group-annotations nil
124 (defvar gnus-article-annotations nil) 124 "List of annotations added/removed when selecting/exiting a group")
125 (defvar gnus-x-face-annotations nil) 125 (defvar gnus-article-annotations nil
126 126 "List of annotations added/removed when selecting an article")
127 (defun gnus-picons-remove (plist) 127 (defvar gnus-x-face-annotations nil
128 (let ((listitem (car plist))) 128 "List of annotations added/removed when selecting an article with an X-Face.")
129 (while (setq listitem (car plist)) 129
130 (when (annotationp listitem) 130 (defun gnus-picons-remove (symbol)
131 (delete-annotation listitem)) 131 "Remove all annotations/processes in variable named SYMBOL.
132 (setq plist (cdr plist))))) 132 This function is careful to set it to nil before removing anything so that
133 asynchronous process don't get crazy."
134 (let ((listitems (symbol-value symbol)))
135 (set symbol nil)
136 (while listitems
137 (let ((item (pop listitems)))
138 (cond ((annotationp item)
139 (delete-annotation item))
140 ((processp item)
141 ;; kill the process, ignore any output.
142 (set-process-sentinel item (function (lambda (p e))))
143 (delete-process item)))))))
133 144
134 (defun gnus-picons-remove-all () 145 (defun gnus-picons-remove-all ()
135 "Removes all picons from the Gnus display(s)." 146 "Removes all picons from the Gnus display(s)."
136 (interactive) 147 (interactive)
137 (gnus-picons-remove gnus-article-annotations) 148 (gnus-picons-remove 'gnus-article-annotations)
138 (gnus-picons-remove gnus-group-annotations) 149 (gnus-picons-remove 'gnus-group-annotations)
139 (gnus-picons-remove gnus-x-face-annotations) 150 (gnus-picons-remove 'gnus-x-face-annotations)
140 (setq gnus-article-annotations nil
141 gnus-group-annotations nil
142 gnus-x-face-annotations nil)
143 (when (bufferp gnus-picons-buffer) 151 (when (bufferp gnus-picons-buffer)
144 (kill-buffer gnus-picons-buffer))) 152 (kill-buffer gnus-picons-buffer)))
145 153
146 (defun gnus-get-buffer-name (variable) 154 (defun gnus-get-buffer-name (variable)
147 "Returns the buffer name associated with the contents of a variable." 155 "Returns the buffer name associated with the contents of a variable."
151 (symbol-value newvar)) 159 (symbol-value newvar))
152 ((stringp newvar) newvar)))) 160 ((stringp newvar) newvar))))
153 ((stringp variable) 161 ((stringp variable)
154 variable))) 162 variable)))
155 163
164 (defun gnus-picons-prepare-for-annotations (annotations)
165 "Prepare picons buffer for puting annotations memorized in ANNOTATIONS.
166 ANNOTATIONS should be a symbol naming a variable wich contains a list of
167 annotations. Sets buffer to `gnus-picons-display-where'."
168 ;; let drawing catch up
169 (when gnus-picons-refresh-before-display
170 (sit-for 0))
171 (set-buffer (get-buffer-create
172 (gnus-get-buffer-name gnus-picons-display-where)))
173 (gnus-add-current-to-buffer-list)
174 (goto-char (point-min))
175 (if (and (eq gnus-picons-display-where 'article)
176 gnus-picons-display-article-move-p)
177 (when (search-forward "\n\n" nil t)
178 (forward-line -1)))
179 (gnus-picons-remove annotations))
180
156 (defun gnus-picons-article-display-x-face () 181 (defun gnus-picons-article-display-x-face ()
157 "Display the x-face header bitmap in the 'gnus-picons-display-where buffer." 182 "Display the x-face header bitmap in the 'gnus-picons-display-where buffer."
158 ;; delete any old ones. 183 ;; delete any old ones.
159 (gnus-picons-remove gnus-x-face-annotations) 184 ;; This is needed here because gnus-picons-display-x-face will not
160 (setq gnus-x-face-annotations nil) 185 ;; be called if there is no X-Face header
186 (gnus-picons-remove 'gnus-x-face-annotations)
161 ;; display the new one. 187 ;; display the new one.
162 (let ((gnus-article-x-face-command 'gnus-picons-display-x-face)) 188 (let ((gnus-article-x-face-command 'gnus-picons-display-x-face))
163 (gnus-article-display-x-face))) 189 (gnus-article-display-x-face)))
190
191 (defun gnus-picons-x-face-sentinel (process event)
192 ;; don't call gnus-picons-prepare-for-annotations, it would reset
193 ;; gnus-x-face-annotations.
194 (set-buffer (get-buffer-create
195 (gnus-get-buffer-name gnus-picons-display-where)))
196 (gnus-add-current-to-buffer-list)
197 (goto-char (point-min))
198 (if (and (eq gnus-picons-display-where 'article)
199 gnus-picons-display-article-move-p)
200 (when (search-forward "\n\n" nil t)
201 (forward-line -1)))
202 ;; If the process is still in the list, insert this icon
203 (let ((myself (member process gnus-x-face-annotations)))
204 (when myself
205 (setcar myself
206 (make-annotation gnus-picons-x-face-file-name nil 'text))
207 (delete-file gnus-picons-x-face-file-name))))
164 208
165 (defun gnus-picons-display-x-face (beg end) 209 (defun gnus-picons-display-x-face (beg end)
166 "Function to display the x-face header in the picons window. 210 "Function to display the x-face header in the picons window.
167 To use: (setq gnus-article-x-face-command 'gnus-picons-display-x-face)" 211 To use: (setq gnus-article-x-face-command 'gnus-picons-display-x-face)"
168 (interactive) 212 (interactive)
169 ;; convert the x-face header to a .xbm file 213 (if (featurep 'xface)
170 (let ((process-connection-type nil) 214 ;; Use builtin support
171 (process nil)) 215 (let ((buf (current-buffer)))
172 (process-kill-without-query 216 (save-excursion
173 (setq process (start-process 217 (gnus-picons-prepare-for-annotations 'gnus-x-face-annotations)
174 "gnus-x-face" nil shell-file-name shell-command-switch 218 (setq gnus-x-face-annotations
175 gnus-picons-convert-x-face))) 219 (cons (make-annotation (concat "X-Face: "
176 (process-send-region "gnus-x-face" beg end) 220 (buffer-substring beg end buf))
177 (process-send-eof "gnus-x-face") 221 nil 'text)
178 ;; wait for it. 222 gnus-x-face-annotations))))
179 (while (not (equal (process-status process) 'exit)) 223 ;; convert the x-face header to a .xbm file
180 (sleep-for .1))) 224 (let* ((process-connection-type nil)
181 ;; display it 225 (process (start-process "gnus-x-face" nil
182 (save-excursion 226 shell-file-name shell-command-switch
183 (set-buffer (get-buffer-create (gnus-get-buffer-name 227 gnus-picons-convert-x-face)))
184 gnus-picons-display-where))) 228 (process-kill-without-query process)
185 (gnus-add-current-to-buffer-list) 229 (setq gnus-x-face-annotations (list process))
186 (goto-char (point-min)) 230 (set-process-sentinel process 'gnus-picons-x-face-sentinel)
187 (let (buffer-read-only) 231 (process-send-region process beg end)
188 (unless (eolp) 232 (process-send-eof process))))
189 (push (make-annotation "\n" (point) 'text)
190 gnus-x-face-annotations))
191 ;; append the annotation to gnus-article-annotations for deletion.
192 (setq gnus-x-face-annotations
193 (append
194 (gnus-picons-try-to-find-face gnus-picons-x-face-file-name t)
195 gnus-x-face-annotations)))
196 ;; delete the tmp file
197 (delete-file gnus-picons-x-face-file-name)))
198 233
199 (defun gnus-article-display-picons () 234 (defun gnus-article-display-picons ()
200 "Display faces for an author and his/her domain in gnus-picons-display-where." 235 "Display faces for an author and his/her domain in gnus-picons-display-where."
201 (interactive) 236 (interactive)
202 ;; let drawing catch up 237 (let (from at-idx)
203 (when gnus-picons-refresh-before-display
204 (sit-for 0))
205 (let ((first t)
206 from at-idx databases)
207 (when (and (featurep 'xpm) 238 (when (and (featurep 'xpm)
208 (or (not (fboundp 'device-type)) (equal (device-type) 'x)) 239 (or (not (fboundp 'device-type)) (equal (device-type) 'x))
209 (setq from (mail-fetch-field "from")) 240 (setq from (mail-fetch-field "from"))
210 (setq from (downcase 241 (setq from (downcase
211 (or (cadr (mail-extract-address-components from)) 242 (or (cadr (mail-extract-address-components from))
214 (setq at-idx (length from)))) 245 (setq at-idx (length from))))
215 (save-excursion 246 (save-excursion
216 (let ((username (substring from 0 at-idx)) 247 (let ((username (substring from 0 at-idx))
217 (addrs (if (eq at-idx (length from)) 248 (addrs (if (eq at-idx (length from))
218 (if gnus-local-domain 249 (if gnus-local-domain
219 (nreverse (message-tokenize-header 250 (message-tokenize-header gnus-local-domain ".")
220 gnus-local-domain ".")) 251 nil)
221 '(".")) 252 (message-tokenize-header (substring from (1+ at-idx))
222 (nreverse (message-tokenize-header 253 "."))))
223 (substring from (1+ at-idx)) "."))))) 254 (gnus-picons-prepare-for-annotations 'gnus-article-annotations)
224 (set-buffer (get-buffer-create 255 (setq gnus-article-annotations
225 (gnus-get-buffer-name gnus-picons-display-where))) 256 (nconc gnus-article-annotations
226 (gnus-add-current-to-buffer-list) 257 ;; look for domain paths.
227 (goto-char (point-min)) 258 (gnus-picons-display-pairs
228 (if (and (eq gnus-picons-display-where 'article) 259 (gnus-picons-lookup-pairs addrs
229 gnus-picons-display-article-move-p) 260 gnus-picons-domain-directories)
230 (when (search-forward "\n\n" nil t) 261 (not (or gnus-picons-display-as-address
231 (forward-line -1)) 262 gnus-article-annotations))
232 (unless (eolp) 263 nil "." t)
233 (push (make-annotation "\n" (point) 'text) 264 ;; add an '@' if displaying as address
234 gnus-article-annotations))) 265 (if (and gnus-picons-display-as-address addrs)
235 266 (list (make-annotation "@" nil 'text nil nil nil t)))
236 (gnus-picons-remove gnus-article-annotations) 267 ;; then do user directories,
237 (setq gnus-article-annotations nil) 268 (gnus-picons-display-picon-or-name
238 269 (gnus-picons-lookup-user (downcase username) addrs)
239 ;; look for domain paths. 270 username nil t)))
240 (setq databases gnus-picons-domain-directories)
241 (while databases
242 (setq gnus-article-annotations
243 (nconc (gnus-picons-insert-face-if-exists
244 (car databases)
245 addrs
246 "unknown" (or gnus-picons-display-as-address
247 gnus-article-annotations) t t)
248 gnus-article-annotations))
249 (setq databases (cdr databases)))
250
251 ;; add an '@' if displaying as address
252 (when gnus-picons-display-as-address
253 (setq gnus-article-annotations
254 (nconc gnus-article-annotations
255 (list
256 (make-annotation "@" (point) 'text nil nil nil t)))))
257
258 ;; then do user directories,
259 (let (found)
260 (setq databases gnus-picons-user-directories)
261 (setq username (downcase username))
262 (while databases
263 (setq found
264 (nconc (gnus-picons-insert-face-if-exists
265 (car databases) addrs username
266 (or gnus-picons-display-as-address
267 gnus-article-annotations) nil t)
268 found))
269 (setq databases (cdr databases)))
270 ;; add their name if no face exists
271 (when (and gnus-picons-display-as-address (not found))
272 (setq found
273 (list
274 (make-annotation username (point) 'text nil nil nil t))))
275 (setq gnus-article-annotations
276 (nconc found gnus-article-annotations)))
277 271
278 (add-hook 'gnus-summary-exit-hook 'gnus-picons-remove-all)))))) 272 (add-hook 'gnus-summary-exit-hook 'gnus-picons-remove-all))))))
279 273
280 (defun gnus-group-display-picons () 274 (defun gnus-group-display-picons ()
281 "Display icons for the group in the gnus-picons-display-where buffer." 275 "Display icons for the group in the gnus-picons-display-where buffer."
282 (interactive) 276 (interactive)
283 ;; let display catch up so far
284 (when gnus-picons-refresh-before-display
285 (sit-for 0))
286 (when (and (featurep 'xpm) 277 (when (and (featurep 'xpm)
287 (or (not (fboundp 'device-type)) (equal (device-type) 'x))) 278 (or (not (fboundp 'device-type)) (equal (device-type) 'x)))
288 (save-excursion 279 (save-excursion
289 (set-buffer (get-buffer-create 280 (gnus-picons-prepare-for-annotations 'gnus-group-annotations)
290 (gnus-get-buffer-name gnus-picons-display-where)))
291 (gnus-add-current-to-buffer-list)
292 (goto-char (point-min))
293 (if (and (eq gnus-picons-display-where 'article)
294 gnus-picons-display-article-move-p)
295 (when (search-forward "\n\n" nil t)
296 (forward-line -1))
297 (unless (eolp)
298 (push (make-annotation "\n" (point) 'text)
299 gnus-group-annotations)))
300 (cond
301 ((listp gnus-group-annotations)
302 (mapc #'(lambda (ext) (when (extent-live-p ext)
303 (delete-annotation ext)))
304 gnus-group-annotations)
305 (setq gnus-group-annotations nil))
306 ((annotationp gnus-group-annotations)
307 (delete-annotation gnus-group-annotations)
308 (setq gnus-group-annotations nil)))
309 (gnus-picons-remove gnus-group-annotations)
310 (setq gnus-group-annotations 281 (setq gnus-group-annotations
311 (gnus-picons-insert-face-if-exists 282 (gnus-picons-display-pairs
312 gnus-picons-news-directory 283 (gnus-picons-lookup-pairs (reverse (message-tokenize-header
313 (message-tokenize-header gnus-newsgroup-name ".") 284 gnus-newsgroup-name "."))
314 "unknown" nil t)) 285 gnus-picons-news-directory)
286 t nil "."))
315 (add-hook 'gnus-summary-exit-hook 'gnus-picons-remove-all)))) 287 (add-hook 'gnus-summary-exit-hook 'gnus-picons-remove-all))))
288
289 (defun gnus-picons-make-path (dir subdirs)
290 "Make a directory name from a base DIR and a list of SUBDIRS.
291 Returns a directory name build by concatenating DIR and all elements of
292 SUBDIRS with \"/\" between elements."
293 (while subdirs
294 (setq dir (file-name-as-directory (concat dir (pop subdirs)))))
295 dir)
316 296
317 (defsubst gnus-picons-try-suffixes (file) 297 (defsubst gnus-picons-try-suffixes (file)
318 (let ((suffixes gnus-picons-file-suffixes) 298 (let ((suffixes gnus-picons-file-suffixes)
319 f) 299 f)
320 (while (and suffixes 300 (while (and suffixes
321 (not (file-exists-p (setq f (concat file (pop suffixes)))))) 301 (not (file-exists-p (setq f (concat file (pop suffixes))))))
322 (setq f nil)) 302 (setq f nil))
323 f)) 303 f))
324 304
325 (defun gnus-picons-insert-face-if-exists (database addrs filename &optional 305 (defun gnus-picons-lookup (addrs dirs)
326 nobar-p dots rightp) 306 "Lookup the picon for ADDRS in databases DIRS.
327 "Inserts a face at point if I can find one" 307 Returns the picon filename or NIL if none found."
328 ;; '(gnus-picons-insert-face-if-exists 308 (let (result)
329 ;; "Database" '("edu" "indiana" "cs") "Name") 309 (while (and dirs (null result))
330 ;; looks for: 310 (setq result
331 ;; 1. edu/indiana/cs/Name 311 (gnus-picons-try-suffixes
332 ;; 2. edu/indiana/Name 312 (expand-file-name "face."
333 ;; 3. edu/Name 313 (gnus-picons-make-path
334 ;; '(gnus-picons-insert-face-if-exists 314 (file-name-as-directory
335 ;; "Database/MISC" '("edu" "indiana" "cs") "Name") 315 (concat
336 ;; looks for: 316 (file-name-as-directory gnus-picons-database)
337 ;; 1. MISC/Name 317 (pop dirs)))
338 ;; The special treatment of MISC doesn't conform with the conventions for 318 (reverse addrs))))))
339 ;; picon databases, but otherwise we would always see the MISC/unknown face. 319 result))
340 (let ((bar (and (not nobar-p) 320
341 (or gnus-picons-display-as-address 321 (defun gnus-picons-lookup-user-internal (user domains)
342 (annotations-in-region 322 (let ((dirs gnus-picons-user-directories)
343 (point) (min (point-max) (1+ (point))) 323 picon)
344 (current-buffer))))) 324 (while (and dirs (null picon))
345 (path (concat (file-name-as-directory gnus-picons-database) 325 (let ((dir (list (pop dirs)))
346 database "/")) 326 (domains domains))
347 (domainp (and gnus-picons-display-as-address dots)) 327 (while (and domains (null picon))
348 picons found bar-ann cur first) 328 (setq picon (gnus-picons-lookup (cons user domains) dir))
349 (when (string-match "/MISC" database) 329 (pop domains))
350 (setq addrs '("."))) 330 ;; Also make a try MISC subdir
351 (while (and addrs 331 (unless picon
352 (file-accessible-directory-p path)) 332 (setq picon (gnus-picons-lookup (list user "MISC") dir)))))
353 (setq cur (pop addrs) 333
354 path (concat path cur "/")) 334 picon))
355 (if (setq found 335
356 (gnus-picons-try-suffixes (concat path filename "/face."))) 336 (defun gnus-picons-lookup-user (user domains)
357 (progn 337 "Lookup the picon for USER at DOMAINS.
358 (setq picons (nconc (when (and domainp first rightp) 338 USER is a string containing a name.
359 (list (make-annotation 339 DOMAINS is a list of strings from the fully qualified domain name."
360 "." (point) 'text 340 (or (gnus-picons-lookup-user-internal user domains)
361 nil nil nil rightp) 341 (gnus-picons-lookup-user-internal "unknown" domains)))
362 picons)) 342
363 (gnus-picons-try-to-find-face 343 (defun gnus-picons-lookup-pairs (domains directories)
364 found nil (if domainp cur filename) rightp) 344 "Lookup picons for DOMAINS and all its parents in DIRECTORIES.
365 (when (and domainp first (not rightp)) 345 Returns a list of PAIRS whose CAR is the picon filename or NIL if
366 (list (make-annotation 346 none, and whose CDR is the corresponding element of DOMAINS."
367 "." (point) 'text 347 (let (picons)
368 nil nil nil rightp) 348 (while domains
369 picons)) 349 (push (list (gnus-picons-lookup (cons "unknown" domains)
370 picons))) 350 (if (listp directories)
371 (when domainp 351 directories
372 (setq picons 352 (list directories)))
373 (nconc 353 (pop domains))
374 (list (make-annotation 354 picons))
375 (if first (concat (if (not rightp) ".") cur 355 picons))
376 (if rightp ".")) cur) 356
377 (point) 'text nil nil nil rightp)) 357 (defun gnus-picons-display-picon-or-name (picon name &optional xface-p right-p)
378 picons)))) 358 (if picon
379 (when (and bar (or domainp found)) 359 (gnus-picons-try-to-find-face picon xface-p name right-p)
380 (setq bar-ann (gnus-picons-try-to-find-face 360 (list (make-annotation name nil 'text nil nil nil right-p))))
381 (concat gnus-xmas-glyph-directory "bar.xbm") 361
382 nil nil t)) 362 (defun gnus-picons-display-pairs (pairs &optional bar-p xface-p dot-p right-p)
383 (when bar-ann 363 "Display picons in list PAIRS."
384 (setq picons (nconc picons bar-ann)) 364 (let ((bar (and bar-p (or gnus-picons-display-as-address
385 (setq bar nil))) 365 (annotations-in-region (point)
386 (setq first t)) 366 (min (point-max) (1+ (point)))
387 (when (and addrs domainp) 367 (current-buffer)))))
388 (let ((it (mapconcat 'downcase (nreverse addrs) "."))) 368 (domain-p (and gnus-picons-display-as-address dot-p))
389 (setq picons 369 picons)
390 (nconc picons (list (make-annotation 370 (while pairs
391 (if first 371 (let ((pair (pop pairs)))
392 (concat (if (not rightp) ".") 372 (setq picons (nconc (if (and domain-p picons (not right-p))
393 it (if rightp ".")) 373 (list (make-annotation
394 it) 374 dot-p nil 'text nil nil nil right-p)))
395 (point) 'text 375 (gnus-picons-display-picon-or-name (car pair)
396 nil nil nil rightp)))))) 376 (cadr pair)
377 xface-p
378 right-p)
379 (if (and domain-p pairs right-p)
380 (list (make-annotation
381 dot-p nil 'text nil nil nil right-p)))
382 (when (and bar domain-p)
383 (setq bar nil)
384 (gnus-picons-try-to-find-face
385 (expand-file-name "bar.xbm"
386 gnus-xmas-glyph-directory)
387 nil nil t))
388 picons))))
397 picons)) 389 picons))
398 390
399 (defvar gnus-picons-glyph-alist nil) 391 (defvar gnus-picons-glyph-alist nil)
400 392
401 (defun gnus-picons-try-to-find-face (path &optional xface-p part rightp) 393 (defun gnus-picons-try-to-find-face (path &optional xface-p part rightp)
420 (hide-annotation txt) 412 (hide-annotation txt)
421 (set-extent-property txt 'its-partner new) 413 (set-extent-property txt 'its-partner new)
422 (set-extent-property txt 'keymap gnus-picons-map) 414 (set-extent-property txt 'keymap gnus-picons-map)
423 (set-extent-property txt 'mouse-face gnus-article-mouse-face) 415 (set-extent-property txt 'mouse-face gnus-article-mouse-face)
424 (set-extent-property new 'its-partner txt) 416 (set-extent-property new 'its-partner txt)
425 (set-extent-property new 'keymap gnus-picons-map)))))))) 417 (set-extent-property new 'keymap gnus-picons-map)
426 418 (list txt))))))))
427 (defun gnus-picons-reverse-domain-path (str)
428 "a/b/c/d -> d/c/b/a"
429 (mapconcat 'downcase (nreverse (message-tokenize-header str "/")) "/"))
430 419
431 (defun gnus-picons-toggle-extent (event) 420 (defun gnus-picons-toggle-extent (event)
432 "Toggle picon glyph at given point" 421 "Toggle picon glyph at given point"
433 (interactive "e") 422 (interactive "e")
434 (let* ((ant1 (event-glyph-extent event)) 423 (let* ((ant1 (event-glyph-extent event))