*** empty log message ***
authorLars Magne Ingebrigtsen <larsi@gnus.org>
Tue, 4 Mar 1997 23:26:34 +0000 (23:26 +0000)
committerLars Magne Ingebrigtsen <larsi@gnus.org>
Tue, 4 Mar 1997 23:26:34 +0000 (23:26 +0000)
18 files changed:
lisp/ChangeLog
lisp/custom-edit.el
lisp/custom.el
lisp/gnus-cus.el [new file with mode: 0644]
lisp/gnus-group.el
lisp/gnus-load.el
lisp/gnus-score.el
lisp/gnus-sum.el
lisp/gnus-topic.el
lisp/gnus-xmas.el
lisp/gnus.el
lisp/nnbabyl.el
lisp/nnfolder.el
lisp/nnmbox.el
lisp/widget-edit.el
lisp/widget.el
texi/ChangeLog
texi/gnus.texi

index 8946e33..13e1ca9 100644 (file)
@@ -1,3 +1,40 @@
+Sun Sep 29 00:57:13 1996  Dave Disser  <disser@sdd.hp.com>
+
+       * gnus-sum.el (gnus-summary-display-article): Don't show tree
+       unless using threads.
+
+Sun Sep 29 00:19:35 1996  Lars Magne Ingebrigtsen  <larsi@hrym.ifi.uio.no>
+
+       * gnus-score.el (gnus-all-score-files): Remove duplicates.
+
+Sat Sep 28 23:47:43 1996  Lars Magne Ingebrigtsen  <larsi@hrym.ifi.uio.no>
+
+       * gnus-score.el (gnus-summary-increase-score): Wouldn't do regexp
+       bodies. 
+
+       * gnus-topic.el (gnus-topic-group-indentation): Give the right
+       indentation always.
+
+Sat Sep 28 23:23:58 1996  Lars Magne Ingebrigtsen  <larsi@ylfing.ifi.uio.no>
+
+       * gnus-group.el (gnus-group-quick-select-group): Require
+       gnus-score. 
+
+       * gnus-score.el (gnus-score-thread): New function.
+
+Sat Sep 28 00:41:54 1996  Per Abrahamsen  <abraham@dina.kvl.dk>
+
+       * gnus-cus.el: New file.
+
+Sat Sep 28 21:32:52 1996  Kevin Buhr  <buhr@stat.wisc.edu>
+
+       * nnbabyl.el (nnbabyl-request-article): Would delete wrong
+       articles. 
+
+Fri Sep 27 21:54:30 1996  Lars Magne Ingebrigtsen  <larsi@ifi.uio.no>
+
+       * gnus.el: Red Gnus v0.44 is released.
+
 Fri Sep 27 21:24:46 1996  Lars Magne Ingebrigtsen  <larsi@ylfing.ifi.uio.no>
 
        * gnus-sum.el (gnus-nov-parse-line): Would double articles.
index afa677d..ed7385f 100644 (file)
@@ -4,7 +4,7 @@
 ;;
 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
 ;; Keywords: help, faces
-;; Version: 0.96
+;; Version: 0.98
 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
 
 ;;; Commentary:
@@ -223,7 +223,7 @@ The list should be sorted most significant first."
             (push magic buttons)
             (widget-put widget :buttons buttons)))
          (t 
-          (widget-help-format-handler widget escape)))))
+          (widget-default-format-handler widget escape)))))
 
 (defun custom-notify (widget &rest args)
   "Keep track of changes."
@@ -423,11 +423,13 @@ Optional EVENT is the location for the menu."
          ((setq val (widget-apply child :validate))
           (error "Invalid %S"))
          ((eq form 'lisp)
-          (put symbol 'saved-value (list (widget-value child))))
+          (put symbol 'saved-value (list (widget-value child)))
+          (set symbol (eval (widget-value child))))
          (t
           (put symbol
                'saved-value (list (custom-quote (widget-value
-                                                 child))))))
+                                                 child))))
+          (set symbol (widget-value child))))
     (custom-variable-state-set widget)
     (custom-redraw-magic widget)))
 
