[Emacs-diffs] Changes to emacs/lisp/gnus/gnus-score.el,v

[Miles Bader]

CVSROOT:        /cvsroot/emacs
Module name:    emacs
Changes by:     Miles Bader <miles>     07/10/28 09:18:40

Index: lisp/gnus/gnus-score.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/gnus/gnus-score.el,v
retrieving revision 1.31
retrieving revision 1.32
diff -u -b -r1.31 -r1.32
--- lisp/gnus/gnus-score.el     13 Aug 2007 13:41:20 -0000      1.31
+++ lisp/gnus/gnus-score.el     28 Oct 2007 09:18:34 -0000      1.32
@@ -37,8 +37,6 @@
 (require 'message)
 (require 'score-mode)
 
-(autoload 'ffap-string-at-point "ffap")
-
 (defcustom gnus-global-score-files nil
   "List of global score files and directories.
 Set this variable if you want to use people's score files.  One entry
@@ -149,9 +147,15 @@
   :type 'boolean)
 
 (defcustom gnus-decay-scores nil
-  "*If non-nil, decay non-permanent scores."
+  "*If non-nil, decay non-permanent scores.
+
+If it is a regexp, only decay score files matching regexp."
   :group 'gnus-score-decay
-  :type 'boolean)
+  :type `(choice (const :tag "never" nil)
+                (const :tag "always" t)
+                (const :tag "adaptive score files"
+                       ,(concat "\\." gnus-adaptive-file-suffix "\\'"))
+                (regexp)))
 
 (defcustom gnus-decay-score-function 'gnus-decay-score
   "*Function called to decay a score.
@@ -318,6 +322,13 @@
   :group 'gnus-score-files
   :type 'regexp)
 
+(defcustom gnus-adaptive-pretty-print nil
+  "If non-nil, adaptive score files fill are pretty printed."
+  :group 'gnus-score-files
+  :group 'gnus-score-adapt
+  :version "23.0" ;; No Gnus
+  :type 'boolean)
+
 (defcustom gnus-score-default-header nil
   "Default header when entering new scores.
 
@@ -411,6 +422,18 @@
   :group 'gnus-score-various
   :type 'boolean)
 
+(defcustom gnus-inhibit-slow-scoring nil
+  "Inhibit slow scoring, e.g. scoring on headers or body.
+
+If a regexp, scoring on headers or body is inhibited if the group
+matches the regexp.  If it is t, scoring on headers or body is
+inhibited for all groups."
+  :group 'gnus-score-various
+  :version "23.0" ;; No Gnus
+  :type '(choice (const :tag "All" nil)
+                (const :tag "None" t)
+                regexp))
+
 
 
 ;; Internal variables.
@@ -753,7 +776,7 @@
        (setq i (1+ i))))
     (goto-char (point-min))
     ;; display ourselves in a small window at the bottom
-    (gnus-appt-select-lowest-window)
+    (gnus-select-lowest-window)
     (if (< (/ (window-height) 2) window-min-height)
        (switch-to-buffer "*Score Help*")
       (split-window)
@@ -1099,6 +1122,16 @@
      4 (substitute-command-keys
        "\\<gnus-score-mode-map>\\[gnus-score-edit-exit] to save edits"))))
 
+(defun gnus-score-edit-all-score ()
+  "Edit the all.SCORE file."
+  (interactive)
+  (find-file (gnus-score-file-name "all"))
+  (gnus-score-mode)
+  (setq gnus-score-edit-exit-function 'gnus-score-edit-done)
+  (gnus-message
+   4 (substitute-command-keys
+      "\\<gnus-score-mode-map>\\[gnus-score-edit-exit] to save edits")))
+
 (defun gnus-score-edit-file (file)
   "Edit a score file."
   (interactive
@@ -1128,9 +1161,9 @@
         (reg " -> +")
         (file (save-excursion
                 (end-of-line)
-                (if (and (re-search-backward reg (gnus-point-at-bol) t)
-                         (re-search-forward  reg (gnus-point-at-eol) t))
-                    (buffer-substring (point) (gnus-point-at-eol))
+                (if (and (re-search-backward reg (point-at-bol) t)
+                         (re-search-forward  reg (point-at-eol) t))
+                    (buffer-substring (point) (point-at-eol))
                   nil))))
     (if (or (not file)
            (string-match "\\<\\(non-file rule\\|A file\\)\\>" file)
@@ -1209,7 +1242,9 @@
          (decay (car (gnus-score-get 'decay alist)))
          (eval (car (gnus-score-get 'eval alist))))
       ;; Perform possible decays.
-      (when (and gnus-decay-scores
+      (when (and (if (stringp gnus-decay-scores)
+                    (string-match gnus-decay-scores file)
+                  gnus-decay-scores)
                 (or cached (file-exists-p file))
                 (or (not decay)
                     (gnus-decay-scores alist decay)))
@@ -1219,8 +1254,7 @@
       ;; files.
       (when (and files (not global))
        (setq lists (apply 'append lists
-                          (mapcar (lambda (file)
-                                    (gnus-score-load-file file))
+                          (mapcar 'gnus-score-load-file
                                   (if adapt-file (cons adapt-file files)
                                     files)))))
       (when (and eval (not global))
@@ -1412,12 +1446,13 @@
          (setq score (setcdr entry (gnus-delete-alist 'touched score)))
          (erase-buffer)
          (let (emacs-lisp-mode-hook)
-           (if (string-match
+           (if (and (not gnus-adaptive-pretty-print)
+                    (string-match
                 (concat (regexp-quote gnus-adaptive-file-suffix) "$")
-                file)
-               ;; This is an adaptive score file, so we do not run
-               ;; it through `pp'.  These files can get huge, and
-               ;; are not meant to be edited by human hands.
+                     file))
+               ;; This is an adaptive score file, so we do not run it through
+               ;; `pp' unless requested.  These files can get huge, and are
+               ;; not meant to be edited by human hands.
                (gnus-prin1 score)
              ;; This is a normal score file, so we print it very
              ;; prettily.
@@ -1518,8 +1553,21 @@
                                        (length (gnus-score-get header score)))
                                      scores)))
                ;; Call the scoring function for this type of "header".
-               (when (setq new (funcall (nth 2 entry) scores header
-                                        now expire trace))
+               (when (if (and gnus-inhibit-slow-scoring
+                              (if (and (stringp gnus-inhibit-slow-scoring)
+                                       ;; Always true here?
+                                       ;; (stringp gnus-newsgroup-name)
+                                       (string-match gnus-inhibit-slow-scoring
+                                                     gnus-newsgroup-name))
+                                  t
+                                nil)
+                              (> 0 (nth 1 (assoc header gnus-header-index))))
+                         (progn
+                           (gnus-message
+                            7 "Scoring on headers or body skipped.")
+                           nil)
+                       (setq new (funcall (nth 2 entry) scores header
+                                          now expire trace)))
                  (push new news))))
            (when (gnus-buffer-live-p gnus-summary-buffer)
              (let ((scored gnus-newsgroup-scored))
@@ -1860,7 +1908,7 @@
            (goto-char (point-min))
            (if (= dmt ?e)
                (while (funcall search-func match nil t)
-                 (and (= (gnus-point-at-bol)
+                 (and (= (point-at-bol)
                          (match-beginning 0))
                       (= (progn (end-of-line) (point))
                          (match-end 0))
@@ -2030,7 +2078,7 @@
                        (funcall search-func match nil t))
              ;; Is it really exact?
              (and (eolp)
-                  (= (gnus-point-at-bol) (match-beginning 0))
+                  (= (point-at-bol) (match-beginning 0))
                   ;; Yup.
                   (progn
                     (setq found (setq arts (get-text-property
@@ -2120,7 +2168,7 @@
          (goto-char (point-min))
          (while (and (not (eobp))
                      (search-forward match nil t))
-           (when (and (= (gnus-point-at-bol) (match-beginning 0))
+           (when (and (= (point-at-bol) (match-beginning 0))
                       (eolp))
              (setq found (setq arts (get-text-property (point) 'articles)))
              (if trace
@@ -2194,12 +2242,9 @@
 (defun gnus-enter-score-words-into-hashtb (hashtb)
   ;; Find all the words in the buffer and enter them into
   ;; the hashtable.
-  (let ((syntab (syntax-table))
-       word val)
+  (let (word val)
     (goto-char (point-min))
-    (unwind-protect
-       (progn
-         (set-syntax-table gnus-adaptive-word-syntax-table)
+    (with-syntax-table gnus-adaptive-word-syntax-table
          (while (re-search-forward "\\b\\w+\\b" nil t)
            (setq val
                  (gnus-gethash
@@ -2208,9 +2253,8 @@
                   hashtb))
            (gnus-sethash
             word
-            (append (get-text-property (gnus-point-at-eol) 'articles) val)
+        (append (get-text-property (point-at-eol) 'articles) val)
             hashtb)))
-      (set-syntax-table syntab))
     ;; Make all the ignorable words ignored.
     (let ((ignored (append gnus-ignored-adaptive-words
                           (if gnus-adaptive-word-no-group-words
@@ -2313,11 +2357,8 @@
        (let* ((hashtb (gnus-make-hashtable 1000))
               (date (date-to-day (current-time-string)))
               (data gnus-newsgroup-data)
-              (syntab (syntax-table))
               word d score val)
-         (unwind-protect
-             (progn
-               (set-syntax-table gnus-adaptive-word-syntax-table)
+         (with-syntax-table gnus-adaptive-word-syntax-table
                ;; Go through all articles.
                (while (setq d (pop data))
                  (when (and
@@ -2345,7 +2386,6 @@
                            (setq val gnus-adaptive-word-minimum))
                        (gnus-sethash word val hashtb)))
                    (erase-buffer))))
-           (set-syntax-table syntab))
          ;; Make all the ignorable words ignored.
          (let ((ignored (append gnus-ignored-adaptive-words
                                 (if gnus-adaptive-word-no-group-words
@@ -2373,7 +2413,8 @@
     (when winconf
       (set-window-configuration winconf))
     (gnus-score-remove-from-cache bufnam)
-    (gnus-score-load-file bufnam)))
+    (gnus-score-load-file bufnam)
+    (run-hooks 'gnus-score-edit-done-hook)))
 
 (defun gnus-score-find-trace ()
   "Find all score rules that applies to the current article."
@@ -2401,6 +2442,11 @@
                         (interactive)
                         (bury-buffer nil)
                         (gnus-summary-expand-window)))
+       (local-set-key "k"
+                      (lambda ()
+                        (interactive)
+                        (kill-buffer (current-buffer))
+                        (gnus-summary-expand-window)))
        (local-set-key "e" (lambda ()
                             "Run `gnus-score-edit-file-at-point'."
                             (interactive)
@@ -2429,7 +2475,7 @@
 Type `e' to edit score file corresponding to the score rule on current line,
 `f' to format (pretty print) the score file and edit it,
 `t' toggle to truncate long lines in this buffer,
-`q' to quit.
+`q' to quit, `k' to kill score trace buffer.
 
 The first sexp on each line is the score rule, followed by the file name of
 the score file and its full name, including the directory.")
@@ -2775,9 +2821,7 @@
            (lambda (file)
              (cons (inline (gnus-score-file-rank file)) file))
            files)))
-      (mapcar
-       (lambda (f) (cdr f))
-       (sort alist 'car-less-than-car)))))
+      (mapcar 'cdr (sort alist 'car-less-than-car)))))
 
 (defun gnus-score-find-alist (group)
   "Return list of score files for GROUP.