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