Updated with latest version. Changes include:
[emacs.git] / lisp / gnus-cus.el
bloba83d578bec18fe241b181fbf5c6bb23c44a28c48
1 ;;; gnus-cus.el --- User friendly customization of Gnus
2 ;; Copyright (C) 1995,96 Free Software Foundation, Inc.
3 ;;
4 ;; Author: Per Abrahamsen <abraham@iesd.auc.dk>
5 ;; Keywords: help, news
6 ;; Version: 0.1
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
13 ;; any later version.
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
25 ;;; Commentary:
27 ;;; Code:
29 (require 'custom)
30 (require 'gnus-ems)
31 (require 'browse-url)
32 (eval-when-compile (require 'cl))
34 ;; The following is just helper functions and data, not meant to be set
35 ;; by the user.
36 (defun gnus-make-face (color)
37 ;; Create entry for face with COLOR.
38 (custom-face-lookup color nil nil nil nil nil))
40 (defvar gnus-face-light-name-list
41 '("light blue" "light cyan" "light yellow" "light pink"
42 "pale green" "beige" "orange" "magenta" "violet" "medium purple"
43 "turquoise"))
45 (defvar gnus-face-dark-name-list
46 (list
47 ;; Not all servers have dark blue in rgb.txt.
48 (if (and (eq window-system 'x) (x-color-defined-p "dark blue"))
49 "dark blue"
50 "royal blue")
51 "firebrick" "dark green" "OrangeRed"
52 "dark khaki" "dark violet" "SteelBlue4"))
53 ; CornflowerBlue SeaGreen OrangeRed SteelBlue4 DeepPink3
54 ; DarkOlviveGreen4
56 (custom-declare '()
57 '((tag . "Gnus")
58 (doc . "\
59 The coffee-brewing, all singing, all dancing, kitchen sink newsreader.")
60 (type . group)
61 (data
62 ((tag . "Visual")
63 (doc . "\
64 Gnus can be made colorful and fun or grey and dull as you wish.")
65 (type . group)
66 (data
67 ((tag . "Visual")
68 (doc . "Enable visual features.
69 If `visual' is disabled, there will be no menus and few faces. Most of
70 the visual customization options below will be ignored. Gnus will use
71 less space and be faster as a result.")
72 (default .
73 (summary-highlight group-highlight
74 article-highlight
75 mouse-face
76 summary-menu group-menu article-menu
77 tree-highlight menu highlight
78 browse-menu server-menu
79 page-marker tree-menu binary-menu pick-menu
80 grouplens-menu))
81 (name . gnus-visual)
82 (type . sexp))
83 ((tag . "WWW Browser")
84 (doc . "\
85 WWW Browser to call when clicking on an URL button in the article buffer.
87 You can choose between one of the predefined browsers, or `Other'.")
88 (name . browse-url-browser-function)
89 (calculate . (cond ((boundp 'browse-url-browser-function)
90 browse-url-browser-function)
91 ((fboundp 'w3-fetch)
92 'w3-fetch)
93 ((eq window-system 'x)
94 'gnus-netscape-open-url)))
95 (type . choice)
96 (data
97 ((tag . "W3")
98 (type . const)
99 (default . w3-fetch))
100 ((tag . "Netscape")
101 (type . const)
102 (default . browse-url-netscape))
103 ((prompt . "Other")
104 (doc . "\
105 You must specify the name of a Lisp function here. The lisp function
106 should open a WWW browser when called with an URL (a string).
108 (default . __uninitialized__)
109 (type . symbol))))
110 ((tag . "Mouse Face")
111 (doc . "\
112 Face used for group or summary buffer mouse highlighting.
113 The line beneath the mouse pointer will be highlighted with this
114 face.")
115 (name . gnus-mouse-face)
116 (calculate . (condition-case ()
117 (if (gnus-visual-p 'mouse-face 'highlight)
118 (if (boundp 'gnus-mouse-face)
119 gnus-mouse-face
120 'highlight)
121 'default)
122 (error 'default)))
123 (type . face))
124 ((tag . "Article Display")
125 (doc . "Controls how the article buffer will look.
127 If you leave the list empty, the article will appear exactly as it is
128 stored on the disk. The list entries will hide or highlight various
129 parts of the article, making it easier to find the information you
130 want.")
131 (name . gnus-article-display-hook)
132 (type . list)
133 (calculate
134 . (if (and (string-match "xemacs" emacs-version)
135 (featurep 'xface))
136 '(gnus-article-hide-headers-if-wanted
137 gnus-article-hide-boring-headers
138 gnus-article-treat-overstrike
139 gnus-article-maybe-highlight
140 gnus-article-display-x-face)
141 '(gnus-article-hide-headers-if-wanted
142 gnus-article-hide-boring-headers
143 gnus-article-treat-overstrike
144 gnus-article-maybe-highlight)))
145 (data
146 ((type . repeat)
147 (header . nil)
148 (data
149 (tag . "Filter")
150 (type . choice)
151 (data
152 ((tag . "Treat Overstrike")
153 (doc . "\
154 Convert use of overstrike into bold and underline.
156 Two identical letters separated by a backspace are displayed as a
157 single bold letter, while a letter followed by a backspace and an
158 underscore will be displayed as a single underlined letter. This
159 technique was developed for old line printers (think about it), and is
160 still in use on some newsgroups, in particular the ClariNet
161 hierarchy.
163 (type . const)
164 (default .
165 gnus-article-treat-overstrike))
166 ((tag . "Word Wrap")
167 (doc . "\
168 Format too long lines.
170 (type . const)
171 (default . gnus-article-word-wrap))
172 ((tag . "Remove CR")
173 (doc . "\
174 Remove carriage returns from an article.
176 (type . const)
177 (default . gnus-article-remove-cr))
178 ((tag . "Display X-Face")
179 (doc . "\
180 Look for an X-Face header and display it if present.
182 See also `X Face Command' for a definition of the external command
183 used for decoding and displaying the face.
185 (type . const)
186 (default . gnus-article-display-x-face))
187 ((tag . "Unquote Printable")
188 (doc . "\
189 Transform MIME quoted printable into 8-bit characters.
191 Quoted printable is often seen by strings like `=EF' where you would
192 expect a non-English letter.
194 (type . const)
195 (default .
196 gnus-article-de-quoted-unreadable))
197 ((tag . "Universal Time")
198 (doc . "\
199 Convert date header to universal time.
201 (type . const)
202 (default . gnus-article-date-ut))
203 ((tag . "Local Time")
204 (doc . "\
205 Convert date header to local timezone.
207 (type . const)
208 (default . gnus-article-date-local))
209 ((tag . "Lapsed Time")
210 (doc . "\
211 Replace date header with a header showing the articles age.
213 (type . const)
214 (default . gnus-article-date-lapsed))
215 ((tag . "Highlight")
216 (doc . "\
217 Highlight headers, citations, signature, and buttons.
219 (type . const)
220 (default . gnus-article-highlight))
221 ((tag . "Maybe Highlight")
222 (doc . "\
223 Highlight headers, signature, and buttons if `Visual' is turned on.
225 (type . const)
226 (default .
227 gnus-article-maybe-highlight))
228 ((tag . "Highlight Some")
229 (doc . "\
230 Highlight headers, signature, and buttons.
232 (type . const)
233 (default . gnus-article-highlight-some))
234 ((tag . "Highlight Headers")
235 (doc . "\
236 Highlight headers as specified by `Article Header Highlighting'.
238 (type . const)
239 (default .
240 gnus-article-highlight-headers))
241 ((tag . "Highlight Signature")
242 (doc . "\
243 Highlight the signature as specified by `Article Signature Face'.
245 (type . const)
246 (default .
247 gnus-article-highlight-signature))
248 ((tag . "Citation")
249 (doc . "\
250 Highlight the citations as specified by `Citation Faces'.
252 (type . const)
253 (default .
254 gnus-article-highlight-citation))
255 ((tag . "Hide")
256 (doc . "\
257 Hide unwanted headers, excess citation, and the signature.
259 (type . const)
260 (default . gnus-article-hide))
261 ((tag . "Hide Headers If Wanted")
262 (doc . "\
263 Hide headers, but allow user to display them with `t' or `v'.
265 (type . const)
266 (default .
267 gnus-article-hide-headers-if-wanted))
268 ((tag . "Hide Headers")
269 (doc . "\
270 Hide unwanted headers and possibly sort them as well.
271 Most likely you want to use `Hide Headers If Wanted' instead.
273 (type . const)
274 (default . gnus-article-hide-headers))
275 ((tag . "Hide Signature")
276 (doc . "\
277 Hide the signature.
279 (type . const)
280 (default . gnus-article-hide-signature))
281 ((tag . "Hide Excess Citations")
282 (doc . "\
283 Hide excess citation.
285 Excess is defined by `Citation Hide Percentage' and `Citation Hide Absolute'.
287 (type . const)
288 (default .
289 gnus-article-hide-citation-maybe))
290 ((tag . "Hide Citations")
291 (doc . "\
292 Hide all cited text.
294 (type . const)
295 (default . gnus-article-hide-citation))
296 ((tag . "Add Buttons")
297 (doc . "\
298 Make URL's into clickable buttons.
300 (type . const)
301 (default . gnus-article-add-buttons))
302 ((prompt . "Other")
303 (doc . "\
304 Name of Lisp function to call.
306 Push the `Filter' button to select one of the predefined filters.
308 (type . symbol)))))))
309 ((tag . "Article Button Face")
310 (doc . "\
311 Face used for highlighting buttons in the article buffer.
313 An article button is a piece of text that you can activate by pressing
314 `RET' or `mouse-2' above it.")
315 (name . gnus-article-button-face)
316 (default . bold)
317 (type . face))
318 ((tag . "Article Mouse Face")
319 (doc . "\
320 Face used for mouse highlighting in the article buffer.
322 Article buttons will be displayed in this face when the cursor is
323 above them.")
324 (name . gnus-article-mouse-face)
325 (default . highlight)
326 (type . face))
327 ((tag . "Article Signature Face")
328 (doc . "\
329 Face used for highlighting a signature in the article buffer.")
330 (name . gnus-signature-face)
331 (default . italic)
332 (type . face))
333 ((tag . "Article Header Highlighting")
334 (doc . "\
335 Controls highlighting of article header.
337 Below is a list of article header names, and the faces used for
338 displaying the name and content of the header. The `Header' field
339 should contain the name of the header. The field actually contains a
340 regular expression that should match the beginning of the header line,
341 but if you don't know what a regular expression is, just write the
342 name of the header. The second field is the `Name' field, which
343 determines how the the header name (i.e. the part of the header left
344 of the `:') is displayed. The third field is the `Content' field,
345 which determines how the content (i.e. the part of the header right of
346 the `:') is displayed.
348 If you leave the last `Header' field in the list empty, the `Name' and
349 `Content' fields will determine how headers not listed above are
350 displayed.
352 If you only want to change the display of the name part for a specific
353 header, specify `None' in the `Content' field. Similarly, specify
354 `None' in the `Name' field if you only want to leave the name part
355 alone.")
356 (name . gnus-header-face-alist)
357 (type . list)
358 (calculate
359 . (cond
360 ((not (eq gnus-display-type 'color))
361 '(("" bold italic)))
362 ((eq gnus-background-mode 'dark)
363 (list
364 (list "From" nil
365 (custom-face-lookup "light blue" nil nil t t nil))
366 (list "Subject" nil
367 (custom-face-lookup "pink" nil nil t t nil))
368 (list "Newsgroups:.*," nil
369 (custom-face-lookup "yellow" nil nil t t nil))
370 (list
372 (custom-face-lookup "cyan" nil nil t nil nil)
373 (custom-face-lookup "forestgreen" nil nil nil t
374 nil))))
376 (list
377 (list "From" nil
378 (custom-face-lookup "MidnightBlue" nil nil t t nil))
379 (list "Subject" nil
380 (custom-face-lookup "firebrick" nil nil t t nil))
381 (list "Newsgroups:.*," nil
382 (custom-face-lookup "indianred" nil nil t t nil))
383 (list ""
384 (custom-face-lookup
385 "DarkGreen" nil nil t nil nil)
386 (custom-face-lookup "DarkGreen" nil nil
387 nil t nil))))))
388 (data
389 ((type . repeat)
390 (header . nil)
391 (data
392 (type . list)
393 (compact . t)
394 (data
395 ((type . string)
396 (prompt . "Header")
397 (tag . "Header "))
398 "\n "
399 ((type . face)
400 (prompt . "Name")
401 (tag . "Name "))
402 "\n "
403 ((type . face)
404 (tag . "Content"))
405 "\n")))))
406 ((tag . "Attribution Face")
407 (doc . "\
408 Face used for attribution lines.
409 It is merged with the face for the cited text belonging to the attribution.")
410 (name . gnus-cite-attribution-face)
411 (default . underline)
412 (type . face))
413 ((tag . "Citation Faces")
414 (doc . "\
415 List of faces used for highlighting citations.
417 When there are citations from multiple articles in the same message,
418 Gnus will try to give each citation from each article its own face.
419 This should make it easier to see who wrote what.")
420 (name . gnus-cite-face-list)
421 (import . gnus-custom-import-cite-face-list)
422 (type . list)
423 (calculate . (cond ((not (eq gnus-display-type 'color))
424 '(italic))
425 ((eq gnus-background-mode 'dark)
426 (mapcar 'gnus-make-face
427 gnus-face-light-name-list))
429 (mapcar 'gnus-make-face
430 gnus-face-dark-name-list))))
431 (data
432 ((type . repeat)
433 (header . nil)
434 (data (type . face)
435 (tag . "Face")))))
436 ((tag . "Citation Hide Percentage")
437 (doc . "\
438 Only hide excess citation if above this percentage of the body.")
439 (name . gnus-cite-hide-percentage)
440 (default . 50)
441 (type . integer))
442 ((tag . "Citation Hide Absolute")
443 (doc . "\
444 Only hide excess citation if above this number of lines in the body.")
445 (name . gnus-cite-hide-absolute)
446 (default . 10)
447 (type . integer))
448 ((tag . "Summary Selected Face")
449 (doc . "\
450 Face used for highlighting the current article in the summary buffer.")
451 (name . gnus-summary-selected-face)
452 (default . underline)
453 (type . face))
454 ((tag . "Summary Line Highlighting")
455 (doc . "\
456 Controls the highlighting of summary buffer lines.
458 Below is a list of `Form'/`Face' pairs. When deciding how a a
459 particular summary line should be displayed, each form is
460 evaluated. The content of the face field after the first true form is
461 used. You can change how those summary lines are displayed, by
462 editing the face field.
464 It is also possible to change and add form fields, but currently that
465 requires an understanding of Lisp expressions. Hopefully this will
466 change in a future release. For now, you can use the following
467 variables in the Lisp expression:
469 score: The article's score
470 default: The default article score.
471 below: The score below which articles are automatically marked as read.
472 mark: The article's mark.")
473 (name . gnus-summary-highlight)
474 (type . list)
475 (calculate
476 . (cond
477 ((not (eq gnus-display-type 'color))
478 '(((> score default) . bold)
479 ((< score default) . italic)))
480 ((eq gnus-background-mode 'dark)
481 (list
482 (cons
483 '(= mark gnus-canceled-mark)
484 (custom-face-lookup "yellow" "black" nil
485 nil nil nil))
486 (cons '(and (> score default)
487 (or (= mark gnus-dormant-mark)
488 (= mark gnus-ticked-mark)))
489 (custom-face-lookup
490 "pink" nil nil t nil nil))
491 (cons '(and (< score default)
492 (or (= mark gnus-dormant-mark)
493 (= mark gnus-ticked-mark)))
494 (custom-face-lookup "pink" nil nil
495 nil t nil))
496 (cons '(or (= mark gnus-dormant-mark)
497 (= mark gnus-ticked-mark))
498 (custom-face-lookup
499 "pink" nil nil nil nil nil))
501 (cons
502 '(and (> score default) (= mark gnus-ancient-mark))
503 (custom-face-lookup "medium blue" nil nil t
504 nil nil))
505 (cons
506 '(and (< score default) (= mark gnus-ancient-mark))
507 (custom-face-lookup "SkyBlue" nil nil
508 nil t nil))
509 (cons
510 '(= mark gnus-ancient-mark)
511 (custom-face-lookup "SkyBlue" nil nil
512 nil nil nil))
513 (cons '(and (> score default) (= mark gnus-unread-mark))
514 (custom-face-lookup "white" nil nil t
515 nil nil))
516 (cons '(and (< score default) (= mark gnus-unread-mark))
517 (custom-face-lookup "white" nil nil
518 nil t nil))
519 (cons '(= mark gnus-unread-mark)
520 (custom-face-lookup
521 "white" nil nil nil nil nil))
523 (cons '(> score default) 'bold)
524 (cons '(< score default) 'italic)))
526 (list
527 (cons
528 '(= mark gnus-canceled-mark)
529 (custom-face-lookup
530 "yellow" "black" nil nil nil nil))
531 (cons '(and (> score default)
532 (or (= mark gnus-dormant-mark)
533 (= mark gnus-ticked-mark)))
534 (custom-face-lookup "firebrick" nil nil
535 t nil nil))
536 (cons '(and (< score default)
537 (or (= mark gnus-dormant-mark)
538 (= mark gnus-ticked-mark)))
539 (custom-face-lookup "firebrick" nil nil
540 nil t nil))
541 (cons
542 '(or (= mark gnus-dormant-mark)
543 (= mark gnus-ticked-mark))
544 (custom-face-lookup
545 "firebrick" nil nil nil nil nil))
547 (cons '(and (> score default) (= mark gnus-ancient-mark))
548 (custom-face-lookup "RoyalBlue" nil nil
549 t nil nil))
550 (cons '(and (< score default) (= mark gnus-ancient-mark))
551 (custom-face-lookup "RoyalBlue" nil nil
552 nil t nil))
553 (cons
554 '(= mark gnus-ancient-mark)
555 (custom-face-lookup
556 "RoyalBlue" nil nil nil nil nil))
558 (cons '(and (> score default) (/= mark gnus-unread-mark))
559 (custom-face-lookup "DarkGreen" nil nil
560 t nil nil))
561 (cons '(and (< score default) (/= mark gnus-unread-mark))
562 (custom-face-lookup "DarkGreen" nil nil
563 nil t nil))
564 (cons
565 '(/= mark gnus-unread-mark)
566 (custom-face-lookup "DarkGreen" nil nil
567 nil nil nil))
569 (cons '(> score default) 'bold)
570 (cons '(< score default) 'italic)))))
571 (data
572 ((type . repeat)
573 (header . nil)
574 (data (type . pair)
575 (compact . t)
576 (data ((type . sexp)
577 (width . 60)
578 (tag . "Form"))
579 "\n "
580 ((type . face)
581 (tag . "Face"))
582 "\n")))))
584 ((tag . "Group Line Highlighting")
585 (doc . "\
586 Controls the highlighting of group buffer lines.
588 Below is a list of `Form'/`Face' pairs. When deciding how a a
589 particular group line should be displayed, each form is
590 evaluated. The content of the face field after the first true form is
591 used. You can change how those group lines are displayed by
592 editing the face field.
594 It is also possible to change and add form fields, but currently that
595 requires an understanding of Lisp expressions. Hopefully this will
596 change in a future release. For now, you can use the following
597 variables in the Lisp expression:
599 group: The name of the group.
600 unread: The number of unread articles in the group.
601 method: The select method used.
602 mailp: Whether it's a mail group or not.
603 level: The level of the group.
604 score: The score of the group.
605 ticked: The number of ticked articles.")
606 (name . gnus-group-highlight)
607 (type . list)
608 (calculate
609 . (cond
610 ((not (eq gnus-display-type 'color))
611 '((mailp . bold)
612 ((= unread 0) . italic)))
613 ((eq gnus-background-mode 'dark)
614 `(((and (not mailp) (eq level 1)) .
615 ,(custom-face-lookup "PaleTurquoise" nil nil t))
616 ((and (not mailp) (eq level 2)) .
617 ,(custom-face-lookup "turquoise" nil nil t))
618 ((and (not mailp) (eq level 3)) .
619 ,(custom-face-lookup "MediumTurquoise" nil nil t))
620 ((and (not mailp) (>= level 4)) .
621 ,(custom-face-lookup "DarkTurquoise" nil nil t))
622 ((and mailp (eq level 1)) .
623 ,(custom-face-lookup "aquamarine1" nil nil t))
624 ((and mailp (eq level 2)) .
625 ,(custom-face-lookup "aquamarine2" nil nil t))
626 ((and mailp (eq level 3)) .
627 ,(custom-face-lookup "aquamarine3" nil nil t))
628 ((and mailp (>= level 4)) .
629 ,(custom-face-lookup "aquamarine4" nil nil t))
632 `(((and (not mailp) (<= level 3)) .
633 ,(custom-face-lookup "ForestGreen" nil nil t))
634 ((and (not mailp) (eq level 4)) .
635 ,(custom-face-lookup "DarkGreen" nil nil t))
636 ((and (not mailp) (eq level 5)) .
637 ,(custom-face-lookup "CadetBlue4" nil nil t))
638 ((and mailp (eq level 1)) .
639 ,(custom-face-lookup "DeepPink3" nil nil t))
640 ((and mailp (eq level 2)) .
641 ,(custom-face-lookup "HotPink3" nil nil t))
642 ((and mailp (eq level 3)) .
643 ,(custom-face-lookup
644 ;; Not all servers have dark magenta in rgb.txt.
645 (if (and (eq window-system 'x)
646 (x-color-defined-p "dark magenta"))
647 "dark magenta"
648 "maroon")
649 nil nil t))
650 ((and mailp (eq level 4)) .
651 ,(custom-face-lookup "DeepPink4" nil nil t))
652 ((and mailp (> level 4)) .
653 ,(custom-face-lookup "DarkOrchid4" nil nil t))
654 ))))
655 (data
656 ((type . repeat)
657 (header . nil)
658 (data (type . pair)
659 (compact . t)
660 (data ((type . sexp)
661 (width . 60)
662 (tag . "Form"))
663 "\n "
664 ((type . face)
665 (tag . "Face"))
666 "\n")))))
668 ;; Do not define `gnus-button-alist' before we have
669 ;; some `complexity' attribute so we can hide it from
670 ;; beginners.
671 )))))
673 (defun gnus-custom-import-cite-face-list (custom alist)
674 ;; Backward compatible grokking of light and dark.
675 (cond ((eq alist 'light)
676 (setq alist (mapcar 'gnus-make-face gnus-face-light-name-list)))
677 ((eq alist 'dark)
678 (setq alist (mapcar 'gnus-make-face gnus-face-dark-name-list))))
679 (funcall (custom-super custom 'import) custom alist))
681 (provide 'gnus-cus)
683 ;;; gnus-cus.el ends here