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