cgit.sxemacs.org Git - gnus/blob - lisp/gnus-cus.el

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