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