lisp/gnus-cus.el

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