Mercurial > hg > xemacs-beta
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 -