;;; gnus-score.el --- scoring code for Gnus
-;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
+
+;; Copyright (C) 1995-2012 Free Software Foundation, Inc.
;; Author: Per Abrahamsen <amanda@iesd.auc.dk>
-;; Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; 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.
+;; the Free Software Foundation, either version 3 of the License, 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
;; 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.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
+(eval-when-compile (require 'cl))
+
(require 'gnus)
(require 'gnus-sum)
(require 'gnus-range)
+(require 'gnus-win)
+(require 'message)
+(require 'score-mode)
(defcustom gnus-global-score-files nil
"List of global score files and directories.
by itself what score files are applicable to which group.
Say you want to use the single score file
-\"/ftp.ifi.uio.no@ftp:/pub/larsi/ding/score/soc.motss.SCORE\" and all
+\"/ftp.gnus.org@ftp:/pub/larsi/ding/score/soc.motss.SCORE\" and all
score files in the \"/ftp.some-where:/pub/score\" directory.
(setq gnus-global-score-files
- '(\"/ftp.ifi.uio.no:/pub/larsi/ding/score/soc.motss.SCORE\"
- \"/ftp.some-where:/pub/score\"))"
+ '(\"/ftp.gnus.org:/pub/larsi/ding/score/soc.motss.SCORE\"
+ \"/ftp.some-where:/pub/score\"))"
:group 'gnus-score-files
:type '(repeat file))
If the name of a group is matched by REGEXP, the corresponding scorefiles
will be used for that group.
The first match found is used, subsequent matching entries are ignored (to
-use multiple matches, see gnus-score-file-multiple-match-alist).
+use multiple matches, see `gnus-score-file-multiple-match-alist').
These score files are loaded in addition to any files returned by
-gnus-score-find-score-files-function (which see)."
+`gnus-score-find-score-files-function'."
:group 'gnus-score-files
:type '(repeat (cons regexp (repeat file))))
will be used for that group.
If multiple REGEXPs match a group, the score files corresponding to each
match will be used (for only one match to be used, see
-gnus-score-file-single-match-alist).
+`gnus-score-file-single-match-alist').
These score files are loaded in addition to any files returned by
-gnus-score-find-score-files-function (which see)."
+`gnus-score-find-score-files-function'."
:group 'gnus-score-files
:type '(repeat (cons regexp (repeat file))))
Predefined values are:
-gnus-score-find-single: Only apply the group's own score file.
-gnus-score-find-hierarchical: Also apply score files from parent groups.
-gnus-score-find-bnews: Apply score files whose names matches.
+`gnus-score-find-single': Only apply the group's own score file.
+`gnus-score-find-hierarchical': Also apply score files from parent groups.
+`gnus-score-find-bnews': Apply score files whose names matches.
See the documentation to these functions for more information.
This variable can also be a list of functions to be called. Each
-function should either return a list of score files, or a list of
-score alists."
+function is given the group name as argument and should either return
+a list of score files, or a list of score alists.
+
+If functions other than these pre-defined functions are used,
+the `a' symbolic prefix to the score commands will always use
+\"all.SCORE\"."
:group 'gnus-score-files
:type '(radio (function-item gnus-score-find-single)
(function-item gnus-score-find-hierarchical)
(function-item gnus-score-find-bnews)
- (function :tag "Other")))
+ (repeat :tag "List of functions"
+ (choice (function :tag "Other" :value 'ignore)
+ (function-item gnus-score-find-single)
+ (function-item gnus-score-find-hierarchical)
+ (function-item gnus-score-find-bnews)))
+ (function :tag "Other" :value 'ignore)))
(defcustom gnus-score-interactive-default-score 1000
"*Scoring commands will raise/lower the score with this number as the default."
number))
(defcustom gnus-update-score-entry-dates t
- "*In non-nil, update matching score entry dates.
+ "*If non-nil, update matching score entry dates.
If this variable is nil, then score entries that provide matches
will be expired along with non-matching score entries."
:group 'gnus-score-expire
:type 'boolean)
-(defcustom gnus-orphan-score nil
- "*All orphans get this score added. Set in the score file."
- :group 'gnus-score-default
- :type 'integer)
-
(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.
It can be:
* A string
- This file file will be used as the home score file.
+ This file will be used as the home score file.
* A function
The result of this function will be used as the home score file.
The elements in this list can be:
* `(regexp file-name ...)'
- If the `regexp' matches the group name, the first `file-name' will
+ If the `regexp' matches the group name, the first `file-name'
will be used as the home score file. (Multiple filenames are
allowed so that one may use gnus-score-file-single-match-alist to
set this variable.)
* A function.
If the function returns non-nil, the result will be used
- as the home score file. The function will be passed the
+ as the home score file. The function will be passed the
name of the group as its parameter.
* A string. Use the string as the home score file.
(repeat (choice string
(cons regexp (repeat file))
function))
+ (function-item gnus-hierarchial-home-score-file)
+ (function-item gnus-current-home-score-file)
function))
(defcustom gnus-home-adapt-file nil
function))
function))
-(defcustom gnus-default-adaptive-score-alist
- '((gnus-kill-file-mark)
+(defcustom gnus-default-adaptive-score-alist
+ `((gnus-kill-file-mark)
(gnus-unread-mark)
- (gnus-read-mark (from 3) (subject 30))
- (gnus-catchup-mark (subject -10))
- (gnus-killed-mark (from -1) (subject -20))
- (gnus-del-mark (from -2) (subject -15)))
-"Alist of marks and scores."
-:group 'gnus-score-adapt
-:type '(repeat (cons (symbol :tag "Mark")
- (repeat (list (choice :tag "Header"
- (const from)
- (const subject)
- (symbol :tag "other"))
- (integer :tag "Score"))))))
+ (gnus-read-mark
+ (from , (+ 2 gnus-score-decay-constant))
+ (subject , (+ 27 gnus-score-decay-constant)))
+ (gnus-catchup-mark
+ (subject , (+ -7 (* -1 gnus-score-decay-constant))))
+ (gnus-killed-mark
+ (from , (- -1 gnus-score-decay-constant))
+ (subject , (+ -17 (* -1 gnus-score-decay-constant))))
+ (gnus-del-mark
+ (from , (- -1 gnus-score-decay-constant))
+ (subject , (+ -12 (* -1 gnus-score-decay-constant)))))
+ "Alist of marks and scores.
+If you use score decays, you might want to set values higher than
+`gnus-score-decay-constant'."
+ :group 'gnus-score-adapt
+ :type '(repeat (cons (symbol :tag "Mark")
+ (repeat (list (choice :tag "Header"
+ (const from)
+ (const subject)
+ (symbol :tag "other"))
+ (integer :tag "Score"))))))
+
+(defcustom gnus-adaptive-word-length-limit nil
+ "*Words of a length lesser than this limit will be ignored when doing adaptive scoring."
+ :version "22.1"
+ :group 'gnus-score-adapt
+ :type '(radio (const :format "Unlimited " nil)
+ (integer :format "Maximum length: %v")))
(defcustom gnus-ignored-adaptive-words nil
"List of words to be ignored when doing adaptive word scoring."
"being" "current" "back" "still" "go" "point" "value" "each" "did"
"both" "true" "off" "say" "another" "state" "might" "under" "start"
"try" "re")
- "Default list of words to be ignored when doing adaptive word scoring."
+ "*Default list of words to be ignored when doing adaptive word scoring."
:group 'gnus-score-adapt
:type '(repeat string))
-(defcustom gnus-default-adaptive-word-score-alist
+(defcustom gnus-default-adaptive-word-score-alist
`((,gnus-read-mark . 30)
(,gnus-catchup-mark . -10)
(,gnus-killed-mark . -20)
(,gnus-del-mark . -15))
-"Alist of marks and scores."
-:group 'gnus-score-adapt
-:type '(repeat (cons (character :tag "Mark")
- (integer :tag "Score"))))
+ "*Alist of marks and scores."
+ :group 'gnus-score-adapt
+ :type '(repeat (cons (character :tag "Mark")
+ (integer :tag "Score"))))
+
+(defcustom gnus-adaptive-word-minimum nil
+ "If a number, this is the minimum score value that can be assigned to a word."
+ :group 'gnus-score-adapt
+ :type '(choice (const nil) integer))
+
+(defcustom gnus-adaptive-word-no-group-words nil
+ "If t, don't adaptively score words included in the group name."
+ :group 'gnus-score-adapt
+ :type 'boolean)
(defcustom gnus-score-mimic-keymap nil
"*Have the score entry functions pretend that they are a keymap."
: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.1" ;; No Gnus
+ :type 'boolean)
+
(defcustom gnus-score-default-header nil
"Default header when entering new scores.
i: message-id
t: references
x: xref
+ e: `extra' (non-standard overview)
l: lines
d: date
f: followup
(const :tag "message-id" i)
(const :tag "references" t)
(const :tag "xref" x)
+ (const :tag "extra" e)
(const :tag "lines" l)
(const :tag "date" d)
- (const :tag "followup" f)))
+ (const :tag "followup" f)
+ (const :tag "ask" nil)))
(defcustom gnus-score-default-type nil
"Default match type when entering new scores.
f: fuzzy string
r: regexp string
b: before date
- a: at date
+ a: after date
n: this date
<: less than number
>: greater than number
(const :tag "fuzzy string" f)
(const :tag "regexp string" r)
(const :tag "before date" b)
- (const :tag "at date" a)
+ (const :tag "after date" a)
(const :tag "this date" n)
(const :tag "less than number" <)
(const :tag "greater than number" >)
- (const :tag "equal than number" =)))
+ (const :tag "equal than number" =)
+ (const :tag "ask" nil)))
(defcustom gnus-score-default-fold nil
- "Use case folding for new score file entries iff not nil."
+ "Non-nil means use case folding for new score file entries."
:group 'gnus-score-default
:type 'boolean)
:group 'gnus-score-default
:type '(choice (const :tag "temporary" t)
(const :tag "permanent" p)
- (const :tag "immediate" i)))
+ (const :tag "immediate" i)
+ (const :tag "ask" nil)))
(defcustom gnus-score-after-write-file-function nil
"Function called with the name of the score file just written to disk."
:group 'gnus-score-files
- :type 'function)
+ :type '(choice (const nil) function))
+
+(defcustom gnus-score-thread-simplify nil
+ "If non-nil, subjects will simplified as in threading."
+ :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.1" ;; No Gnus
+ :type '(choice (const :tag "All" nil)
+ (const :tag "None" t)
+ regexp))
\f
;; Internal variables.
+(defvar gnus-score-use-all-scores t
+ "If nil, only `gnus-score-find-score-files-function' is used.")
+
(defvar gnus-adaptive-word-syntax-table
(let ((table (copy-syntax-table (standard-syntax-table)))
(numbers '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9)))
(defvar gnus-score-alist nil
"Alist containing score information.
-The keys can be symbols or strings. The following symbols are defined.
+The keys can be symbols or strings. The following symbols are defined.
touched: If this alist has been modified.
mark: Automatically mark articles below this.
("chars" 6 gnus-score-integer)
("lines" 7 gnus-score-integer)
("xref" 8 gnus-score-string)
+ ("extra" 9 gnus-score-string)
("head" -1 gnus-score-body)
("body" -1 gnus-score-body)
("all" -1 gnus-score-body)
(gnus-define-keys (gnus-summary-score-map "V" gnus-summary-mode-map)
"s" gnus-summary-set-score
- "a" gnus-summary-score-entry
"S" gnus-summary-current-score
"c" gnus-score-change-score-file
"C" gnus-score-customize
;; Much modification of the kill (ahem, score) code and lots of the
;; functions are written by Per Abrahamsen <amanda@iesd.auc.dk>.
-(defun gnus-summary-lower-score (&optional score)
+(defun gnus-summary-lower-score (&optional score symp)
"Make a score entry based on the current article.
The user will be prompted for header to score on, match type,
-permanence, and the string to be used. The numerical prefix will be
-used as score."
- (interactive "P")
- (gnus-summary-increase-score (- (gnus-score-default score))))
+permanence, and the string to be used. The numerical prefix will
+be used as SCORE. A symbolic prefix of `a' (the SYMP parameter)
+says to use the `all.SCORE' file for the command instead of the
+current score file."
+ (interactive (gnus-interactive "P\ny"))
+ (gnus-summary-increase-score (- (gnus-score-delta-default score)) symp))
(defun gnus-score-kill-help-buffer ()
(when (get-buffer "*Score Help*")
(when gnus-score-help-winconf
(set-window-configuration gnus-score-help-winconf))))
-(defun gnus-summary-increase-score (&optional score)
+(defun gnus-summary-increase-score (&optional score symp)
"Make a score entry based on the current article.
The user will be prompted for header to score on, match type,
-permanence, and the string to be used. The numerical prefix will be
-used as score."
- (interactive "P")
- (gnus-set-global-variables)
- (let* ((nscore (gnus-score-default score))
+permanence, and the string to be used. The numerical prefix will
+be used as SCORE. A symbolic prefix of `a' (the SYMP parameter)
+says to use the `all.SCORE' file for the command instead of the
+current score file."
+ (interactive (gnus-interactive "P\ny"))
+ (let* ((nscore (gnus-score-delta-default score))
(prefix (if (< nscore 0) ?L ?I))
(increase (> nscore 0))
- (char-to-header
+ (char-to-header
'((?a "from" nil nil string)
(?s "subject" nil nil string)
(?b "body" "" nil body-string)
(?h "head" "" nil body-string)
- (?i "message-id" nil t string)
- (?t "references" "message-id" nil string)
+ (?i "message-id" nil nil string)
+ (?r "references" "message-id" nil string)
(?x "xref" nil nil string)
+ (?e "extra" nil nil string)
(?l "lines" nil nil number)
(?d "date" nil nil date)
(?f "followup" nil nil string)
- (?T "thread" nil nil string)))
+ (?t "thread" "message-id" nil string)))
(char-to-type
'((?s s "substring" string)
(?e e "exact string" string)
(?z s "substring" body-string)
(?p r "regexp string" body-string)
(?b before "before date" date)
- (?a at "at date" date)
- (?n now "this date" date)
+ (?a after "after date" date)
+ (?n at "this date" date)
(?< < "less than number" number)
(?> > "greater than number" number)
(?= = "equal to number" number)))
+ (current-score-file gnus-current-score-file)
(char-to-perm
(list (list ?t (current-time-string) "temporary")
'(?p perm "permanent") '(?i now "immediate")))
(mimic gnus-score-mimic-keymap)
- (hchar (and gnus-score-default-header
+ (hchar (and gnus-score-default-header
(aref (symbol-name gnus-score-default-header) 0)))
(tchar (and gnus-score-default-type
(aref (symbol-name gnus-score-default-type) 0)))
(pchar (and gnus-score-default-duration
(aref (symbol-name gnus-score-default-duration) 0)))
- entry temporary type match)
-
+ entry temporary type match extra)
+
(unwind-protect
(progn
;; First we read the header to score.
(while (not hchar)
(if mimic
- (progn
+ (progn
(sit-for 1)
(message "%c-" prefix))
(message "%s header (%s?): " (if increase "Increase" "Lower")
(gnus-score-kill-help-buffer)
(unless (setq entry (assq (downcase hchar) char-to-header))
- (if mimic (error "%c %c" prefix hchar) (error "")))
+ (if mimic (error "%c %c" prefix hchar)
+ (error "Invalid header type")))
(when (/= (downcase hchar) hchar)
;; This was a majuscule, so we end reading and set the defaults.
(if mimic (message "%c %c" prefix hchar) (message ""))
(setq tchar (or tchar ?s)
pchar (or pchar ?t)))
-
- ;; We continue reading - the type.
- (while (not tchar)
- (if mimic
- (progn
- (sit-for 1) (message "%c %c-" prefix hchar))
- (message "%s header '%s' with match type (%s?): "
- (if increase "Increase" "Lower")
- (nth 1 entry)
- (mapconcat (lambda (s)
- (if (eq (nth 4 entry)
- (nth 3 s))
- (char-to-string (car s))
- ""))
- char-to-type "")))
- (setq tchar (read-char))
- (when (or (= tchar ??) (= tchar ?\C-h))
- (setq tchar nil)
- (gnus-score-insert-help
- "Match type"
- (delq nil
- (mapcar (lambda (s)
- (if (eq (nth 4 entry)
- (nth 3 s))
- s nil))
- char-to-type))
- 2)))
- (gnus-score-kill-help-buffer)
- (unless (setq type (nth 1 (assq (downcase tchar) char-to-type)))
- (if mimic (error "%c %c" prefix hchar) (error "")))
+ (let ((legal-types
+ (delq nil
+ (mapcar (lambda (s)
+ (if (eq (nth 4 entry)
+ (nth 3 s))
+ s nil))
+ char-to-type))))
+ ;; We continue reading - the type.
+ (while (not tchar)
+ (if mimic
+ (progn
+ (sit-for 1) (message "%c %c-" prefix hchar))
+ (message "%s header '%s' with match type (%s?): "
+ (if increase "Increase" "Lower")
+ (nth 1 entry)
+ (mapconcat (lambda (s) (char-to-string (car s)))
+ legal-types "")))
+ (setq tchar (read-char))
+ (when (or (= tchar ??) (= tchar ?\C-h))
+ (setq tchar nil)
+ (gnus-score-insert-help "Match type" legal-types 2)))
+
+ (gnus-score-kill-help-buffer)
+ (unless (setq type (nth 1 (assq (downcase tchar) legal-types)))
+ (if mimic (error "%c %c" prefix hchar)
+ (error "Invalid match type"))))
(when (/= (downcase tchar) tchar)
;; It was a majuscule, so we end reading and use the default.
(if mimic (message "%c %c %c" prefix hchar tchar)
(message ""))
- (setq pchar (or pchar ?p)))
+ (setq pchar (or pchar ?t)))
;; We continue reading.
(while (not pchar)
(gnus-score-insert-help "Match permanence" char-to-perm 2)))
(gnus-score-kill-help-buffer)
- (if mimic (message "%c %c %c" prefix hchar tchar pchar)
+ (if mimic (message "%c %c %c %c" prefix hchar tchar pchar)
(message ""))
(unless (setq temporary (cadr (assq pchar char-to-perm)))
;; Deal with der(r)ided superannuated paradigms.
(when (and (eq (1+ prefix) 77)
(eq (+ hchar 12) 109)
- (eq tchar 114)
+ (eq (1- tchar) 113)
(eq (- pchar 4) 111))
(error "You rang?"))
- (if mimic
+ (if mimic
(error "%c %c %c %c" prefix hchar tchar pchar)
- (error ""))))
+ (error "Invalid match duration"))))
;; Always kill the score help buffer.
(gnus-score-kill-help-buffer))
+ ;; If scoring an extra (non-standard overview) header,
+ ;; we must find out which header is in question.
+ (setq extra
+ (and gnus-extra-headers
+ (equal (nth 1 entry) "extra")
+ (intern ; need symbol
+ (let ((collection (mapcar 'symbol-name gnus-extra-headers)))
+ (gnus-completing-read
+ "Score extra header" ; prompt
+ collection ; completion list
+ t ; require match
+ nil ; no history
+ nil ; no initial-input
+ (car collection)))))) ; default value
+ ;; extra is now nil or a symbol.
+
;; We have all the data, so we enter this score.
(setq match (if (string= (nth 2 entry) "") ""
- (gnus-summary-header (or (nth 2 entry) (nth 1 entry)))))
-
+ (gnus-summary-header (or (nth 2 entry) (nth 1 entry))
+ nil extra)))
+
;; Modify the match, perhaps.
- (cond
+ (cond
((equal (nth 1 entry) "xref")
(when (string-match "^Xref: *" match)
(setq match (substring match (match-end 0))))
(when (string-match "^[^:]* +" match)
(setq match (substring match (match-end 0))))))
-
+
(when (memq type '(r R regexp Regexp))
(setq match (regexp-quote match)))
+ ;; Change score file to the "all.SCORE" file.
+ (when (eq symp 'a)
+ (with-current-buffer gnus-summary-buffer
+ (gnus-score-load-file
+ ;; This is a kludge; yes...
+ (cond
+ ((eq gnus-score-find-score-files-function
+ 'gnus-score-find-hierarchical)
+ (gnus-score-file-name ""))
+ ((eq gnus-score-find-score-files-function 'gnus-score-find-single)
+ current-score-file)
+ (t
+ (gnus-score-file-name "all"))))))
+
(gnus-summary-score-entry
(nth 1 entry) ; Header
match ; Match
(if (eq temporary 'perm) ; Temp
nil
temporary)
- (not (nth 3 entry))) ; Prompt
- ))
-
+ (not (nth 3 entry)) ; Prompt
+ nil ; not silent
+ extra) ; non-standard overview.
+
+ (when (eq symp 'a)
+ ;; We change the score file back to the previous one.
+ (with-current-buffer gnus-summary-buffer
+ (gnus-score-load-file current-score-file)))))
+
(defun gnus-score-insert-help (string alist idx)
(setq gnus-score-help-winconf (current-window-configuration))
- (save-excursion
- (set-buffer (get-buffer-create "*Score Help*"))
- (buffer-disable-undo (current-buffer))
+ (with-current-buffer (gnus-get-buffer-create "*Score Help*")
+ (buffer-disable-undo)
(delete-windows-on (current-buffer))
(erase-buffer)
(insert string ":\n\n")
(setq max (+ max 4)) ; %c, `:', SPACE, a SPACE at end
(setq n (/ (1- (window-width)) max)) ; items per line
(setq width (/ (1- (window-width)) n)) ; width of each item
- ;; insert `n' items, each in a field of width `width'
+ ;; insert `n' items, each in a field of width `width'
(while alist
(if (< i n)
()
(insert (format format (caar alist) (nth idx (car alist))))
(setq alist (cdr alist))
(setq i (1+ i))))
+ (goto-char (point-min))
;; display ourselves in a small window at the bottom
- (gnus-appt-select-lowest-window)
- (split-window)
- (pop-to-buffer "*Score Help*")
+ (gnus-select-lowest-window)
+ (if (< (/ (window-height) 2) window-min-height)
+ (switch-to-buffer "*Score Help*")
+ (split-window)
+ (pop-to-buffer "*Score Help*"))
(let ((window-min-height 1))
(shrink-window-if-larger-than-buffer))
- (select-window (get-buffer-window gnus-summary-buffer))))
-
-(defun gnus-summary-header (header &optional no-err)
+ (select-window (gnus-get-buffer-window gnus-summary-buffer t))))
+
+(defun gnus-summary-header (header &optional no-err extra)
;; Return HEADER for current articles, or error.
(let ((article (gnus-summary-article-number))
headers)
(if article
(if (and (setq headers (gnus-summary-article-header article))
(vectorp headers))
- (aref headers (nth 1 (assoc header gnus-header-index)))
+ (if extra ; `header' must be "extra"
+ (or (cdr (assq extra (mail-header-extra headers))) "")
+ (aref headers (nth 1 (assoc header gnus-header-index))))
(if no-err
nil
(error "Pseudo-articles can't be scored")))
(defun gnus-newsgroup-score-alist ()
(or
- (let ((param-file (gnus-group-find-parameter
+ (let ((param-file (gnus-group-find-parameter
gnus-newsgroup-name 'score-file)))
(when param-file
(gnus-score-load param-file)))
(defsubst gnus-score-get (symbol &optional alist)
;; Get SYMBOL's definition in ALIST.
- (cdr (assoc symbol
- (or alist
+ (cdr (assoc symbol
+ (or alist
gnus-score-alist
(gnus-newsgroup-score-alist)))))
(defun gnus-summary-score-entry (header match type score date
- &optional prompt silent)
+ &optional prompt silent extra)
"Enter score file entry.
HEADER is the header being scored.
MATCH is the string we are looking for.
SCORE is the score to add.
DATE is the expire date, or nil for no expire, or 'now for immediate expire.
If optional argument `PROMPT' is non-nil, allow user to edit match.
-If optional argument `SILENT' is nil, show effect of score entry."
- (interactive
- (list (completing-read "Header: "
- gnus-header-index
- (lambda (x) (fboundp (nth 2 x)))
- t)
- (read-string "Match: ")
- (if (y-or-n-p "Use regexp match? ") 'r 's)
- (and current-prefix-arg
- (prefix-numeric-value current-prefix-arg))
- (cond ((not (y-or-n-p "Add to score file? "))
- 'now)
- ((y-or-n-p "Expire kill? ")
- (current-time-string))
- (t nil))))
+If optional argument `SILENT' is nil, show effect of score entry.
+If optional argument `EXTRA' is non-nil, it's a non-standard overview header."
;; Regexp is the default type.
(when (eq type t)
(setq type 'r))
(setq match (if match (gnus-simplify-subject-re match) "")))
((eq type 'f)
(setq match (gnus-simplify-subject-fuzzy match))))
- (let ((score (gnus-score-default score))
- (header (format "%s" (downcase header)))
+ (let ((score (gnus-score-delta-default score))
+ (header (downcase header))
new)
+ (set-text-properties 0 (length header) nil header)
(when prompt
- (setq match (read-string
- (format "Match %s on %s, %s: "
+ (setq match (read-string
+ (format "Match %s on %s, %s: "
(cond ((eq date 'now)
"now")
((stringp date)
(int-to-string match)
match))))
- ;; Get rid of string props.
- (setq match (format "%s" match))
-
- ;; If this is an integer comparison, we transform from string to int.
- (when (eq (nth 2 (assoc header gnus-header-index)) 'gnus-score-integer)
- (setq match (string-to-int match)))
+ ;; If this is an integer comparison, we transform from string to int.
+ (if (eq (nth 2 (assoc header gnus-header-index)) 'gnus-score-integer)
+ (if (stringp match)
+ (setq match (string-to-number match)))
+ (set-text-properties 0 (length match) nil match))
(unless (eq date 'now)
;; Add the score entry to the score file.
(let ((old (gnus-score-get header))
elem)
(setq new
- (cond
+ (cond
+ (extra
+ (list match score
+ (and date (if (numberp date) date
+ (date-to-day date)))
+ type (symbol-name extra)))
(type
(list match score
(and date (if (numberp date) date
- (gnus-day-number date)))
+ (date-to-day date)))
type))
- (date (list match score (gnus-day-number date)))
+ (date (list match score (date-to-day date)))
(score (list match score))
(t (list match))))
;; We see whether we can collapse some score entries.
(or (nth 1 new)
gnus-score-interactive-default-score)))
;; Nope, we have to add a new elem.
- (gnus-score-set header (if old (cons new old) (list new))))
+ (gnus-score-set header (if old (cons new old) (list new)) nil t))
(gnus-score-set 'touched '(t))))
;; Score the current buffer.
(if (and (>= (nth 1 (assoc header gnus-header-index)) 0)
(eq (nth 2 (assoc header gnus-header-index))
'gnus-score-string))
- (gnus-summary-score-effect header match type score)
+ (gnus-summary-score-effect header match type score extra)
(gnus-summary-rescore)))
;; Return the new scoring rule.
new))
-(defun gnus-summary-score-effect (header match type score)
+(defun gnus-summary-score-effect (header match type score &optional extra)
"Simulate the effect of a score file entry.
HEADER is the header being scored.
MATCH is the string we are looking for.
TYPE is the score type.
-SCORE is the score to add."
- (interactive (list (completing-read "Header: "
- gnus-header-index
- (lambda (x) (fboundp (nth 2 x)))
- t)
+SCORE is the score to add.
+EXTRA is the possible non-standard header."
+ (interactive (list (gnus-completing-read "Header"
+ (mapcar
+ 'car
+ (gnus-remove-if-not
+ (lambda (x) (fboundp (nth 2 x)))
+ gnus-header-index))
+ t)
(read-string "Match: ")
- (y-or-n-p "Use regexp match? ")
- (prefix-numeric-value current-prefix-arg)))
+ (if (y-or-n-p "Use regexp match? ") 'r 's)
+ (string-to-number (read-string "Score: "))))
(save-excursion
(unless (and (stringp match) (> (length match) 0))
(error "No match"))
match)
((eq type 'e)
(concat "\\`" (regexp-quote match) "\\'"))
- (t
+ (t
(regexp-quote match)))))
(while (not (eobp))
- (let ((content (gnus-summary-header header 'noerr))
+ (let ((content (gnus-summary-header header 'noerr extra))
(case-fold-search t))
(and content
(when (if (eq type 'f)
(gnus-summary-raise-score score))))
(beginning-of-line 2))))
(gnus-set-mode-line 'summary))
-
-(defun gnus-summary-score-crossposting (score date)
- ;; Enter score file entry for current crossposting.
- ;; SCORE is the score to add.
- ;; DATE is the expire date.
- (let ((xref (gnus-summary-header "xref"))
- (start 0)
- group)
- (unless xref
- (error "This article is not crossposted"))
- (while (string-match " \\([^ \t]+\\):" xref start)
- (setq start (match-end 0))
- (when (not (string=
- (setq group
- (substring xref (match-beginning 1) (match-end 1)))
- gnus-newsgroup-name))
- (gnus-summary-score-entry
- "xref" (concat " " group ":") nil score date t)))))
-
\f
;;;
;;; Gnus Score Files
;; All score code written by Per Abrahamsen <abraham@iesd.auc.dk>.
-;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
(defun gnus-score-set-mark-below (score)
"Automatically mark articles with score below SCORE as read."
- (interactive
+ (interactive
(list (or (and current-prefix-arg (prefix-numeric-value current-prefix-arg))
- (string-to-int (read-string "Mark below: ")))))
+ (string-to-number (read-string "Mark below: ")))))
(setq score (or score gnus-summary-default-score 0))
(gnus-score-set 'mark (list score))
(gnus-score-set 'touched '(t))
(defun gnus-score-set-expunge-below (score)
"Automatically expunge articles with score below SCORE."
- (interactive
+ (interactive
(list (or (and current-prefix-arg (prefix-numeric-value current-prefix-arg))
- (string-to-int (read-string "Set expunge below: ")))))
+ (string-to-number (read-string "Set expunge below: ")))))
(setq score (or score gnus-summary-default-score 0))
(gnus-score-set 'expunge (list score))
(gnus-score-set 'touched '(t)))
(defun gnus-score-followup-article (&optional score)
"Add SCORE to all followups to the article in the current buffer."
(interactive "P")
- (setq score (gnus-score-default score))
+ (setq score (gnus-score-delta-default score))
(when (gnus-buffer-live-p gnus-summary-buffer)
(save-excursion
(save-restriction
(defun gnus-score-followup-thread (&optional score)
"Add SCORE to all later articles in the thread the current buffer is part of."
(interactive "P")
- (setq score (gnus-score-default score))
+ (setq score (gnus-score-delta-default score))
(when (gnus-buffer-live-p gnus-summary-buffer)
(save-excursion
(save-restriction
"references" id 's
score (current-time-string))))))))
-(defun gnus-score-set (symbol value &optional alist)
+(defun gnus-score-set (symbol value &optional alist warn)
;; Set SYMBOL to VALUE in ALIST.
- (let* ((alist
- (or alist
+ (let* ((alist
+ (or alist
gnus-score-alist
(gnus-newsgroup-score-alist)))
(entry (assoc symbol alist)))
(cond ((gnus-score-get 'read-only alist)
;; This is a read-only score file, so we do nothing.
- )
+ (when warn
+ (gnus-message 4 "Note: read-only score file; entry discarded")))
(entry
(setcdr entry value))
((null alist)
(defun gnus-summary-raise-score (n)
"Raise the score of the current article by N."
(interactive "p")
- (gnus-set-global-variables)
(gnus-summary-set-score (+ (gnus-summary-article-score)
(or n gnus-score-interactive-default-score ))))
(defun gnus-summary-set-score (n)
"Set the score of the current article to N."
(interactive "p")
- (gnus-set-global-variables)
(save-excursion
(gnus-summary-show-thread)
(let ((buffer-read-only nil))
;; Set score.
(gnus-summary-update-mark
- (if (= n (or gnus-summary-default-score 0)) ?
+ (if (= n (or gnus-summary-default-score 0)) ? ;Whitespace
(if (< n (or gnus-summary-default-score 0))
gnus-score-below-mark gnus-score-over-mark))
'score))
(defun gnus-summary-current-score ()
"Return the score of the current article."
(interactive)
- (gnus-set-global-variables)
(gnus-message 1 "%s" (gnus-summary-article-score)))
(defun gnus-score-change-score-file (file)
"Change current score alist."
- (interactive
+ (interactive
(list (read-file-name "Change to score file: " gnus-kill-files-directory)))
(gnus-score-load-file file)
(gnus-set-mode-line 'summary))
(defun gnus-score-edit-current-scores (file)
"Edit the current score alist."
(interactive (list gnus-current-score-file))
- (gnus-set-global-variables)
- (let ((winconf (current-window-configuration)))
- (when (buffer-name gnus-summary-buffer)
- (gnus-score-save))
- (gnus-make-directory (file-name-directory file))
- (setq gnus-score-edit-buffer (find-file-noselect file))
- (gnus-configure-windows 'edit-score)
- (gnus-score-mode)
- (setq gnus-score-edit-exit-function 'gnus-score-edit-done)
- (make-local-variable 'gnus-prev-winconf)
- (setq gnus-prev-winconf winconf))
- (gnus-message
- 4 (substitute-command-keys
+ (if (not gnus-current-score-file)
+ (error "No current score file")
+ (let ((winconf (current-window-configuration)))
+ (when (buffer-name gnus-summary-buffer)
+ (gnus-score-save))
+ (gnus-make-directory (file-name-directory file))
+ (setq gnus-score-edit-buffer (find-file-noselect file))
+ (gnus-configure-windows 'edit-score)
+ (gnus-score-mode)
+ (setq gnus-score-edit-exit-function 'gnus-score-edit-done)
+ (make-local-variable 'gnus-prev-winconf)
+ (setq gnus-prev-winconf winconf))
+ (gnus-message
+ 4 "%s" (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
+ (interactive
(list (read-file-name "Edit score file: " gnus-kill-files-directory)))
(gnus-make-directory (file-name-directory file))
(when (buffer-name gnus-summary-buffer)
(setq gnus-score-edit-exit-function 'gnus-score-edit-done)
(make-local-variable 'gnus-prev-winconf)
(setq gnus-prev-winconf winconf))
- (gnus-message
- 4 (substitute-command-keys
- "\\<gnus-score-mode-map>\\[gnus-score-edit-exit] to save edits")))
-
+ (gnus-message
+ 4 "%s" (substitute-command-keys
+ "\\<gnus-score-mode-map>\\[gnus-score-edit-exit] to save edits")))
+
+(defun gnus-score-edit-file-at-point (&optional format)
+ "Edit score file at point in Score Trace buffers.
+If FORMAT, also format the current score file."
+ (let* ((rule (save-excursion
+ (beginning-of-line)
+ (read (current-buffer))))
+ (sep "[ \n\r\t]*")
+ ;; Must be synced with `gnus-score-find-trace':
+ (reg " -> +")
+ (file (save-excursion
+ (end-of-line)
+ (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)
+ ;; (see `gnus-score-find-trace' and `gnus-score-advanced')
+ (string= "" file))
+ (gnus-error 3 "Can't find a score file in current line.")
+ (gnus-score-edit-file file)
+ (when format
+ (gnus-score-pretty-print))
+ (when (consp rule) ;; the rule exists
+ (setq rule (mapconcat #'(lambda (obj)
+ (regexp-quote (format "%S" obj)))
+ rule
+ sep))
+ (goto-char (point-min))
+ (re-search-forward rule nil t)
+ ;; make it easy to use `kill-sexp':
+ (goto-char (1- (match-beginning 0)))))))
+
(defun gnus-score-load-file (file)
;; Load score file FILE. Returns a list a retrieved score-alists.
- (let* ((file (expand-file-name
+ (let* ((file (expand-file-name
(or (and (string-match
- (concat "^" (expand-file-name
- gnus-kill-files-directory))
+ (concat "^" (regexp-quote
+ (expand-file-name
+ gnus-kill-files-directory)))
(expand-file-name file))
file)
- (concat (file-name-as-directory gnus-kill-files-directory)
- file))))
+ (expand-file-name file gnus-kill-files-directory))))
(cached (assoc file gnus-score-cache))
(global (member file gnus-internal-global-score-files))
lists alist)
(setq gnus-score-alist nil)
(setq alist (gnus-score-load-score-alist file))
;; We add '(touched) to the alist to signify that it hasn't been
- ;; touched (yet).
+ ;; touched (yet).
(unless (assq 'touched alist)
(push (list 'touched nil) alist))
;; If it is a global score file, we make it read-only.
found)
(while a
;; Downcase all header names.
- (when (stringp (caar a))
+ (cond
+ ((stringp (caar a))
(setcar (car a) (downcase (caar a)))
(setq found t))
+ ;; Advanced scoring.
+ ((consp (caar a))
+ (setq found t)))
(pop a))
;; If there are actual scores in the alist, we add it to the
;; return value of this function.
(mark-and-expunge (car (gnus-score-get 'mark-and-expunge alist)))
(files (gnus-score-get 'files alist))
(exclude-files (gnus-score-get 'exclude-files alist))
- (orphan (car (gnus-score-get 'orphan alist)))
+ (orphan (car (gnus-score-get 'orphan alist)))
(adapt (gnus-score-get 'adapt alist))
(thread-mark-and-expunge
(car (gnus-score-get 'thread-mark-and-expunge alist)))
(decay (car (gnus-score-get 'decay alist)))
(eval (car (gnus-score-get 'eval alist))))
;; Perform possible decays.
- (when (and gnus-decay-scores
- (gnus-decay-scores
- alist (or decay (gnus-time-to-day (current-time)))))
+ (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)))
(gnus-score-set 'touched '(t) alist)
- (gnus-score-set 'decay (list (gnus-time-to-day (current-time)))))
+ (gnus-score-set 'decay (list (time-to-days (current-time))) alist))
;; We do not respect eval and files atoms from global score
- ;; files.
- (and files (not global)
- (setq lists (apply 'append lists
- (mapcar (lambda (file)
- (gnus-score-load-file file))
- (if adapt-file (cons adapt-file files)
- files)))))
- (and eval (not global) (eval eval))
+ ;; files.
+ (when (and files (not global))
+ (setq lists (apply 'append lists
+ (mapcar 'gnus-score-load-file
+ (if adapt-file (cons adapt-file files)
+ files)))))
+ (when (and eval (not global))
+ (eval eval))
;; We then expand any exclude-file directives.
- (setq gnus-scores-exclude-files
- (nconc
- (mapcar
- (lambda (sfile)
- (expand-file-name sfile (file-name-directory file)))
- exclude-files)
+ (setq gnus-scores-exclude-files
+ (nconc
+ (apply
+ 'nconc
+ (mapcar
+ (lambda (sfile)
+ (list
+ (expand-file-name sfile (file-name-directory file))
+ (expand-file-name sfile gnus-kill-files-directory)))
+ exclude-files))
gnus-scores-exclude-files))
- (if (not local)
- ()
- (save-excursion
- (set-buffer gnus-summary-buffer)
+ (when local
+ (with-current-buffer gnus-summary-buffer
(while local
(and (consp (car local))
(symbolp (caar local))
(setq gnus-newsgroup-adaptive t)
adapt)
(t
- ;;(setq gnus-newsgroup-adaptive gnus-use-adaptive-scoring)
gnus-default-adaptive-score-alist)))
- (setq gnus-thread-expunge-below
+ (setq gnus-thread-expunge-below
(or thread-mark-and-expunge gnus-thread-expunge-below))
- (setq gnus-summary-mark-below
+ (setq gnus-summary-mark-below
(or mark mark-and-expunge gnus-summary-mark-below))
- (setq gnus-summary-expunge-below
+ (setq gnus-summary-expunge-below
(or expunge mark-and-expunge gnus-summary-expunge-below))
- (setq gnus-newsgroup-adaptive-score-file
+ (setq gnus-newsgroup-adaptive-score-file
(or adapt-file gnus-newsgroup-adaptive-score-file)))
(setq gnus-current-score-file file)
(setq gnus-score-alist alist)
(push (cons file gnus-score-alist) gnus-score-cache))))
(defun gnus-score-remove-from-cache (file)
- (setq gnus-score-cache
+ (setq gnus-score-cache
(delq (assoc file gnus-score-cache) gnus-score-cache)))
(defun gnus-score-load-score-alist (file)
;; Couldn't read file.
(setq gnus-score-alist nil)
;; Read file.
- (save-excursion
- (gnus-set-work-buffer)
- (insert-file-contents file)
+ (with-temp-buffer
+ (let ((coding-system-for-read score-mode-coding-system))
+ (insert-file-contents file))
(goto-char (point-min))
;; Only do the loading if the score file isn't empty.
(when (save-excursion (re-search-forward "[()0-9a-zA-Z]" nil t))
(setq alist
(condition-case ()
(read (current-buffer))
- (error
+ (error
(gnus-error 3.2 "Problem with score file %s" file))))))
- (if (eq (car alist) 'setq)
- ;; This is an old-style score file.
- (setq gnus-score-alist (gnus-score-transform-old-to-new alist))
- (setq gnus-score-alist alist))
+ (cond
+ ((and alist
+ (atom alist))
+ ;; Bogus score file.
+ (error "Invalid syntax with score file %s" file))
+ ((eq (car alist) 'setq)
+ ;; This is an old-style score file.
+ (setq gnus-score-alist (gnus-score-transform-old-to-new alist)))
+ (t
+ (setq gnus-score-alist alist)))
;; Check the syntax of the score file.
(setq gnus-score-alist
(gnus-score-check-syntax gnus-score-alist file)))))
(defun gnus-score-check-syntax (alist file)
"Check the syntax of the score ALIST."
- (cond
+ (cond
((null alist)
nil)
((not (consp alist))
err
(cond
((not (listp (car a)))
- (format "Illegal score element %s in %s" (car a) file))
+ (format "Invalid score element %s in %s" (car a) file))
((stringp (caar a))
- (cond
+ (cond
((not (listp (setq sr (cdar a))))
- (format "Illegal header match %s in %s" (nth 1 (car a)) file))
+ (format "Invalid header match %s in %s" (nth 1 (car a)) file))
(t
(setq type (caar a))
(while (and sr (not err))
(setq s (pop sr))
- (setq
+ (setq
err
(cond
((if (member (downcase type) '("lines" "chars"))
(not (numberp (car s)))
(not (stringp (car s))))
- (format "Illegal match %s in %s" (car s) file))
+ (format "Invalid match %s in %s" (car s) file))
((and (cadr s) (not (integerp (cadr s))))
(format "Non-integer score %s in %s" (cadr s) file))
((and (caddr s) (not (integerp (caddr s))))
(if err
(progn
(ding)
- (gnus-message 3 err)
+ (gnus-message 3 "%s" err)
(sit-for 2)
nil)
alist)))))
(setcar scor
(list (caar scor) (nth 2 (car scor))
(and (nth 3 (car scor))
- (gnus-day-number (nth 3 (car scor))))
+ (date-to-day (nth 3 (car scor))))
(if (nth 1 (car scor)) 'r 's)))
(setq scor (cdr scor))))
(push (if (not (listp (cdr entry)))
out))
(setq alist (cdr alist)))
(cons (list 'touched t) (nreverse out))))
-
+
(defun gnus-score-save ()
;; Save all score information.
(let ((cache gnus-score-cache)
(while cache
(current-buffer)
(setq entry (pop cache)
- file (car entry)
+ file (nnheader-translate-file-chars (car entry) t)
score (cdr entry))
(if (or (not (equal (gnus-score-get 'touched score) '(t)))
(gnus-score-get 'read-only score)
(and (file-exists-p file)
(not (file-writable-p file))))
()
- (setq score (setcdr entry (delq (assq 'touched score) score)))
+ (setq score (setcdr entry (gnus-delete-alist 'touched score)))
(erase-buffer)
(let (emacs-lisp-mode-hook)
- (if (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.
+ (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' 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.
- (pp score (current-buffer))))
+ ;; prettily.
+ (let ((lisp-mode-syntax-table score-mode-syntax-table))
+ (gnus-pp score))))
(gnus-make-directory (file-name-directory file))
;; If the score file is empty, we delete it.
(if (zerop (buffer-size))
(delete-file file)
- ;; There are scores, so we write the file.
+ ;; There are scores, so we write the file.
(when (file-writable-p file)
- (gnus-write-buffer file)
+ (let ((coding-system-for-write score-mode-coding-system))
+ (gnus-write-buffer file))
(when gnus-score-after-write-file-function
(funcall gnus-score-after-write-file-function file)))))
(and gnus-score-uncacheable-files
(when (and gnus-summary-default-score
scores)
(let* ((entries gnus-header-index)
- (now (gnus-day-number (current-time-string)))
+ (now (date-to-day (current-time-string)))
(expire (and gnus-score-expiry-days
(- now gnus-score-expiry-days)))
(headers gnus-newsgroup-headers)
(current-score-file gnus-current-score-file)
entry header new)
- (gnus-message 5 "Scoring...")
+ (gnus-message 7 "Scoring...")
;; Create articles, an alist of the form `(HEADER . SCORE)'.
(while (setq header (pop headers))
;; WARNING: The assq makes the function O(N*S) while it could
(cons (cons header (or gnus-summary-default-score 0))
gnus-scores-articles))))
- (save-excursion
- (set-buffer (get-buffer-create "*Headers*"))
- (buffer-disable-undo (current-buffer))
+ (with-current-buffer (gnus-get-buffer-create "*Headers*")
+ (buffer-disable-undo)
+ (when (gnus-buffer-live-p gnus-summary-buffer)
+ (message-clone-locals gnus-summary-buffer))
;; Set the global variant of this variable.
(setq gnus-current-score-file current-score-file)
;; score orphans
- (when gnus-orphan-score
- (setq gnus-score-index
+ (when gnus-orphan-score
+ (setq gnus-score-index
(nth 1 (assoc "references" gnus-header-index)))
(gnus-score-orphans gnus-orphan-score))
;; Run each header through the score process.
(lambda (score)
(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
+ (or (eq gnus-inhibit-slow-scoring t)
+ (and (stringp gnus-inhibit-slow-scoring)
+ ;; Always true here?
+ ;; (stringp gnus-newsgroup-name)
+ (string-match
+ gnus-inhibit-slow-scoring
+ gnus-newsgroup-name)))
+ (> 0 (nth 1 (assoc header gnus-header-index))))
+ (progn
+ (gnus-message
+ 7 "Scoring on headers or body skipped.")
+ nil)
+ ;; Call the scoring function for this type of "header".
+ (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))
+ (with-current-buffer gnus-summary-buffer
+ (setq gnus-newsgroup-scored scored))))
;; Remove the buffer.
- (kill-buffer (current-buffer)))
+ (gnus-kill-buffer (current-buffer)))
;; Add articles to `gnus-newsgroup-scored'.
(while gnus-scores-articles
(let (score)
(while
projects / gnus / blobdiff