@@ -851,7 +853,7 @@ Leave point at the location of the call, or after the last expression."
 (defun custom-mode ()
   "Major mode for editing customization buffers.
 
-Read the non-existing manual for information about how to use it.
+The following commands are available:
 
 \\[widget-forward]             Move to next button or editable field.
 \\[widget-backward]            Move to previous button or editable field.
@@ -975,10 +977,13 @@ that option."
   (kill-buffer (get-buffer-create "*Customization*"))
   (switch-to-buffer (get-buffer-create "*Customization*"))
   (custom-mode)
-  (widget-insert "This is a customization buffer. 
-Press `C-h m' for to get help.
-
-")
+  (widget-insert "This is a customization buffer.
+Push RET or click mouse-2 on the word ")
+  (widget-create 'info-link 
+                :tag "help"
+                :help-echo "Push me for help."
+                "(custom)The Customization Buffer")
+  (widget-insert " for more information.\n\n")
   (setq custom-options 
        (mapcar (lambda (entry)
                  (prog1 
@@ -990,7 +995,7 @@ Press `C-h m' for to get help.
                options))
   (widget-create 'push-button
                 :tag "Apply"
-                :help-echo "Push me to apply all modifications,"
+                :help-echo "Push me to apply all modifications."
                 :action (lambda (widget &optional event)
                           (custom-apply)))
   (widget-insert " ")
index b7d1acd..f8258fa 100644 (file)
@@ -4,7 +4,7 @@
 ;;
 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
 ;; Keywords: help, faces
-;; Version: 0.96
+;; Version: 0.98
 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
 
 ;;; Commentary:
diff --git a/lisp/gnus-cus.el b/lisp/gnus-cus.el
new file mode 100644 (file)
index 0000000..c06893f
--- /dev/null
@@ -0,0 +1,639 @@
+;;; gnus-cus.el --- customization commands for Gnus
+;;
+;; Copyright (C) 1996 Free Software Foundation, Inc.
+
+;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
+;; Keywords: news
+
+;; This file is part of GNU Emacs.
+
+;; 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)
+;; any later version.
+
+;; 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
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'widget-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"
+                                 :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")))))
+    (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."))
+  "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"
+                                      ,group))))
+  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.
+")
+                                    (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.
+
+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.
+
+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)))
+    (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
+
index 0d1935c..da5047e 100644 (file)
@@ -434,6 +434,7 @@ ticked: The number of ticked articles.")
     "f" gnus-group-make-doc-group
     "w" gnus-group-make-web-group
     "r" gnus-group-rename-group
+    "c" gnus-group-customize
     "\177" gnus-group-delete-group
     [delete] gnus-group-delete-group)
 
@@ -1388,6 +1389,7 @@ This means that no highlighting or scoring will be performed.
 If ALL (the prefix argument) is 0, don't even generate the summary
 buffer."
   (interactive "P")
