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

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