X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-cus.el;h=37c0bf955c36dc00f4cd812f106c79b3429f5014;hb=b28454eed83f245c4160228b076134ce930b320a;hp=24c080cf2710299d2320d791af14e88d84b9f7ee;hpb=d117d36f7240b68ae95be895c71dac4bfa0d6742;p=gnus diff --git a/lisp/gnus-cus.el b/lisp/gnus-cus.el index 24c080cf2..37c0bf955 100644 --- a/lisp/gnus-cus.el +++ b/lisp/gnus-cus.el @@ -1,9 +1,9 @@ -;;; gnus-cus.el --- User friendly customization of Gnus -;; Copyright (C) 1995,96 Free Software Foundation, Inc. +;;; gnus-cus.el --- customization commands for Gnus ;; -;; Author: Per Abrahamsen -;; Keywords: help, news -;; Version: 0.1 +;; Copyright (C) 1996 Free Software Foundation, Inc. + +;; Author: Per Abrahamsen +;; Keywords: news ;; 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,530 +26,625 @@ ;;; Code: -(require 'custom) -(require 'gnus-ems) -(require 'browse-url) -(eval-when-compile (require 'cl)) - -;; The following is just helper functions and data, not ment 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)) - -(defvar gnus-face-light-name-list - '("light blue" "light cyan" "light yellow" "light pink" - "pale green" "beige" "orange" "magenta" "violet" "medium purple" - "turquoise")) - -(defvar gnus-face-dark-name-list - '("RoyalBlue" "firebrick" - "dark green" "OrangeRed" "dark khaki" "dark violet" - "SteelBlue4")) -; CornflowerBlue SeaGreen OrangeRed SteelBlue4 DeepPink3 -; DarkOlviveGreen4 - -(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 - summary-menu group-menu article-menu - tree-highlight menu highlight - browse-menu server-menu - page-marker)) - (name . gnus-visual) - (type . toggle)) - ((tag . "WWW Browser") - (doc . "\ -WWW Browser to call when clicking on an URL button in the article buffer. - -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 . (if (boundp 'gnus-mouse-face) - gnus-mouse-face - 'highlight)) - (type . face)) - ((tag . "Article Display") - (doc . "Controls how the article buffer will look. - -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) - (default . (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. - -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. - -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. - -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. +(require 'wid-edit) +(require 'gnus-score) + +;;; Widgets: + +;; 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: + +\\[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. + +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. + +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. + +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.") + + (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. + +`all' + Display all articles, both read and unread. + +`default' + Display the default visible articles, which normally includes + unread and ticked articles.") + + (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) + +(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"))) + + '(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))) + +(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.") + + (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.") + + (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: + + (orphan -500) + (mark-and-expunge -100) + +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.") + + (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) + +(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. + + 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) + +(define-widget 'gnus-score-integer 'group + "Edit score entries for integer-valued headers." + :convert-widget 'gnus-score-integer-convert) + +(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) + +(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.) + +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) + +(defvar gnus-custom-scores) +(defvar gnus-custom-score-alist) + +(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. + +Using one of `Head', `Body', `All' will slow down scoring considerable. ") - (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. + (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. ") - (type . const) - (default . gnus-article-hide-signature)) - ((tag . "Hide Excess Citations") - (doc . "\ -Hide excess citation. + (gnus-score-string :tag "All" + :doc "\ +Match the entire article, including both headers and body. -Excess is defined by `Citation Hide Percentage' and `Citation Hide Absolute'. +Using one of `Head', `Body', `All' will slow down scoring +considerable. ") - (type . const) - (default . - gnus-article-hide-citation-maybe)) - ((tag . "Hide Citations") - (doc . "\ -Hide all cited text. + (gnus-score-string :tag + "Followup" + :doc "\ +Score all followups to the specified authors. + +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. ") - (type . const) - (default . gnus-article-hide-citation)) - ((tag . "Add Buttons") - (doc . "\ -Make URL's into clickable buttons. + (gnus-score-string :tag "Thread" + :doc "\ +Add a score entry on all articles that are part of a thread. + +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. ") - (type . const) - (default . gnus-article-add-buttons)) - ((prompt . "Other") - (doc . "\ -Name of Lisp function to call. - -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. - -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. - -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. - -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 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. - -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. - -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 - "RoyalBlue" - 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. - -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. - -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. - -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: - -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)) - - (cons '(and (> score default) (= mark gnus-ancient-mark)) - (custom-face-lookup "dark 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)) - - (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)) - - (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"))))) - ;; Do not define `gnus-button-alist' before we have - ;; some `complexity' attribute so we can hide it from - ;; beginners. - ))))) - -(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)) - -;(defun gnus-custom-import-swap-alist (custom alist) -; ;; Swap key and value in CUSTOM ALIST. -; (let ((swap (mapcar (lambda (e) (cons (cdr e) (car e))) alist))) -; (funcall (custom-super custom 'import) custom swap))) - -;(defun gnus-custom-export-swap-alist (custom alist) -; ;; Swap key and value in CUSTOM ALIST. -; (let ((swap (mapcar (lambda (e) (cons (cdr e) (car e))) alist))) -; (funcall (custom-super custom 'export) custom swap))) + ,@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: (provide 'gnus-cus) ;;; gnus-cus.el ends here +