+  (require 'gnus-score)
   (let (gnus-visual
        gnus-score-find-score-files-function
        gnus-apply-kill-hook
@@ -1435,7 +1437,7 @@ Return the name of the group is selection was successful."
     (unless (gnus-check-server method)
       (error "Unable to contact server: %s" (gnus-status-message method)))
     (when activate
-      (gnus-activate-group group 'scan t)
+      (gnus-activate-group group 'scan)
       (unless (gnus-request-group group)
        (error "Couldn't request group: %s" 
               (nnheader-get-report (car method)))))
index 509f668..d95ac6b 100644 (file)
@@ -698,6 +698,7 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.")
       (gnus-summary-score-map keymap) gnus-score-save gnus-score-headers
       gnus-current-score-file-nondirectory gnus-score-adaptive
       gnus-score-find-trace gnus-score-file-name)
+     ("gnus-cus" :interactive t gnus-group-customize gnus-score-customize)
      ("gnus-topic" :interactive t gnus-topic-mode)
      ("gnus-topic" gnus-topic-remove-group)
      ("gnus-salt" :interactive t gnus-pick-mode gnus-binary-mode)
index 98c6ed6..8194647 100644 (file)
@@ -335,6 +335,7 @@ of the last successful match.")
   "a" gnus-summary-score-entry
   "S" gnus-summary-current-score
   "c" gnus-score-change-score-file
+  "C" gnus-score-customize
   "m" gnus-score-set-mark-below
   "x" gnus-score-set-expunge-below
   "R" gnus-summary-rescore
@@ -400,7 +401,7 @@ used as score."
            (?f f "fuzzy string" string)
            (?r r "regexp string" string)
            (?z s "substring" body-string)
-           (?p s "regexp string" body-string)
+           (?p r "regexp string" body-string)
            (?b before "before date" date)
            (?a at "at date" date) 
            (?n now "this date" date)
@@ -1483,12 +1484,12 @@ SCORE is the score to add."
 
 (defun gnus-score-body (scores header now expire &optional trace)
   (save-excursion
-    (set-buffer nntp-server-buffer)
     (setq gnus-scores-articles
          (sort gnus-scores-articles
                (lambda (a1 a2)
                  (< (mail-header-number (car a1))
                     (mail-header-number (car a2))))))
+    (set-buffer nntp-server-buffer)
     (save-restriction
       (let* ((buffer-read-only nil)
             (articles gnus-scores-articles)
@@ -1519,19 +1520,18 @@ SCORE is the score to add."
              ;; If just parts of the article is to be searched, but the
              ;; backend didn't support partial fetching, we just narrow
              ;; to the relevant parts.
-             (if ofunc
-                 (if (eq ofunc 'gnus-request-head)
-                     (narrow-to-region
-                      (point)
-                      (or (search-forward "\n\n" nil t) (point-max)))
+             (when ofunc
+               (if (eq ofunc 'gnus-request-head)
                    (narrow-to-region
-                    (or (search-forward "\n\n" nil t) (point))
-                    (point-max))))
+                    (point)
+                    (or (search-forward "\n\n" nil t) (point-max)))
+                 (narrow-to-region
+                  (or (search-forward "\n\n" nil t) (point))
+                  (point-max))))
              (setq scores all-scores)
              ;; Find matches.
              (while scores
-               (setq alist (car scores)
-                     scores (cdr scores)
+               (setq alist (pop scores)
                      entries (assoc header alist))
                (while (cdr entries)    ;First entry is the header index.
                  (let* ((rest (cdr entries))           
@@ -1555,32 +1555,33 @@ SCORE is the score to add."
                                (t
                                 (error "Illegal match type: %s" type)))))
                    (goto-char (point-min))
-                   (if (funcall search-func match nil t)
-                       ;; Found a match, update scores.
-                       (progn
-                         (setcdr (car articles) (+ score (cdar articles)))
-                         (setq found t)
-                         (and trace (setq gnus-score-trace 
-                                          (cons
-                                           (cons
-                                            (car-safe
-                                             (rassq alist gnus-score-cache))
-                                            kill)
-                                           gnus-score-trace)))))
+                   (when (funcall search-func match nil t)
+                     ;; Found a match, update scores.
+                     (setcdr (car articles) (+ score (cdar articles)))
+                     (setq found t)
+                     (when trace
+                       (push
+                        (cons (car-safe (rassq alist gnus-score-cache)) kill)
+                        gnus-score-trace)))
                    ;; Update expire date
-                   (cond
-                    ((null date))      ;Permanent entry.
-                    ((and found gnus-update-score-entry-dates) ;Match, update date.
-                     (gnus-score-set 'touched '(t) alist)
-                     (setcar (nthcdr 2 kill) now))
-                    ((and expire (< date expire)) ;Old entry, remove.
-                     (gnus-score-set 'touched '(t) alist)
-                     (setcdr entries (cdr rest))
-                     (setq rest entries)))
+                   (unless trace
+                     (cond
+                      ((null date))    ;Permanent entry.
+                      ((and found gnus-update-score-entry-dates) 
+                       ;; Match, update date.
+                       (gnus-score-set 'touched '(t) alist)
+                       (setcar (nthcdr 2 kill) now))
+                      ((and expire (< date expire)) ;Old entry, remove.
+                       (gnus-score-set 'touched '(t) alist)
+                       (setcdr entries (cdr rest))
+                       (setq rest entries))))
                    (setq entries rest)))))
            (setq articles (cdr articles)))))))
   nil)
 
+(defun gnus-score-thread (scores header now expire &optional trace)
+  (gnus-score-followup scores header now expire trace t))
+
 (defun gnus-score-followup (scores header now expire &optional trace thread)
   ;; Insert the unique article headers in the buffer.
   (let ((gnus-score-index (nth 1 (assoc header gnus-header-index)))
@@ -1787,13 +1788,11 @@ SCORE is the score to add."
                     (if trace
                         (while (setq art (pop arts))
                           (setcdr art (+ score (cdr art)))
-                          (setq gnus-score-trace
-                                (cons
-                                 (cons
-                                  (car-safe
-                                   (rassq alist gnus-score-cache))
-                                  kill)
-                                 gnus-score-trace)))
+                          (push
+                           (cons 
+                            (car-safe (rassq alist gnus-score-cache))
+                            kill)
+                           gnus-score-trace))
                       (while (setq art (pop arts))
                         (setcdr art (+ score (cdr art)))))))
              (forward-line 1)))
