diff lisp/gnus/gnus-cus.el @ 70:131b0175ea99 r20-0b30

Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents ec9a17fef872
children 0d2f883870bc
line wrap: on
line diff
--- a/lisp/gnus/gnus-cus.el	Mon Aug 13 09:00:04 2007 +0200
+++ b/lisp/gnus/gnus-cus.el	Mon Aug 13 09:02:59 2007 +0200
@@ -1,9 +1,9 @@
-;;; gnus-cus.el --- customization commands for Gnus
+;;; gnus-cus.el --- User friendly customization of Gnus
+;; Copyright (C) 1995,96 Free Software Foundation, Inc.
 ;;
-;; Copyright (C) 1996 Free Software Foundation, Inc.
-
-;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
-;; Keywords: news
+;; Author: Per Abrahamsen <abraham@iesd.auc.dk>
+;; Keywords: help, news
+;; Version: 0.1
 
 ;; This file is part of GNU Emacs.
 
@@ -14,7 +14,7 @@
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.	 See the
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
@@ -26,625 +26,647 @@
 
 ;;; Code:
 
-(require 'wid-edit)
-(require 'gnus-score)
-
-;;; Widgets:
+(require 'custom)
+(require 'gnus-ems)
+(require 'browse-url)
+(eval-when-compile (require 'cl))
 
-;; There should be special validation for this.
-(define-widget 'gnus-email-address 'string
-  "An email address")
-
-(defun gnus-custom-mode ()
-  "Major mode for editing Gnus customization buffers.
-
-The following commands are available:
+;; The following is just helper functions and data, not meant to be set
+;; by the user.
+(defun gnus-make-face (color)
+  ;; Create entry for face with COLOR.
+  (custom-face-lookup color nil nil nil nil nil))
 
-\\[widget-forward]		Move to next button or editable field.
-\\[widget-backward]		Move to previous button or editable field.
-\\[widget-button-click]		Activate button under the mouse pointer.
-\\[widget-button-press]		Activate button under point.
+(defvar gnus-face-light-name-list
+  '("light blue" "light cyan" "light yellow" "light pink"
+    "pale green" "beige" "orange" "magenta" "violet" "medium purple"
+    "turquoise"))
 
-Entry to this mode calls the value of `gnus-custom-mode-hook'
-if that value is non-nil."
-  (kill-all-local-variables)
-  (setq major-mode 'gnus-custom-mode
-	mode-name "Gnus Customize")
-  (use-local-map widget-keymap)
-  (run-hooks 'gnus-custom-mode-hook))
-
-;;; Group Customization:
-
-(defconst gnus-group-parameters
-  '((to-address (gnus-email-address :tag "To Address") "\
-This will be used when doing followups and posts.
+(defvar gnus-face-dark-name-list
+  '("dark blue" "firebrick" "dark green" "OrangeRed" 
+    "dark khaki" "dark violet" "SteelBlue4"))
+; CornflowerBlue SeaGreen OrangeRed SteelBlue4 DeepPink3
+; DarkOlviveGreen4 
 
-This is primarily useful in mail groups that represent closed
-mailing lists--mailing lists where it's expected that everybody that
-writes to the mailing list is subscribed to it.  Since using this
-parameter ensures that the mail only goes to the mailing list itself,
-it means that members won't receive two copies of your followups.
-
-Using `to-address' will actually work whether the group is foreign or
-not.  Let's say there's a group on the server that is called
-`fa.4ad-l'.  This is a real newsgroup, but the server has gotten the
-articles from a mail-to-news gateway.  Posting directly to this group
-is therefore impossible--you have to send mail to the mailing list
-address instead.")
-
-    (to-list (gnus-email-address :tag "To List") "\
-This address will be used when doing a `a' in the group.
-
-It is totally ignored when doing a followup--except that if it is
-present in a news group, you'll get mail group semantics when doing
-`f'.")
-
-    (broken-reply-to (const :tag "Broken Reply To" t) "\
-Ignore `Reply-To' headers in this group.
-
-That can be useful if you're reading a mailing list group where the
-listserv has inserted `Reply-To' headers that point back to the
-listserv itself.  This is broken behavior.  So there!")
-
-    (to-group (string :tag "To Group") "\
-All posts will be send to the specified group.")
-
-    (gcc-self (choice :tag  "GCC"
-		      :value t
-		      (const t)
-		      (const none)
-		      (string :format "%v" :hide-front-space t)) "\
-Specify default value for GCC header.
+(custom-declare '()
+  '((tag . "Gnus")
+    (doc . "\
+The coffee-brewing, all singing, all dancing, kitchen sink newsreader.")
+    (type . group)
+    (data
+     ((tag . "Visual")
+      (doc . "\
+Gnus can be made colorful and fun or grey and dull as you wish.")
+      (type . group)
+      (data
+       ((tag . "Visual")
+	(doc . "Enable visual features.
+If `visual' is disabled, there will be no menus and few faces.  Most of
+the visual customization options below will be ignored.  Gnus will use
+less space and be faster as a result.")
+	(default . 
+	  (summary-highlight group-highlight
+			     article-highlight 
+			     mouse-face
+			     summary-menu group-menu article-menu
+			     tree-highlight menu highlight
+			     browse-menu server-menu
+			     page-marker tree-menu binary-menu pick-menu
+			     grouplens-menu))
+	(name . gnus-visual)
+	(type . sexp))
+       ((tag . "WWW Browser")
+	(doc . "\
+WWW Browser to call when clicking on an URL button in the article buffer.
 
-If this symbol is present in the group parameter list and set to `t',
-new composed messages will be `Gcc''d to the current group. If it is
-present and set to `none', no `Gcc:' header will be generated, if it
-is present and a string, this string will be inserted literally as a
-`gcc' header (this symbol takes precedence over any default `Gcc'
-rules as described later).")
-
-    (auto-expire (const :tag "Automatic Expire" t) "\
-All articles that are read will be marked as expirable.")
-
-    (total-expire (const :tag "Total Expire" t) "\
-All read articles will be put through the expiry process
-
-This happens even if they are not marked as expirable.
-Use with caution.")
-
-    (expiry-wait (choice :tag  "Expire Wait"
-			 :value never
-			 (const never)
-			 (const immediate)
-			 (number :hide-front-space t
-				 :format "%v")) "\
-When to expire.
-
-Overrides any `nnmail-expiry-wait' and `nnmail-expiry-wait-function'
-when expiring expirable messages. The value can either be a number of
-days (not necessarily an integer) or the symbols `never' or
-`immediate'.")
-
-    (score-file (file :tag "Score File") "\
-Make the specified file into the current score file.
-This means that all score commands you issue will end up in this file.")
+You can choose between one of the predefined browsers, or `Other'.")
+	(name . browse-url-browser-function)
+	(calculate . (cond ((boundp 'browse-url-browser-function)
+			    browse-url-browser-function)
+			   ((fboundp 'w3-fetch) 
+			    'w3-fetch)
+			   ((eq window-system 'x) 
+			    'gnus-netscape-open-url)))
+	(type . choice)
+	(data
+	 ((tag . "W3")
+	  (type . const)
+	  (default . w3-fetch))
+	 ((tag . "Netscape")
+	  (type . const)
+	  (default . browse-url-netscape))
+	 ((prompt . "Other")
+	  (doc . "\
+You must specify the name of a Lisp function here.  The lisp function
+should open a WWW browser when called with an URL (a string).
+")
+	  (default . __uninitialized__)
+	  (type . symbol))))
+       ((tag . "Mouse Face")
+	(doc . "\
+Face used for group or summary buffer mouse highlighting.
+The line beneath the mouse pointer will be highlighted with this
+face.")
+	(name . gnus-mouse-face)
+	(calculate . (condition-case ()
+			 (if (gnus-visual-p 'mouse-face 'highlight)
+			     (if (boundp 'gnus-mouse-face)
+				 gnus-mouse-face
+			       'highlight)
+			   'default)
+		       (error nil)))
+	(type . face))
+       ((tag . "Article Display")
+	(doc . "Controls how the article buffer will look.
 
-    (adapt-file (file :tag "Adapt File") "\
-Make the specified file into the current adaptive file.
-All adaptive score entries will be put into this file.")
-
-    (admin-address (gnus-email-address :tag "Admin Address") "\
-Administration address for a mailing list.
-
-When unsubscribing to a mailing list you should never send the
-unsubscription notice to the mailing list itself.  Instead, you'd
-send messages to the administrative address.  This parameter allows
-you to put the admin address somewhere convenient.")
-
-    (display (choice :tag "Display"
-		     :value default
-		     (const all)
-		     (const default)) "\
-Which articles to display on entering the group.
+If you leave the list empty, the article will appear exactly as it is
+stored on the disk.  The list entries will hide or highlight various
+parts of the article, making it easier to find the information you
+want.")
+	(name . gnus-article-display-hook)
+	(type . list)
+	(calculate 
+	 . (if (and (string-match "xemacs" emacs-version)
+		    (featurep 'xface))
+	       '(gnus-article-hide-headers-if-wanted
+		gnus-article-hide-boring-headers
+		gnus-article-treat-overstrike
+		gnus-article-maybe-highlight
+		gnus-article-display-x-face)
+	     '(gnus-article-hide-headers-if-wanted
+	      gnus-article-hide-boring-headers
+	      gnus-article-treat-overstrike
+	      gnus-article-maybe-highlight)))
+	(data 
+	 ((type . repeat)
+	  (header . nil)
+	  (data
+	   (tag . "Filter")
+	   (type . choice)
+	   (data
+	    ((tag . "Treat Overstrike")
+	     (doc . "\
+Convert use of overstrike into bold and underline.
 
-`all'
-     Display all articles, both read and unread.
-
-`default'
-     Display the default visible articles, which normally includes
-     unread and ticked articles.")
+Two identical letters separated by a backspace are displayed as a
+single bold letter, while a letter followed by a backspace and an
+underscore will be displayed as a single underlined letter.  This
+technique was developed for old line printers (think about it), and is
+still in use on some newsgroups, in particular the ClariNet
+hierarchy.
+")
+	     (type . const)
+	     (default . 
+	       gnus-article-treat-overstrike))
+	    ((tag . "Word Wrap")
+	     (doc . "\
+Format too long lines.
+")
+	     (type . const)
+	     (default . gnus-article-word-wrap))
+	    ((tag . "Remove CR")
+	     (doc . "\
+Remove carriage returns from an article.
+")
+	     (type . const)
+	     (default . gnus-article-remove-cr))
+	    ((tag . "Display X-Face")
+	     (doc . "\
+Look for an X-Face header and display it if present.
 
-    (comment (string :tag  "Comment") "\
-An arbitrary comment on the group."))
-  "Alist of valid group parameters.
-
-Each entry has the form (NAME TYPE DOC), where NAME is the parameter
-itself (a symbol), TYPE is the parameters type (a sexp widget), and
-DOC is a documentation string for the parameter.")
-
-(defvar gnus-custom-params)
-(defvar gnus-custom-method)
-(defvar gnus-custom-group)
+See also `X Face Command' for a definition of the external command
+used for decoding and displaying the face.
+")
+	     (type . const)
+	     (default . gnus-article-display-x-face))
+	    ((tag . "Unquote Printable")
+	     (doc . "\
+Transform MIME quoted printable into 8-bit characters.
 
-(defun gnus-group-customize (group &optional part)
-  "Edit the group on the current line."
-  (interactive (list (gnus-group-group-name)))
-  (let ((part (or part 'info))
-	info
-	(types (mapcar (lambda (entry)
-			 `(cons :format "%v%h\n"
-				:doc ,(nth 2 entry)
-				(const :format "" ,(nth 0 entry))
-				,(nth 1 entry)))
-		       gnus-group-parameters)))
-    (unless group
-      (error "No group on current line"))
-    (unless (setq info (gnus-get-info group))
-      (error "Killed group; can't be edited"))
-    ;; Ready.
-    (kill-buffer (get-buffer-create "*Gnus Customize*"))
-    (switch-to-buffer (get-buffer-create "*Gnus Customize*"))
-    (gnus-custom-mode)
-    (make-local-variable 'gnus-custom-group)
-    (setq gnus-custom-group group)
-    (widget-insert "Customize the ")
-    (widget-create 'info-link
-		   :help-echo "Push me to learn more."
-		   :tag "group parameters"
-		   "(gnus)Group Parameters")
-    (widget-insert " for <")
-    (widget-insert group)
-    (widget-insert "> and press ")
-    (widget-create 'push-button
-		   :tag "done"
-		   :help-echo "Push me when done customizing."
-		   :action 'gnus-group-customize-done)
-    (widget-insert ".\n\n")
-    (make-local-variable 'gnus-custom-params)
-    (setq gnus-custom-params
-	  (widget-create 'group
-			 :value (gnus-info-params info)
-			 `(set :inline t
-			       :greedy t
-			       :tag "Parameters"
-			       :format "%t:\n%h%v"
-			       :doc "\
-These special paramerters are recognized by Gnus.
-Check the [ ] for the parameters you want to apply to this group, then
-edit the value to suit your taste."
-			       ,@types)
-			 '(repeat :inline t
-				  :tag "Variables"
-				  :format "%t:\n%h%v%i\n\n"
-				  :doc "\
-Set variables local to the group you are entering.
-
-If you want to turn threading off in `news.answers', you could put
-`(gnus-show-threads nil)' in the group parameters of that group.
-`gnus-show-threads' will be made into a local variable in the summary
-buffer you enter, and the form `nil' will be `eval'ed there.
-
-This can also be used as a group-specific hook function, if you'd
-like.  If you want to hear a beep when you enter a group, you could
-put something like `(dummy-variable (ding))' in the parameters of that
-group.  `dummy-variable' will be set to the result of the `(ding)'
-form, but who cares?"
-				  (group :value (nil nil)
-					 (symbol :tag "Variable")
-					 (sexp :tag
-					       "Value")))
+Quoted printable is often seen by strings like `=EF' where you would
+expect a non-English letter.
+")
+	     (type . const)
+	     (default .
+	       gnus-article-de-quoted-unreadable))
+	    ((tag . "Universal Time")
+	     (doc . "\
+Convert date header to universal time.
+")
+	     (type . const)
+	     (default . gnus-article-date-ut))
+	    ((tag . "Local Time")
+	     (doc . "\
+Convert date header to local timezone.
+")
+	     (type . const)
+	     (default . gnus-article-date-local))
+	    ((tag . "Lapsed Time")
+	     (doc . "\
+Replace date header with a header showing the articles age.
+")
+	     (type . const)
+	     (default . gnus-article-date-lapsed))
+	    ((tag . "Highlight")
+	     (doc . "\
+Highlight headers, citations, signature, and buttons.
+")
+	     (type . const)
+	     (default . gnus-article-highlight))
+	    ((tag . "Maybe Highlight")
+	     (doc . "\
+Highlight headers, signature, and buttons if `Visual' is turned on.
+")
+	     (type . const)
+	     (default . 
+	       gnus-article-maybe-highlight))
+	    ((tag . "Highlight Some")
+	     (doc . "\
+Highlight headers, signature, and buttons.
+")
+	     (type . const)
+	     (default . gnus-article-highlight-some))
+	    ((tag . "Highlight Headers")
+	     (doc . "\
+Highlight headers as specified by `Article Header Highlighting'.
+")
+	     (type . const)
+	     (default .
+	       gnus-article-highlight-headers))
+	    ((tag . "Highlight Signature")
+	     (doc . "\
+Highlight the signature as specified by `Article Signature Face'.
+")
+	     (type . const)
+	     (default .
+	       gnus-article-highlight-signature))
+	    ((tag . "Citation")
+	     (doc . "\
+Highlight the citations as specified by `Citation Faces'.
+")
+	     (type . const)
+	     (default . 
+	       gnus-article-highlight-citation))
+	    ((tag . "Hide")
+	     (doc . "\
+Hide unwanted headers, excess citation, and the signature.
+")
+	     (type . const)
+	     (default . gnus-article-hide))
+	    ((tag . "Hide Headers If Wanted")
+	     (doc . "\
+Hide headers, but allow user to display them with `t' or `v'.
+")
+	     (type . const)
+	     (default . 
+	       gnus-article-hide-headers-if-wanted))
+	    ((tag . "Hide Headers")
+	     (doc . "\
+Hide unwanted headers and possibly sort them as well.
+Most likely you want to use `Hide Headers If Wanted' instead.
+")
+	     (type . const)
+	     (default . gnus-article-hide-headers))
+	    ((tag . "Hide Signature")
+	     (doc . "\
+Hide the signature.
+")
+	     (type . const)
+	     (default . gnus-article-hide-signature))
+	    ((tag . "Hide Excess Citations")
+	     (doc . "\
+Hide excess citation.
 
-			 '(repeat :inline t
-				  :tag "Unknown entries"
-				  sexp)))
-    (widget-insert "\n\nYou can also edit the ")
-    (widget-create 'info-link
-		   :tag "select method"
-		   :help-echo "Push me to learn more about select methods."
-		   "(gnus)Select Methods")
-    (widget-insert " for the group.\n")
-    (setq gnus-custom-method
-	  (widget-create 'sexp
-			 :tag "Method"
-			 :value (gnus-info-method info)))
-    (use-local-map widget-keymap)
-    (widget-setup)))
+Excess is defined by `Citation Hide Percentage' and `Citation Hide Absolute'.
+")
+	     (type . const)
+	     (default . 
+	       gnus-article-hide-citation-maybe))
+	    ((tag . "Hide Citations")
+	     (doc . "\
+Hide all cited text.
+")
+	     (type . const)
+	     (default . gnus-article-hide-citation))
+	    ((tag . "Add Buttons")
+	     (doc . "\
+Make URL's into clickable buttons.
+")
+	     (type . const)
+	     (default . gnus-article-add-buttons))
+	    ((prompt . "Other")
+	     (doc . "\
+Name of Lisp function to call.
 
-(defun gnus-group-customize-done (&rest ignore)
-  "Apply changes and bury the buffer."
-  (interactive)
-  (gnus-group-edit-group-done 'params gnus-custom-group
-			      (widget-value gnus-custom-params))
-  (gnus-group-edit-group-done 'method gnus-custom-group
-			      (widget-value gnus-custom-method))
-  (bury-buffer))
-
-;;; Score Customization:
-
-(defconst gnus-score-parameters
-  '((mark (number :tag "Mark") "\
-The value of this entry should be a number.
-Any articles with a score lower than this number will be marked as read.")
-
-    (expunge (number :tag "Expunge") "\
-The value of this entry should be a number.
-Any articles with a score lower than this number will be removed from
-the summary buffer.")
-
-    (mark-and-expunge (number :tag "Mark-and-expunge") "\
-The value of this entry should be a number.
-Any articles with a score lower than this number will be marked as
-read and removed from the summary buffer.")
+Push the `Filter' button to select one of the predefined filters.
+")
+	     (type . symbol)))))))
+       ((tag . "Article Button Face")
+	(doc . "\
+Face used for highlighting buttons in the article buffer.
 
-    (thread-mark-and-expunge (number :tag "Thread-mark-and-expunge") "\
-The value of this entry should be a number.
-All articles that belong to a thread that has a total score below this
-number will be marked as read and removed from the summary buffer.
-`gnus-thread-score-function' says how to compute the total score
-for a thread.")
-
-    (files (repeat :tag "Files" file) "\
-The value of this entry should be any number of file names.
-These files are assumed to be score files as well, and will be loaded
-the same way this one was.")
-
-    (exclude-files (repeat :tag "Exclude-files" file) "\
-The clue of this entry should be any number of files.
-These files will not be loaded, even though they would normally be so,
-for some reason or other.")
-
-    (eval (sexp :tag "Eval" :value nil) "\
-The value of this entry will be `eval'el.
-This element will be ignored when handling global score files.")
+An article button is a piece of text that you can activate by pressing
+`RET' or `mouse-2' above it.")
+	(name . gnus-article-button-face)
+	(default . bold)
+	(type . face))
+       ((tag . "Article Mouse Face")
+	(doc . "\
+Face used for mouse highlighting in the article buffer.
 
-    (read-only (boolean :tag "Read-only" :value t) "\
-Read-only score files will not be updated or saved.
-Global score files should feature this atom.")
-
-    (orphan (number :tag "Orphan") "\
-The value of this entry should be a number.
-Articles that do not have parents will get this number added to their
-scores.  Imagine you follow some high-volume newsgroup, like
-`comp.lang.c'.  Most likely you will only follow a few of the threads,
-also want to see any new threads.
-
-You can do this with the following two score file entries:
+Article buttons will be displayed in this face when the cursor is
+above them.")
+	(name . gnus-article-mouse-face)
+	(default . highlight)
+	(type . face))
+       ((tag . "Article Signature Face")
+	(doc . "\
+Face used for highlighting a signature in the article buffer.")
+	(name . gnus-signature-face)
+	(default . italic)
+	(type . face))
+       ((tag . "Article Header Highlighting")
+	(doc . "\
+Controls highlighting of article header.
 
-     (orphan -500)
-     (mark-and-expunge -100)
+Below is a list of article header names, and the faces used for
+displaying the name and content of the header.  The `Header' field
+should contain the name of the header.  The field actually contains a
+regular expression that should match the beginning of the header line,
+but if you don't know what a regular expression is, just write the
+name of the header.  The second field is the `Name' field, which
+determines how the header name (i.e. the part of the header left
+of the `:') is displayed.  The third field is the `Content' field,
+which determines how the content (i.e. the part of the header right of
+the `:') is displayed.  
 
-When you enter the group the first time, you will only see the new
-threads.  You then raise the score of the threads that you find
-interesting (with `I T' or `I S'), and ignore (`C y') the rest.
-Next time you enter the group, you will see new articles in the
-interesting threads, plus any new threads.
-
-I.e.---the orphan score atom is for high-volume groups where there
-exist a few interesting threads which can't be found automatically
-by ordinary scoring rules.")
+If you leave the last `Header' field in the list empty, the `Name' and
+`Content' fields will determine how headers not listed above are
+displayed.  
 
-    (adapt (choice :tag "Adapt"
-		   (const t)
-		   (const ignore)
-		   (sexp :format "%v"
-			 :hide-front-space t)) "\
-This entry controls the adaptive scoring.
-If it is `t', the default adaptive scoring rules will be used.  If it
-is `ignore', no adaptive scoring will be performed on this group.  If
-it is a list, this list will be used as the adaptive scoring rules.
-If it isn't present, or is something other than `t' or `ignore', the
-default adaptive scoring rules will be used.  If you want to use
-adaptive scoring on most groups, you'd set `gnus-use-adaptive-scoring'
-to `t', and insert an `(adapt ignore)' in the groups where you do not
-want adaptive scoring.  If you only want adaptive scoring in a few
-groups, you'd set `gnus-use-adaptive-scoring' to `nil', and insert
-`(adapt t)' in the score files of the groups where you want it.")
-
-    (adapt-file (file :tag "Adapt-file") "\
-All adaptive score entries will go to the file named by this entry.
-It will also be applied when entering the group.  This atom might
-be handy if you want to adapt on several groups at once, using the
-same adaptive file for a number of groups.")
-
-    (local (repeat :tag "Local"
-		   (group :value (nil nil)
-			  (symbol :tag "Variable")
-			  (sexp :tag "Value"))) "\
-The value of this entry should be a list of `(VAR VALUE)' pairs.
-Each VAR will be made buffer-local to the current summary buffer,
-and set to the value specified.  This is a convenient, if somewhat
-strange, way of setting variables in some groups if you don't like
-hooks much.")
-    (touched (sexp :format "Touched\n") "Internal variable."))
-  "Alist of valid symbolic score parameters.
-
-Each entry has the form (NAME TYPE DOC), where NAME is the parameter
-itself (a symbol), TYPE is the parameters type (a sexp widget), and DOC is a
-documentation string for the parameter.")
-
-(define-widget 'gnus-score-string 'group
-  "Edit score entries for string-valued headers."
-  :convert-widget 'gnus-score-string-convert)
+If you only want to change the display of the name part for a specific
+header, specify `None' in the `Content' field.  Similarly, specify
+`None' in the `Name' field if you only want to leave the name part
+alone.")
+	(name . gnus-header-face-alist)
+	(type . list)
+	(calculate
+	 . (cond 
+	    ((not (eq gnus-display-type 'color))
+	     '(("" bold italic)))
+	    ((eq gnus-background-mode 'dark)
+	     (list 
+	      (list "From" nil 
+		    (custom-face-lookup "light blue" nil nil t t nil))
+	      (list "Subject" nil 
+		    (custom-face-lookup "pink" nil nil t t nil))
+	      (list "Newsgroups:.*," nil
+		    (custom-face-lookup "yellow" nil nil t t nil))
+	      (list 
+	       "" 
+	       (custom-face-lookup "cyan" nil nil t nil nil)
+	       (custom-face-lookup "forestgreen" nil nil nil t 
+				   nil))))
+	    (t
+	     (list
+	      (list "From" nil
+		    (custom-face-lookup "MidnightBlue" nil nil t t nil))
+	      (list "Subject" nil 
+		    (custom-face-lookup "firebrick" nil nil t t nil))
+	      (list "Newsgroups:.*," nil
+		    (custom-face-lookup "indianred" nil nil t t nil))
+	      (list ""
+		    (custom-face-lookup 
+		     "DarkGreen" nil nil t nil nil)
+		    (custom-face-lookup "DarkGreen" nil nil
+					nil t nil))))))
+	(data
+	 ((type . repeat)
+	  (header . nil)
+	  (data 
+	   (type . list)
+	   (compact . t)
+	   (data
+	    ((type . string)
+	     (prompt . "Header")
+	     (tag . "Header "))
+	    "\n            "
+	    ((type . face)
+	     (prompt . "Name")
+	     (tag . "Name   "))
+	    "\n            "
+	    ((type . face)
+	     (tag . "Content"))
+	    "\n")))))
+       ((tag . "Attribution Face")
+	(doc . "\
+Face used for attribution lines.
+It is merged with the face for the cited text belonging to the attribution.")
+	(name . gnus-cite-attribution-face)
+	(default . underline)
+	(type . face))
+       ((tag . "Citation Faces")
+	(doc . "\
+List of faces used for highlighting citations. 
 
-(defun gnus-score-string-convert (widget)
-  ;; Set args appropriately.
-  (let* ((tag (widget-get widget :tag))
-	 (item `(const :format "" :value ,(downcase tag)))
-	 (match '(string :tag "Match"))
-	 (score '(choice :tag "Score"
-			(const :tag "default" nil)
-			(integer :format "%v"
-				 :hide-front-space t)))
-	 (expire '(choice :tag "Expire"
-			  (const :tag "off" nil)
-			  (integer :format "%v"
-				   :hide-front-space t)))
-	 (type '(choice :tag "Type"
-			:value s
-			;; I should really create a forgiving :match
-			;; function for each type below, that only
-			;; looked at the first letter.
-			(const :tag "Regexp" r)
-			(const :tag "Regexp (fixed case)" R)
-			(const :tag "Substring" s)
-			(const :tag "Substring (fixed case)" S)
-			(const :tag "Exact" e)
-			(const :tag "Exact (fixed case)" E)
-			(const :tag "Word" w)
-			(const :tag "Word (fixed case)" W)
-			(const :tag "default" nil)))
-	 (group `(group ,match ,score ,expire ,type))
-	 (doc (concat (or (widget-get widget :doc)
-			  (concat "Change score based on the " tag
-				  " header.\n"))
-		      "
-You can have an arbitrary number of score entries for this header,
-each score entry has four elements:
-
-1. The \"match element\".  This should be the string to look for in the
-   header.
-
-2. The \"score element\".  This number should be an integer in the
-   neginf to posinf interval.  This number is added to the score
-   of the article if the match is successful.  If this element is
-   not present, the `gnus-score-interactive-default-score' number
-   will be used instead.  This is 1000 by default.
-
-3. The \"date element\".  This date says when the last time this score
-   entry matched, which provides a mechanism for expiring the
-   score entries.  It this element is not present, the score
-   entry is permanent.  The date is represented by the number of
-   days since December 31, 1 ce.
-
-4. The \"type element\".  This element specifies what function should
-   be used to see whether this score entry matches the article.
+When there are citations from multiple articles in the same message,
+Gnus will try to give each citation from each article its own face.
+This should make it easier to see who wrote what.")
+	(name . gnus-cite-face-list)
+	(import . gnus-custom-import-cite-face-list)
+	(type . list)
+	(calculate . (cond ((not (eq gnus-display-type 'color))
+			    '(italic))
+			   ((eq gnus-background-mode 'dark)
+			    (mapcar 'gnus-make-face 
+				    gnus-face-light-name-list))
+			   (t 
+			    (mapcar 'gnus-make-face 
+				    gnus-face-dark-name-list))))
+	(data
+	 ((type . repeat)
+	  (header . nil)
+	  (data (type . face)
+		(tag . "Face")))))
+       ((tag . "Citation Hide Percentage")
+	(doc . "\
+Only hide excess citation if above this percentage of the body.")
+	(name . gnus-cite-hide-percentage)
+	(default . 50)
+	(type . integer))
+       ((tag . "Citation Hide Absolute")
+	(doc . "\
+Only hide excess citation if above this number of lines in the body.")
+	(name . gnus-cite-hide-absolute)
+	(default . 10)
+	(type . integer))
+       ((tag . "Summary Selected Face")
+	(doc . "\
+Face used for highlighting the current article in the summary buffer.")
+	(name . gnus-summary-selected-face)
+	(default . underline)
+	(type . face))
+       ((tag . "Summary Line Highlighting")
+	(doc . "\
+Controls the highlighting of summary buffer lines. 
 
-   There are the regexp, as well as substring types, and exact match,
-   and word match types.  If this element is not present, Gnus will
-   assume that substring matching should be used.  There is case
-   sensitive variants of all match types.")))
-    (widget-put widget :args `(,item
-			       (repeat :inline t
-				       :indent 0
-				       :tag ,tag
-				       :doc ,doc
-				       :format "%t:\n%h%v%i\n\n"
-				       (choice :format "%v"
-					       :value ("" nil nil s)
-					       ,group
-					       sexp)))))
-  widget)
+Below is a list of `Form'/`Face' pairs.  When deciding how a a
+particular summary line should be displayed, each form is
+evaluated. The content of the face field after the first true form is
+used.  You can change how those summary lines are displayed, by
+editing the face field.  
 
-(define-widget 'gnus-score-integer 'group
-  "Edit score entries for integer-valued headers."
-  :convert-widget 'gnus-score-integer-convert)
+It is also possible to change and add form fields, but currently that
+requires an understanding of Lisp expressions.  Hopefully this will
+change in a future release.  For now, you can use the following
+variables in the Lisp expression:
 
-(defun gnus-score-integer-convert (widget)
-  ;; Set args appropriately.
-  (let* ((tag (widget-get widget :tag))
-	 (item `(const :format "" :value ,(downcase tag)))
-	 (match '(integer :tag "Match"))
-	 (score '(choice :tag "Score"
-			(const :tag "default" nil)
-			(integer :format "%v"
-				 :hide-front-space t)))
-	 (expire '(choice :tag "Expire"
-			  (const :tag "off" nil)
-			  (integer :format "%v"
-				   :hide-front-space t)))
-	 (type '(choice :tag "Type"
-			:value <
-			(const <)
-			(const >)
-			(const =)
-			(const >=)
-			(const <=)))
-	 (group `(group ,match ,score ,expire ,type))
-	 (doc (concat (or (widget-get widget :doc)
-			  (concat "Change score based on the " tag
-				  " header.")))))
-    (widget-put widget :args `(,item
-			       (repeat :inline t
-				       :indent 0
-				       :tag ,tag
-				       :doc ,doc
-				       :format "%t:\n%h%v%i\n\n"
-				       ,group))))
-  widget)
-
-(define-widget 'gnus-score-date 'group
-  "Edit score entries for date-valued headers."
-  :convert-widget 'gnus-score-date-convert)
+score:   The article's score
+default: The default article score.
+below:   The score below which articles are automatically marked as read. 
+mark:    The article's mark.")
+	(name . gnus-summary-highlight)
+	(type . list)
+	(calculate 
+	 . (cond
+	    ((not (eq gnus-display-type 'color))
+	     '(((> score default) . bold)
+	       ((< score default) . italic)))
+	    ((eq gnus-background-mode 'dark)
+	     (list
+	      (cons 
+	       '(= mark gnus-canceled-mark)
+	       (custom-face-lookup "yellow" "black" nil
+				   nil nil nil))
+	      (cons '(and (> score default) 
+			  (or (= mark gnus-dormant-mark)
+			      (= mark gnus-ticked-mark)))
+		    (custom-face-lookup 
+		     "pink" nil nil t nil nil))
+	      (cons '(and (< score default) 
+			  (or (= mark gnus-dormant-mark)
+			      (= mark gnus-ticked-mark)))
+		    (custom-face-lookup "pink" nil nil 
+					nil t nil))
+	      (cons '(or (= mark gnus-dormant-mark)
+			 (= mark gnus-ticked-mark))
+		    (custom-face-lookup 
+		     "pink" nil nil nil nil nil))
 
-(defun gnus-score-date-convert (widget)
-  ;; Set args appropriately.
-  (let* ((tag (widget-get widget :tag))
-	 (item `(const :format "" :value ,(downcase tag)))
-	 (match '(string :tag "Match"))
-	 (score '(choice :tag "Score"
-			(const :tag "default" nil)
-			(integer :format "%v"
-				 :hide-front-space t)))
-	 (expire '(choice :tag "Expire"
-			  (const :tag "off" nil)
-			  (integer :format "%v"
-				   :hide-front-space t)))
-	 (type '(choice :tag "Type"
-			:value regexp
-			(const regexp)
-			(const before)
-			(const at)
-			(const after)))
-	 (group `(group ,match ,score ,expire ,type))
-	 (doc (concat (or (widget-get widget :doc)
-			  (concat "Change score based on the " tag
-				  " header."))
-		      "
-For the Date header we have three kinda silly match types: `before',
-`at' and `after'.  I can't really imagine this ever being useful, but,
-like, it would feel kinda silly not to provide this function.  Just in
-case.  You never know.  Better safe than sorry.  Once burnt, twice
-shy.  Don't judge a book by its cover.  Never not have sex on a first
-date.  (I have been told that at least one person, and I quote,
-\"found this function indispensable\", however.)
+	      (cons
+	       '(and (> score default) (= mark gnus-ancient-mark))
+	       (custom-face-lookup "medium blue" nil nil t
+				   nil nil))
+	      (cons 
+	       '(and (< score default) (= mark gnus-ancient-mark))
+	       (custom-face-lookup "SkyBlue" nil nil
+				   nil t nil))
+	      (cons 
+	       '(= mark gnus-ancient-mark)
+	       (custom-face-lookup "SkyBlue" nil nil
+				   nil nil nil))
+	      (cons '(and (> score default) (= mark gnus-unread-mark))
+		    (custom-face-lookup "white" nil nil t
+					nil nil))
+	      (cons '(and (< score default) (= mark gnus-unread-mark))
+		    (custom-face-lookup "white" nil nil
+					nil t nil))
+	      (cons '(= mark gnus-unread-mark)
+		    (custom-face-lookup
+		     "white" nil nil nil nil nil))
 
-A more useful match type is `regexp'.  With it, you can match the date
-string using a regular expression.  The date is normalized to ISO8601
-compact format first---`YYYYMMDDTHHMMSS'.  If you want to match all
-articles that have been posted on April 1st in every year, you could
-use `....0401.........' as a match string, for instance.  (Note that
-the date is kept in its original time zone, so this will match
-articles that were posted when it was April 1st where the article was
-posted from.  Time zones are such wholesome fun for the whole family,
-eh?")))
-    (widget-put widget :args `(,item
-			       (repeat :inline t
-				       :indent 0
-				       :tag ,tag
-				       :doc ,doc
-				       :format "%t:\n%h%v%i\n\n"
-				       ,group))))
-  widget)
+	      (cons '(> score default) 'bold)
+	      (cons '(< score default) 'italic)))
+	    (t
+	     (list
+	      (cons
+	       '(= mark gnus-canceled-mark)
+	       (custom-face-lookup
+		"yellow" "black" nil nil nil nil))
+	      (cons '(and (> score default) 
+			  (or (= mark gnus-dormant-mark)
+			      (= mark gnus-ticked-mark)))
+		    (custom-face-lookup "firebrick" nil nil
+					t nil nil))
+	      (cons '(and (< score default) 
+			  (or (= mark gnus-dormant-mark)
+			      (= mark gnus-ticked-mark)))
+		    (custom-face-lookup "firebrick" nil nil
+					nil t nil))
+	      (cons 
+	       '(or (= mark gnus-dormant-mark)
+		    (= mark gnus-ticked-mark))
+	       (custom-face-lookup 
+		"firebrick" nil nil nil nil nil))
 
-(defvar gnus-custom-scores)
-(defvar gnus-custom-score-alist)
+	      (cons '(and (> score default) (= mark gnus-ancient-mark))
+		    (custom-face-lookup "RoyalBlue" nil nil
+					t nil nil))
+	      (cons '(and (< score default) (= mark gnus-ancient-mark))
+		    (custom-face-lookup "RoyalBlue" nil nil
+					nil t nil))
+	      (cons 
+	       '(= mark gnus-ancient-mark)
+	       (custom-face-lookup
+		"RoyalBlue" nil nil nil nil nil))
+
+	      (cons '(and (> score default) (/= mark gnus-unread-mark))
+		    (custom-face-lookup "DarkGreen" nil nil
+					t nil nil))
+	      (cons '(and (< score default) (/= mark gnus-unread-mark))
+		    (custom-face-lookup "DarkGreen" nil nil
+					nil t nil))
+	      (cons
+	       '(/= mark gnus-unread-mark)
+	       (custom-face-lookup "DarkGreen" nil nil 
+				   nil nil nil))
+
+	      (cons '(> score default) 'bold)
+	      (cons '(< score default) 'italic)))))
+	(data
+	 ((type . repeat)
+	  (header . nil)
+	  (data (type . pair)
+		(compact . t)
+		(data ((type . sexp)
+		       (width . 60)
+		       (tag . "Form"))
+		      "\n            "
+		      ((type . face)
+		       (tag . "Face"))
+		      "\n")))))
+
+       ((tag . "Group Line Highlighting")
+	(doc . "\
+Controls the highlighting of group buffer lines. 
 
-(defun gnus-score-customize (file)
-  "Customize score file FILE."
-  (interactive (list gnus-current-score-file))
-  (let ((scores (gnus-score-load file))
-	(types (mapcar (lambda (entry)
-		 `(group :format "%v%h\n"
-			 :doc ,(nth 2 entry)
-			 (const :format "" ,(nth 0 entry))
-			 ,(nth 1 entry)))
-	       gnus-score-parameters)))
-    ;; Ready.
-    (kill-buffer (get-buffer-create "*Gnus Customize*"))
-    (switch-to-buffer (get-buffer-create "*Gnus Customize*"))
-    (gnus-custom-mode)
-    (make-local-variable 'gnus-custom-score-alist)
-    (setq gnus-custom-score-alist scores)
-    (widget-insert "Customize the ")
-    (widget-create 'info-link
-		   :help-echo "Push me to learn more."
-		   :tag "score entries"
-		   "(gnus)Score File Format")
-    (widget-insert " for\n\t")
-    (widget-insert file)
-    (widget-insert "\nand press ")
-    (widget-create 'push-button
-		   :tag "done"
-		   :help-echo "Push me when done customizing."
-		   :action 'gnus-score-customize-done)
-    (widget-insert ".\n
-Check the [ ] for the entries you want to apply to this score file, then
-edit the value to suit your taste.  Don't forget to mark the checkbox,
-if you do all your changes will be lost.  ")
-    (widget-create 'push-button
-		   :action (lambda (&rest ignore)
-			     (require 'gnus-audio)
-			     (gnus-audio-play "Evil_Laugh.au"))
-		   "Bhahahah!")
-    (widget-insert "\n\n")
-    (make-local-variable 'gnus-custom-scores)
-    (setq gnus-custom-scores
-	  (widget-create 'group
-			 :value scores
-			 `(checklist :inline t
-				     :greedy t
-				     (gnus-score-string :tag "From")
-				     (gnus-score-string :tag "Subject")
-				     (gnus-score-string :tag "References")
-				     (gnus-score-string :tag "Xref")
-				     (gnus-score-string :tag "Message-ID")
-				     (gnus-score-integer :tag "Lines")
-				     (gnus-score-integer :tag "Chars")
-				     (gnus-score-date :tag "Date")
-				     (gnus-score-string :tag "Head"
-							:doc "\
-Match all headers in the article.
+Below is a list of `Form'/`Face' pairs.  When deciding how a a
+particular group line should be displayed, each form is
+evaluated. The content of the face field after the first true form is
+used.  You can change how those group lines are displayed by
+editing the face field.  
+
+It is also possible to change and add form fields, but currently that
+requires an understanding of Lisp expressions.  Hopefully this will
+change in a future release.  For now, you can use the following
+variables in the Lisp expression:
 
-Using one of `Head', `Body', `All' will slow down scoring considerable.
-")
-				     (gnus-score-string :tag "Body"
-							:doc "\
-Match the body sans header of the article.
-
-Using one of `Head', `Body', `All' will slow down scoring considerable.
-")
-				     (gnus-score-string :tag "All"
-							:doc "\
-Match the entire article, including both headers and body.
-
-Using one of `Head', `Body', `All' will slow down scoring
-considerable.
-")
-				     (gnus-score-string :tag
-							"Followup"
-							:doc "\
-Score all followups to the specified authors.
+group: The name of the group.
+unread: The number of unread articles in the group.
+method: The select method used.
+mailp: Whether it's a mail group or not.
+level: The level of the group.
+score: The score of the group.
+ticked: The number of ticked articles.")
+	(name . gnus-group-highlight)
+	(type . list)
+	(calculate 
+	 . (cond 
+	    ((not (eq gnus-display-type 'color))
+	     '((mailp . bold)
+	       ((= unread 0) . italic)))
+	    ((eq gnus-background-mode 'dark)
+	     `(((and (not mailp) (eq level 1)) .
+		,(custom-face-lookup "PaleTurquoise" nil nil t))
+	       ((and (not mailp) (eq level 2)) .
+		,(custom-face-lookup "turquoise" nil nil t))
+	       ((and (not mailp) (eq level 3)) .
+		,(custom-face-lookup "MediumTurquoise" nil nil t))
+	       ((and (not mailp) (>= level 4)) .
+		,(custom-face-lookup "DarkTurquoise" nil nil t))
+	       ((and mailp (eq level 1)) .
+		,(custom-face-lookup "aquamarine1" nil nil t))
+	       ((and mailp (eq level 2)) .
+		,(custom-face-lookup "aquamarine2" nil nil t))
+	       ((and mailp (eq level 3)) .
+		,(custom-face-lookup "aquamarine3" nil nil t))
+	       ((and mailp (>= level 4)) .
+		,(custom-face-lookup "aquamarine4" nil nil t))
+	       ))
+	    (t
+	     `(((and (not mailp) (<= level 3)) .
+		,(custom-face-lookup "ForestGreen" nil nil t))
+	       ((and (not mailp) (eq level 4)) .
+		,(custom-face-lookup "DarkGreen" nil nil t))
+	       ((and (not mailp) (eq level 5)) .
+		,(custom-face-lookup "CadetBlue4" nil nil t))
+	       ((and mailp (eq level 1)) .
+		,(custom-face-lookup "DeepPink3" nil nil t))
+	       ((and mailp (eq level 2)) .
+		,(custom-face-lookup "HotPink3" nil nil t))
+	       ((and mailp (eq level 3)) .
+		,(custom-face-lookup "dark magenta" nil nil t))
+	       ((and mailp (eq level 4)) .
+		,(custom-face-lookup "DeepPink4" nil nil t))
+	       ((and mailp (> level 4)) .
+		,(custom-face-lookup "DarkOrchid4" nil nil t))
+	       ))))
+	(data
+	 ((type . repeat)
+	  (header . nil)
+	  (data (type . pair)
+		(compact . t)
+		(data ((type . sexp)
+		       (width . 60)
+		       (tag . "Form"))
+		      "\n            "
+		      ((type . face)
+		       (tag . "Face"))
+		      "\n")))))
 
-This entry is somewhat special, in that it will match the `From:'
-header, and affect the score of not only the matching articles, but
-also all followups to the matching articles.  This allows you
-e.g. increase the score of followups to your own articles, or decrease
-the score of followups to the articles of some known trouble-maker.
-")
-				     (gnus-score-string :tag "Thread"
-							:doc "\
-Add a score entry on all articles that are part of a thread.
+       ;; Do not define `gnus-button-alist' before we have
+       ;; some `complexity' attribute so we can hide it from
+       ;; beginners. 
+       )))))
 
-This match key works along the same lines as the `Followup' match key.
-If you say that you want to score on a (sub-)thread that is started by
-an article with a `Message-ID' X, then you add a `thread' match.  This
-will add a new `thread' match for each article that has X in its
-`References' header.  (These new `thread' matches will use the
-`Message-ID's of these matching articles.)  This will ensure that you
-can raise/lower the score of an entire thread, even though some
-articles in the thread may not have complete `References' headers.
-Note that using this may lead to undeterministic scores of the
-articles in the thread.
-")
-				     ,@types)
-			 '(repeat :inline t
-				  :tag "Unknown entries"
-				  sexp)))
-    (use-local-map widget-keymap)
-    (widget-setup)))
-
-(defun gnus-score-customize-done (&rest ignore)
-  "Reset the score alist with the present value."
-  (let ((alist gnus-custom-score-alist)
-	(value (widget-value gnus-custom-scores)))
-    (setcar alist (car value))
-    (setcdr alist (cdr value))
-    (gnus-score-set 'touched '(t) alist))
-  (bury-buffer))
-
-;;; The End:
+(defun gnus-custom-import-cite-face-list (custom alist)
+  ;; Backward compatible grokking of light and dark.
+  (cond ((eq alist 'light)
+	 (setq alist (mapcar 'gnus-make-face gnus-face-light-name-list)))
+	((eq alist 'dark)
+	 (setq alist (mapcar 'gnus-make-face gnus-face-dark-name-list))))
+  (funcall (custom-super custom 'import) custom alist))
 
 (provide 'gnus-cus)
 
 ;;; gnus-cus.el ends here
-