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