@@ -1894,8 +1893,7 @@ SCORE is the score to add."
              (if trace
                  (while (setq art (pop arts))
                    (setcdr art (+ score (cdr art)))
-                   (push (cons
-                          (car-safe (rassq alist gnus-score-cache)) kill)
+                   (push (cons (car-safe (rassq alist gnus-score-cache)) kill)
                          gnus-score-trace))
                ;; Found a match, update scores.
                (while (setq art (pop arts))
@@ -2492,6 +2490,19 @@ The list is determined from the variable gnus-score-file-alist."
     (let ((param-file (gnus-group-find-parameter group 'score-file)))
       (when param-file
        (push param-file score-files)))
+    ;; Expand all files names.
+    (let ((files score-files))
+      (while files
+       (setcar files (expand-file-name (pop files)))))
+    ;; Remove any duplicate score files.
+    (while (and score-files
+               (member (car score-files) (cdr score-files)))
+      (pop score-files))
+    (let ((files score-files))
+      (while (cdr files)
+       (when (member (cadr files) (cddr files))
+         (setcdr files (cddr files)))
+       (pop files)))
     ;; Do the scoring if there are any score files for this group.
     score-files))
     
index 54c64df..4443c15 100644 (file)
@@ -4895,7 +4895,7 @@ Given a prefix, will force an `article' buffer configuration."
                 (not (zerop gnus-current-article)))
        (gnus-summary-goto-subject gnus-current-article))
       (gnus-summary-recenter)
-      (when gnus-use-trees
+      (when (and gnus-use-trees gnus-show-threads)
        (gnus-possibly-generate-tree article)
        (gnus-highlight-selected-tree article))
       ;; Successfully display article.
index 03d2c3b..fee823a 100644 (file)
@@ -571,6 +571,7 @@ articles in the topic and its subtopics."
   (make-string 
    (* gnus-topic-indent-level
       (or (save-excursion
+           (forward-line -1)
            (gnus-topic-goto-topic (gnus-current-topic))
            (gnus-group-topic-level)) 0)) ? ))
 
index ec47f77..ab4048f 100644 (file)
@@ -315,7 +315,7 @@ call it with the value of the `gnus-data' text property."
 
 (defun gnus-xmas-read-event-char ()
   "Get the next event."
-  (let ((event (next-event)))
+  (let ((event (next-command-event)))
     ;; We junk all non-key events.  Is this naughty?
     (while (not (key-press-event-p event))
       (setq event (next-event)))
index 8b27916..9d8c1ea 100644 (file)
@@ -42,7 +42,7 @@
   "Score and kill file handling."
   :group 'gnus )
 
-(defconst gnus-version-number "0.44"
+(defconst gnus-version-number "0.45"
   "Version number for this version of Gnus.")
 
 (defconst gnus-version (format "Red Gnus v%s" gnus-version-number)
index 70db9b3..df50dec 100644 (file)
        (while (and (not (looking-at ".+:"))
                    (zerop (forward-line 1))))
        (setq start (point))
-       (or (and (re-search-forward 
-                 (concat "^" nnbabyl-mail-delimiter) nil t)
-                (forward-line -1))
+       (or (when (re-search-forward 
+                  (concat "^" nnbabyl-mail-delimiter) nil t)
+             (beginning-of-line)
+             t)
            (goto-char (point-max)))
        (setq stop (point))
        (let ((nntp-server-buffer (or buffer nntp-server-buffer)))
 
 (deffoo nnbabyl-request-move-article 
   (article group server accept-form &optional last)
-  (nnbabyl-possibly-change-newsgroup group server)
   (let ((buf (get-buffer-create " *nnbabyl move*"))
        result)
     (and 
        (set-buffer buf)
        (insert-buffer-substring nntp-server-buffer)
        (goto-char (point-min))
-       (if (re-search-forward 
-           "^X-Gnus-Newsgroup:" 
-           (save-excursion (search-forward "\n\n" nil t) (point)) t)
-          (delete-region (progn (beginning-of-line) (point))
-                         (progn (forward-line 1) (point))))
+       (while (re-search-forward 
+              "^X-Gnus-Newsgroup:" 
+              (save-excursion (search-forward "\n\n" nil t) (point)) t)
+        (delete-region (progn (beginning-of-line) (point))
+                       (progn (forward-line 1) (point))))
        (setq result (eval accept-form))
        (kill-buffer (current-buffer))
        result)
      (save-excursion
+       (nnbabyl-possibly-change-newsgroup group server)
        (set-buffer nnbabyl-mbox-buffer)
        (goto-char (point-min))
        (if (search-forward (nnbabyl-article-string article) nil t)
         (forward-line 1)
         (or (and (re-search-forward (concat "^" nnbabyl-mail-delimiter) 
                                     nil t)
-                 (if (and (not (bobp)) leave-delim)
-                     (progn (forward-line -2) (point))
-                   (match-beginning 0)))
+                 (match-beginning 0))
             (point-max))))
       (goto-char (point-min))
       ;; Only delete the article if no other groups owns it as well.
index cb61716..e3b3305 100644 (file)
@@ -342,7 +342,6 @@ time saver for large mailboxes.")
 
 (deffoo nnfolder-request-move-article
   (article group server accept-form &optional last)
-  (nnfolder-possibly-change-group group server)
   (let ((buf (get-buffer-create " *nnfolder move*"))
        result)
     (and 
index a784051..65016bc 100644 (file)
 
 (deffoo nnmbox-request-move-article
   (article group server accept-form &optional last)
-  (nnmbox-possibly-change-newsgroup group server)
   (let ((buf (get-buffer-create " *nnmbox move*"))
        result)
     (and 
        (kill-buffer buf)
        result)
      (save-excursion
+       (nnmbox-possibly-change-newsgroup group server)
        (set-buffer nnmbox-mbox-buffer)
        (goto-char (point-min))
        (if (search-forward (nnmbox-article-string article) nil t)
index 7eb78fc..2541a6a 100644 (file)
@@ -4,7 +4,7 @@
 ;;
 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
 ;; Keywords: extensions
-;; Version: 0.96
+;; Version: 0.98
 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
 
 ;;; Commentary:
 (require 'widget)
 (require 'cl)
 (autoload 'pp-to-string "pp")
+(autoload 'Info-goto-node "info")
 
 ;; The following should go away when bundled with Emacs.
-(require 'custom)
+(condition-case ()
+    (require 'custom)
+  (error nil))
+
 (eval-and-compile
-  (unless (fboundp 'custom-declare-variable)
+  (unless (and (featurep 'custom) (fboundp 'custom-declare-variable))
     ;; We have the old custom-library, hack around it!
     (defmacro defgroup (&rest args) nil)
     (defmacro defcustom (&rest args) nil)
@@ -475,10 +479,7 @@ With optional ARG, move across that many fields."
             (goto-char (max button field)))
            (button (goto-char button))
            (field (goto-char field)))))
-  (let ((help-echo (or (get-text-property (point) 'button)
-                      (get-text-property (point) 'field))))
-    (if (and help-echo (setq help-echo (widget-get help-echo :help-echo)))
-       (message "%s" help-echo))))
+  (widget-echo-help (point)))
 
 (defun widget-backward (arg)
   "Move point to the previous field or button.
@@ -663,8 +664,45 @@ With optional ARG, move across that many fields."
      (widget-put widget :to to))))
 
 (defun widget-default-format-handler (widget escape)
-  ;; By default unknown escapes are errors.
-  (error "Unknown escape `%c'" escape))
+  ;; We recognize the %h escape by default.
+  (let* ((buttons (widget-get widget :buttons))
+        (doc-property (widget-get widget :documentation-property))
+        (doc-try (cond ((widget-get widget :doc))
+                       ((symbolp doc-property)
+                        (documentation-property (widget-get widget :value)
+                                                doc-property))
+                       (t
+                        (funcall doc-property (widget-get widget :value)))))
+        (doc-text (and (stringp doc-try)
+                       (> (length doc-try) 1)
+                       doc-try)))
+    (cond ((eq escape ?h)
+          (when doc-text
+            (and (eq (preceding-char) ?\n)
+                 (widget-get widget :indent)
+                 (insert-char ?  (widget-get widget :indent)))
+            ;; The `*' in the beginning is redundant.
+            (when (eq (aref doc-text  0) ?*)
+              (setq doc-text (substring doc-text 1)))
+            ;; Get rid of trailing newlines.
+            (when (string-match "\n+\\'" doc-text)
+              (setq doc-text (substring doc-text 0 (match-beginning 0))))
+            (push (if (string-match "\n." doc-text)
+                      ;; Allow multiline doc to be hiden.
+                      (widget-create-child-and-convert
+                       widget 'widget-help 
+                       :doc (progn
+                              (string-match "\\`.*" doc-text)
+                              (match-string 0 doc-text))
+                       :widget-doc doc-text
+                       "?")
+                    ;; A single line is just inserted.
+                    (widget-create-child-and-convert
+                     widget 'item :format "%d" :doc doc-text nil))
+                  buttons)))
+         (t 
+          (error "Unknown escape `%c'" escape)))
+    (widget-put widget :buttons buttons)))
 
 (defun widget-default-button-face-get (widget)
   ;; Use :button-face or widget-button-face
@@ -722,7 +760,7 @@ With optional ARG, move across that many fields."
   :match 'widget-item-match
   :match-inline 'widget-item-match-inline
   :action 'widget-item-action
-  :format "%t\n%d")
+  :format "%t")
 
 (defun widget-item-convert-widget (widget)
   ;; Initialize :value and :tag from :args in WIDGET.
@@ -763,13 +801,34 @@ With optional ARG, move across that many fields."
 
 (define-widget 'push-button 'item
   "A pushable button."
-  :format "%[[%t]%]%d")
+  :format "%[[%t]%]")
 
 ;;; The `link' Widget.
 
 (define-widget 'link 'item
   "An embedded link."
-  :format "%[_%t_%]%d")
+  :format "%[_%t_%]")
+
+;;; The `info-link' Widget.
+
+(define-widget 'info-link 'link
+  "A link to an info file."
+  :action 'widget-info-link-action)
+
+(defun widget-info-link-action (widget &optional event)
+  "Open the info node specified by WIDGET."
+  (Info-goto-node (widget-value widget)))
+
+;;; The `url-link' Widget.
+
+(define-widget 'url-link 'link
+  "A link to an www page."
+  :action 'widget-url-link-action)
+
+(defun widget-url-link-action (widget &optional event)
+  "Open the url specified by WIDGET."
+  (require 'browse-url)
+  (funcall browse-url-browser-function (widget-value widget)))
 
 ;;; The `editable-field' Widget.
 
@@ -793,9 +852,16 @@ With optional ARG, move across that many fields."
        (invalid (widget-apply widget :validate)))
     (when invalid
       (error (widget-get invalid :error)))
-    (widget-value-set widget (read-string (concat tag ": ") 
-                                         (widget-get widget :value)
-                                         'widget-field-history))))
+    (widget-value-set widget 
+                     (widget-apply widget 
+                                   :value-to-external
+                                   (read-string (concat tag ": ") 
+                                                (widget-apply 
+                                                 widget
+                                                 :value-to-internal
+                                                 (widget-value widget))
+                                                'widget-field-history)))
+    (widget-setup)))
 
 (defun widget-field-value-create (widget)
   ;; Create an editable text field.
@@ -851,7 +917,7 @@ With optional ARG, move across that many fields."
 
 ;;; The `text' Widget.
 
-(define-widget 'text 'field
+(define-widget 'text 'editable-field
   "A multiline text area.")
 
 ;;; The `menu-choice' Widget.
@@ -918,10 +984,10 @@ With optional ARG, move across that many fields."
        (tag (widget-apply widget :menu-tag-get))
        current choices)
     ;; Remember old value.
-    (if (and old (widget-apply widget :validate))
+    (if (and old (not (widget-apply widget :validate)))
        (let* ((external (widget-value widget))
               (internal (widget-apply old :value-to-internal external)))
-       (widget-put old :value internal)))
+         (widget-put old :value internal)))
     ;; Find new choice.
     (setq current
          (cond ((= (length args) 0)
@@ -1631,57 +1697,15 @@ With optional ARG, move across that many fields."
     (widget-put widget :widget-doc old))
   (widget-value-set widget (widget-value widget)))
 
-(defun widget-help-format-handler (widget escape)
-  ;; We recognize extra escape sequences.
-  (let* ((symbol (widget-get widget :value))
-        (buttons (widget-get widget :buttons))
-        (doc-property (widget-get widget :documentation-property))
-        (doc-try (cond ((widget-get widget :doc))
-                       ((symbolp doc-property)
-                        (documentation-property symbol doc-property))
-                       (t
-                        (funcall doc-property symbol))))
-        (doc-text (and (stringp doc-try)
-                       (> (length doc-try) 1)
-                       doc-try)))
-    (cond ((eq escape ?h)
-          (when doc-text
-            (and (eq (preceding-char) ?\n)
-                 (widget-get widget :indent)
-                 (insert-char ?  (widget-get widget :indent)))
-            ;; The `*' in the beginning is redundant.
-            (when (eq (aref doc-text  0) ?*)
-              (setq doc-text (substring doc-text 1)))
-            ;; Get rid of trailing newlines.
-            (when (string-match "\n+\\'" doc-text)
-              (setq doc-text (substring doc-text 0 (match-beginning 0))))
-            (push (if (string-match "\n." doc-text)
-                      ;; Allow multiline doc to be hiden.
-                      (widget-create-child-and-convert
-                       widget 'widget-help 
-                       :doc (progn
-                              (string-match "\\`.*" doc-text)
-                              (match-string 0 doc-text))
-                       :widget-doc doc-text
-                       "?")
-                    ;; A single line is just inserted.
-                    (widget-create-child-and-convert
-                     widget 'item :format "%d" :doc doc-text nil))
-                  buttons)))
-         (t 
-          (widget-default-format-handler widget escape)))
-    (widget-put widget :buttons buttons)))
-
 ;;; The Sexp Widgets.
 
 (define-widget 'const 'item
   "An immutable sexp."
-  :format "%t\n")
+  :format "%t\n%d")
 
 (define-widget 'function-item 'item
   "An immutable function name."
   :format "%v\n%h"
-  :format-handler 'widget-help-format-handler
   :documentation-property (lambda (symbol)
                            (condition-case nil
                                (documentation symbol t)
@@ -1692,7 +1716,6 @@ With optional ARG, move across that many fields."
 (define-widget 'variable-item 'item
   "An immutable variable name."
   :format "%v\n%h"
-  :format-handler 'widget-help-format-handler
   :documentation-property 'variable-documentation
   :value-delete 'widget-radio-value-delete
   :match (lambda (widget value) (symbolp value)))
@@ -1735,10 +1758,14 @@ It will read a directory name from the minibuffer when activated."
   :value nil
   :tag "Symbol"
   :match (lambda (widget value) (symbolp value))
-  :value-to-internal (lambda (widget value) (and (symbolp value)
-                                                (symbol-name value)))
-  :value-to-external (lambda (widget value) (and (stringp value)
-                                                (intern value))))
+  :value-to-internal (lambda (widget value)
+                      (if (symbolp value)
+                          (symbol-name value)
+                        value))
+  :value-to-external (lambda (widget value)
+                      (if (stringp value)
+                          (intern value)
+                        value)))
 
 (define-widget 'function 'symbol
   ;; Should complete on functions.
@@ -1796,6 +1823,10 @@ It will read a directory name from the minibuffer when activated."
   :tag "Integer"
   :value 0
   :type-error "This field should contain an integer"
+  :value-to-internal (lambda (widget value)
+                      (if (integerp value) 
+                          (prin1-to-string value)
+                        value))
   :match (lambda (widget value) (integerp value)))
 
 (define-widget 'number 'sexp
@@ -1803,6 +1834,10 @@ It will read a directory name from the minibuffer when activated."
   :tag "Number"
   :value 0.0
   :type-error "This field should contain a number"
+  :value-to-internal (lambda (widget value)
+                      (if (numberp value)
+                          (prin1-to-string value)
+                        value))
   :match (lambda (widget value) (numberp value)))
 
 (define-widget 'hook 'sexp 
@@ -1840,7 +1875,7 @@ It will read a directory name from the minibuffer when activated."
 (defun widget-cons-match (widget value) 
   (and (consp value)
        (widget-group-match widget
-                          (widget-apply :value-to-internal widget value))))
+                          (widget-apply widget :value-to-internal value))))
 
 (define-widget 'choice 'menu-choice
   "A union of several sexp types."
@@ -1855,12 +1890,12 @@ It will read a directory name from the minibuffer when activated."
 (define-widget 'repeat 'editable-list
   "A variable length homogeneous list."
   :tag "Repeat"
-  :format "%[%t%]:\n%v%i\n")
+  :format "%t:\n%v%i\n")
 
 (define-widget 'set 'checklist
   "A list of members from a fixed set."
   :tag "Set"
-  :format "%[%t%]:\n%v")
+  :format "%t:\n%v")
 
 (define-widget 'boolean 'toggle
   "To be nil or non-nil, that is the question."
@@ -1935,6 +1970,51 @@ It will read a directory name from the minibuffer when activated."
     (unless (zerop (length answer))
       (widget-value-set widget answer))))
 
+;;; The Help Echo
+
+(defun widget-echo-help-mouse ()
+  "Display the help message for the widget under the mouse.
+Enable with (run-with-idle-timer 2 t 'widget-echo-help-mouse)"
+  (let* ((pos (mouse-position))
+        (frame (car pos))
+        (x (car (cdr pos)))
+        (y (cdr (cdr pos)))
+        (win (window-at x y frame))
+        (where (coordinates-in-window-p (cons x y) win)))
+    (when (consp where)
+      (save-window-excursion
+       (progn ; save-excursion
+         (select-window win)
+         (let* ((result (compute-motion (window-start win)
+                                        '(0 . 0)
+                                        (window-end win)
+                                        where
+                                        (window-width win)
+                                        (cons (window-hscroll) 0)
+                                        win)))
+           (when (and (eq (nth 1 result) x)
+                      (eq (nth 2 result) y))
+             (widget-echo-help (nth 0 result))))))))
+  (unless track-mouse
+    (setq track-mouse t)
+    (add-hook 'post-command-hook 'widget-stop-mouse-tracking)))
+
+(defun widget-stop-mouse-tracking (&rest args)
+  "Stop the mouse tracking done while idle."
+  (remove-hook 'post-command-hook 'widget-stop-mouse-tracking)
+  (setq track-mouse nil))
+
+(defun widget-echo-help (pos)
+  "Display the help echo for widget at POS."
+  (let* ((widget (or (get-text-property pos 'button)
+                    (get-text-property pos 'field)))
+        (help-echo (and widget (widget-get widget :help-echo))))
+    (cond ((stringp help-echo)
+          (message "%s" help-echo))
+         ((and (symbolp help-echo) (fboundp help-echo)
+               (stringp (setq help-echo (funcall help-echo widget))))
+          (message "%s" help-echo)))))
+
 ;;; The End:
 
 (provide 'widget-edit)
index 6c3b1c3..bde0b98 100644 (file)
@@ -4,7 +4,7 @@
 ;;
 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
 ;; Keywords: help, extensions, faces, hypermedia
-;; Version: 0.96
+;; Version: 0.98
 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
 
 ;;; Commentary:
index cde367f..6a4bb4e 100644 (file)
@@ -1,3 +1,7 @@
+Sat Sep 28 21:36:40 1996  Lars Magne Ingebrigtsen  <larsi@ylfing.ifi.uio.no>
+
+       * gnus.texi (Foreign Groups): Addition.
+
 Mon Sep 23 22:17:44 1996  Lars Magne Ingebrigtsen  <larsi@ifi.uio.no>
 
        * gnus.texi (The Summary Buffer): Addition.
index 663f1d7..78edd54 100644 (file)
@@ -1,7 +1,7 @@
 \input texinfo                  @c -*-texinfo-*-
 
 @setfilename gnus
-@settitle Red Gnus 0.44 Manual
+@settitle Red Gnus 0.45 Manual
 @synindex fn cp
 @synindex vr cp
 @synindex pg cp
@@ -287,7 +287,7 @@ into another language, under the above conditions for modified versions.
 @tex
 
 @titlepage
-@title Red Gnus 0.44 Manual
+@title Red Gnus 0.45 Manual
 
 @author by Lars Magne Ingebrigtsen
 @page
@@ -1690,6 +1690,12 @@ Rename the current group to something else
 groups---mail groups mostly.  This command might very well be quite slow
 on some backends.
 
+@item G c
+@kindex G c (Group)
+@cindex customizing
+@findex gnus-group-customize
+Customize the group parameters (@code{gnus-group-customize}).
+
 @item G e
 @kindex G e (Group)
 @findex gnus-group-edit-group-method
@@ -10580,13 +10586,25 @@ These three match keys use the same match types as the @code{From} (etc)
 header uses.
 
 @item Followup
-This match key will add a score entry on all articles that followup to
-some author.  Uses the same match types as the @code{From} header uses.
+This match key is somewhat special, in that it will match the
+@code{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.  Uses the same match types as the @code{From} header
+uses.
 
 @item Thread
-This match key will add a score entry on all articles that are part of
-a thread.  Uses the same match types as the @code{References} header
-uses.
+This match key works along the same lines as the @code{Followup} match
+key.  If you say that you want to score on a (sub-)thread that is
+started by an article with a @code{Message-ID} @var{X}, then you add a
+@samp{thread} match.  This will add a new @samp{thread} match for each
+article that has @var{X} in its @code{References} header.  (These new
+@samp{thread} matches will use the @code{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 @code{References} headers.  Note that using this may lead to
+undeterministic scores of the articles in the thread.
 @end table
 @end enumerate
 
@@ -10615,7 +10633,7 @@ are assumed to be score files as well, and will be loaded the same way
 this one was.
 
 @item exclude-files
-The clue of this entry should be any number of files.  This files will
+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.