* gnus-art.el (gnus-use-idna)

[gnus] / lisp / gnus-cus.el

diff --git a/lisp/gnus-cus.el b/lisp/gnus-cus.el
index 8660096..6d37120 100644 (file)
--- a/lisp/gnus-cus.el
+++ b/lisp/gnus-cus.el
@@ -1,7 +1,7 @@
 ;;; gnus-cus.el --- customization commands for Gnus
 
 ;; Copyright (C) 1996, 1999, 2000, 2001, 2002, 2003, 2004,
-;;   2005 Free Software Foundation, Inc.
+;;   2005, 2006, 2007 Free Software Foundation, Inc.
 
 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
 ;; Keywords: news
@@ -10,7 +10,7 @@
 
 ;; GNU Emacs is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
 ;; any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
@@ -227,8 +227,11 @@ See `gnus-emphasis-alist'.")
                              (const signature-file)
                              (const organization)
                              (const address)
+                             (const x-face-file)
                              (const name)
-                             (const body))
+                             (const body)
+                             (symbol)
+                             (string :tag "Header"))
                      (string :format "%v"))))
      "post style.
 See `gnus-posting-styles'."))
@@ -763,6 +766,67 @@ eh?")))
                                       ,group))))
   widget)
 
+(define-widget 'gnus-score-extra 'group
+  "Edit score entries for extra headers."
+  :convert-widget 'gnus-score-extra-convert)
+
+(defun gnus-score-extra-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)))
+        (header (if gnus-extra-headers
+                    (let (name)
+                      `(choice :tag "Header"
+                               ,@(mapcar (lambda (h)
+                                           (setq name (symbol-name h))
+                                           (list 'const :tag name name))
+                                         gnus-extra-headers)
+                               (string :tag "Other" :format "%v")))
+                  '(string :tag "Header")))
+        (group `(group ,match ,score ,expire ,type ,header))
+        (doc (concat (or (widget-get widget :doc)
+                         (concat "Change score based on the " tag
+                                 " header.\n")))))
+    (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
+                              ,(if gnus-extra-headers
+                                   (symbol-name (car gnus-extra-headers))
+                                 ""))
+                      ,group
+                      sexp)))))
+  widget)
+
 (defvar gnus-custom-scores)
 (defvar gnus-custom-score-alist)
 
@@ -819,7 +883,7 @@ if you do all your changes will be lost.  ")
                                     (gnus-score-string :tag "Subject")
                                     (gnus-score-string :tag "References")
                                     (gnus-score-string :tag "Xref")
-                                    (gnus-score-string :tag "Extra")
+                                    (gnus-score-extra :tag "Extra")
                                     (gnus-score-string :tag "Message-ID")
                                     (gnus-score-integer :tag "Lines")
                                     (gnus-score-integer :tag "Chars")