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