;;; Code:
(require 'gnus)
-(eval-when-compile (require 'cl))
+(require 'gnus-sum)
+(require 'gnus-range)
-(defvar gnus-global-score-files nil
- "*List of global score files and directories.
+(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
for each score file or each score file directory. Gnus will decide
by itself what score files are applicable to which group.
(setq gnus-global-score-files
'(\"/ftp.ifi.uio.no:/pub/larsi/ding/score/soc.motss.SCORE\"
- \"/ftp.some-where:/pub/score\"))")
+ \"/ftp.some-where:/pub/score\"))"
+ :group 'gnus-score
+ :type '(repeat file))
-(defvar gnus-score-file-single-match-alist nil
- "*Alist mapping regexps to lists of score files.
+(defcustom gnus-score-file-single-match-alist nil
+ "Alist mapping regexps to lists of score files.
Each element of this alist should be of the form
(\"REGEXP\" [ \"SCORE-FILE-1\" ] [ \"SCORE-FILE-2\" ] ... )
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 (which see)."
+ :group 'gnus-score
+ :type '(repeat (cons regexp (repeat file))))
-(defvar gnus-score-file-multiple-match-alist nil
- "*Alist mapping regexps to lists of score files.
+(defcustom gnus-score-file-multiple-match-alist nil
+ "Alist mapping regexps to lists of score files.
Each element of this alist should be of the form
(\"REGEXP\" [ \"SCORE-FILE-1\" ] [ \"SCORE-FILE-2\" ] ... )
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).")
-
-(defvar gnus-score-file-suffix "SCORE"
- "*Suffix of the score files.")
-
-(defvar gnus-adaptive-file-suffix "ADAPT"
- "*Suffix of the adaptive score files.")
-
-(defvar gnus-score-find-score-files-function 'gnus-score-find-bnews
- "*Function used to find score files.
+gnus-score-find-score-files-function (which see)."
+ :group 'gnus-score
+ :type '(repeat (cons regexp (repeat file))))
+
+(defcustom gnus-score-file-suffix "SCORE"
+ "Suffix of the score files."
+ :group 'gnus-score
+ :type 'string)
+
+(defcustom gnus-adaptive-file-suffix "ADAPT"
+ "Suffix of the adaptive score files."
+ :group 'gnus-score
+ :type 'string)
+
+(defcustom gnus-score-find-score-files-function 'gnus-score-find-bnews
+ "Function used to find score files.
The function will be called with the group name as the argument, and
should return a list of score files to apply to that group. The score
files do not actually have to exist.
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.")
-
-(defvar gnus-score-interactive-default-score 1000
- "*Scoring commands will raise/lower the score with this number as the default.")
-
-(defvar gnus-score-expiry-days 7
+score alists."
+ :group 'gnus-score
+ :type '(radio (function-item gnus-score-find-single)
+ (function-item gnus-score-find-hierarchical)
+ (function-item gnus-score-find-bnews)
+ (function :tag "Other")))
+
+(defcustom gnus-score-interactive-default-score 1000
+ "*Scoring commands will raise/lower the score with this number as the default."
+ :group 'gnus-score
+ :type 'integer)
+
+(defcustom gnus-score-expiry-days 7
"*Number of days before unused score file entries are expired.
-If this variable is nil, no score file entries will be expired.")
+If this variable is nil, no score file entries will be expired."
+ :group 'gnus-score
+ :type '(choice (const :tag "never" nil)
+ number))
-(defvar gnus-update-score-entry-dates t
+(defcustom gnus-update-score-entry-dates t
"*In 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.")
-
-(defvar gnus-orphan-score nil
- "*All orphans get this score added. Set in the score file.")
-
-(defvar gnus-default-adaptive-score-alist
+will be expired along with non-matching score entries."
+ :group 'gnus-score
+ :type 'boolean)
+
+(defcustom gnus-orphan-score nil
+ "*All orphans get this score added. Set in the score file."
+ :group 'gnus-score
+ :type 'integer)
+
+(defcustom gnus-decay-scores nil
+ "*If non-nil, decay non-permanent scores."
+ :group 'gnus-score
+ :type 'boolean)
+
+(defcustom gnus-decay-score-function 'gnus-decay-score
+ "*Function called to decay a score.
+It is called with one parameter -- the score to be decayed."
+ :group 'gnus-score
+ :type '(radio (function-item gnus-decay-score)
+ (function :tag "Other")))
+
+(defcustom gnus-score-decay-constant 3
+ "*Decay all \"small\" scores with this amount."
+ :group 'gnus-score
+ :type 'integer)
+
+(defcustom gnus-score-decay-scale .05
+ "*Decay all \"big\" scores with this factor."
+ :group 'gnus-score
+ :type 'number)
+
+(defcustom gnus-home-score-file nil
+ "Variable to control where interactive score entries are to go.
+It can be:
+
+ * A string
+ This file 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 function will be passed the name of the group as its
+ parameter.
+
+ * A list
+ The elements in this list can be:
+
+ * `(regexp file-name ...)'
+ If the `regexp' matches the group name, the first `file-name' will
+ 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
+ name of the group as its parameter.
+
+ * A string. Use the string as the home score file.
+
+ The list will be traversed from the beginning towards the end looking
+ for matches."
+ :group 'gnus-score
+ :type '(choice string
+ (repeat (choice string
+ (cons regexp (repeat file))
+ function))
+ function))
+
+(defcustom gnus-home-adapt-file nil
+ "Variable to control where new adaptive score entries are to go.
+This variable allows the same syntax as `gnus-home-score-file'."
+ :group 'gnus-score
+ :type '(choice string
+ (repeat (choice string
+ (cons regexp (repeat file))
+ function))
+ function))
+
+(defcustom gnus-default-adaptive-score-alist
'((gnus-kill-file-mark)
(gnus-unread-mark)
- (gnus-read-mark (from 3) (subject 30))
+ (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.")
-
-(defvar gnus-score-mimic-keymap nil
- "*Have the score entry functions pretend that they are a keymap.")
-
-(defvar gnus-score-exact-adapt-limit 10
+"Alist of marks and scores."
+:group 'gnus-score
+:type '(repeat (cons (symbol :tag "Mark")
+ (repeat (list (choice :tag "Header"
+ (const from)
+ (const subject)
+ (symbol :tag "other"))
+ (integer :tag "Score"))))))
+
+(defcustom gnus-ignored-adaptive-words nil
+ "List of words to be ignored when doing adaptive word scoring."
+ :group 'gnus-score
+ :type '(repeat string))
+
+(defcustom gnus-default-ignored-adaptive-words
+ '("a" "i" "the" "to" "of" "and" "in" "is" "it" "for" "that" "if" "you"
+ "this" "be" "on" "with" "not" "have" "are" "or" "as" "from" "can"
+ "but" "by" "at" "an" "will" "no" "all" "was" "do" "there" "my" "one"
+ "so" "we" "they" "what" "would" "any" "which" "about" "get" "your"
+ "use" "some" "me" "then" "name" "like" "out" "when" "up" "time"
+ "other" "more" "only" "just" "end" "also" "know" "how" "new" "should"
+ "been" "than" "them" "he" "who" "make" "may" "people" "these" "now"
+ "their" "here" "into" "first" "could" "way" "had" "see" "work" "well"
+ "were" "two" "very" "where" "while" "us" "because" "good" "same"
+ "even" "much" "most" "many" "such" "long" "his" "over" "last" "since"
+ "right" "before" "our" "without" "too" "those" "why" "must" "part"
+ "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."
+ :group 'gnus-score
+ :type '(repeat string))
+
+(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
+:type '(repeat (cons (character :tag "Mark")
+ (integer :tag "Score"))))
+
+(defcustom gnus-score-mimic-keymap nil
+ "*Have the score entry functions pretend that they are a keymap."
+ :group 'gnus-score
+ :type 'boolean)
+
+(defcustom gnus-score-exact-adapt-limit 10
"*Number that says how long a match has to be before using substring matching.
When doing adaptive scoring, one normally uses fuzzy or substring
matching. However, if the header one matches is short, the possibility
for false positives is great, so if the length of the match is less
than this variable, exact matching will be used.
-If this variable is nil, exact matching will always be used.")
+If this variable is nil, exact matching will always be used."
+ :group 'gnus-score
+ :type '(choice (const nil) integer))
-(defvar gnus-score-uncacheable-files "ADAPT$"
- "*All score files that match this regexp will not be cached.")
+(defcustom gnus-score-uncacheable-files "ADAPT$"
+ "All score files that match this regexp will not be cached."
+ :group 'gnus-score
+ :type 'regexp)
-(defvar gnus-score-default-header nil
+(defcustom gnus-score-default-header nil
"Default header when entering new scores.
Should be one of the following symbols.
d: date
f: followup
-If nil, the user will be asked for a header.")
-
-(defvar gnus-score-default-type nil
+If nil, the user will be asked for a header."
+ :group 'gnus-score
+ :type '(choice (const :tag "from" a)
+ (const :tag "subject" s)
+ (const :tag "body" b)
+ (const :tag "head" h)
+ (const :tag "message-id" i)
+ (const :tag "references" t)
+ (const :tag "xref" x)
+ (const :tag "lines" l)
+ (const :tag "date" d)
+ (const :tag "followup" f)))
+
+(defcustom gnus-score-default-type nil
"Default match type when entering new scores.
Should be one of the following symbols.
>: greater than number
=: equal to number
-If nil, the user will be asked for a match type.")
-
-(defvar gnus-score-default-fold nil
- "Use case folding for new score file entries iff not nil.")
-
-(defvar gnus-score-default-duration nil
+If nil, the user will be asked for a match type."
+ :group 'gnus-score
+ :type '(choice (const :tag "substring" s)
+ (const :tag "exact string" e)
+ (const :tag "fuzzy string" f)
+ (const :tag "regexp string" r)
+ (const :tag "before date" b)
+ (const :tag "at date" a)
+ (const :tag "this date" n)
+ (const :tag "less than number" <)
+ (const :tag "greater than number" >)
+ (const :tag "equal than number" =)))
+
+(defcustom gnus-score-default-fold nil
+ "Use case folding for new score file entries iff not nil."
+ :group 'gnus-score
+ :type 'boolean)
+
+(defcustom gnus-score-default-duration nil
"Default duration of effect when entering new scores.
Should be one of the following symbols.
p: permanent
i: immediate
-If nil, the user will be asked for a duration.")
+If nil, the user will be asked for a duration."
+ :group 'gnus-score
+ :type '(choice (const :tag "temporary" t)
+ (const :tag "permanent" p)
+ (const :tag "immediate" i)))
-(defvar gnus-score-after-write-file-function nil
- "*Function called with the name of the score file just written to disk.")
+(defcustom gnus-score-after-write-file-function nil
+ "Function called with the name of the score file just written to disk."
+ :group 'gnus-score
+ :type 'function)
\f
;; Internal variables.
+(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)))
+ (while numbers
+ (modify-syntax-entry (pop numbers) " " table))
+ (modify-syntax-entry ?' "w" table)
+ table)
+ "Syntax table used when doing adaptive word scoring.")
+
+(defvar gnus-scores-exclude-files nil)
(defvar gnus-internal-global-score-files nil)
(defvar gnus-score-file-list nil)
(defvar gnus-score-help-winconf nil)
(defvar gnus-adaptive-score-alist gnus-default-adaptive-score-alist)
+(defvar gnus-adaptive-word-score-alist gnus-default-adaptive-word-score-alist)
(defvar gnus-score-trace nil)
(defvar gnus-score-edit-buffer nil)
files: List of other score files to load when loading this one.
eval: Sexp to be evaluated when the score file is loaded.
-String entries have the form (HEADER (MATCH TYPE SCORE DATE) ...)
+String entries have the form (HEADER (MATCH TYPE SCORE DATE) ...)
where HEADER is the header being scored, MATCH is the string we are
looking for, TYPE is a flag indicating whether it should use regexp or
substring matching, SCORE is the score to add and DATE is the date
("subject" 1 gnus-score-string)
("from" 2 gnus-score-string)
("date" 3 gnus-score-date)
- ("message-id" 4 gnus-score-string)
- ("references" 5 gnus-score-string)
- ("chars" 6 gnus-score-integer)
- ("lines" 7 gnus-score-integer)
+ ("message-id" 4 gnus-score-string)
+ ("references" 5 gnus-score-string)
+ ("chars" 6 gnus-score-integer)
+ ("lines" 7 gnus-score-integer)
("xref" 8 gnus-score-string)
("head" -1 gnus-score-body)
("body" -1 gnus-score-body)
("followup" 2 gnus-score-followup)
("thread" 5 gnus-score-thread)))
-(eval-and-compile
- (autoload 'gnus-uu-ctl-map "gnus-uu" nil nil 'keymap))
-
;;; Summary mode score maps.
-(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
- "m" gnus-score-set-mark-below
- "x" gnus-score-set-expunge-below
- "R" gnus-summary-rescore
- "e" gnus-score-edit-current-scores
- "f" gnus-score-edit-file
- "F" gnus-score-flush-cache
- "t" gnus-score-find-trace
- "C" gnus-score-customize)
+(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
+ "m" gnus-score-set-mark-below
+ "x" gnus-score-set-expunge-below
+ "R" gnus-summary-rescore
+ "e" gnus-score-edit-current-scores
+ "f" gnus-score-edit-file
+ "F" gnus-score-flush-cache
+ "t" gnus-score-find-trace
+ "w" gnus-score-find-favourite-words)
;; Summary score file commands
(interactive "P")
(gnus-summary-increase-score (- (gnus-score-default score))))
-(defvar gnus-score-default-header nil
- "*The default header to score on when entering a score rule interactively.")
-
-(defvar gnus-score-default-type nil
- "*The default score type to use when entering a score rule interactively.")
-
-(defvar gnus-score-default-duration nil
- "*The default score duration to use on when entering a score rule interactively.")
-
(defun gnus-score-kill-help-buffer ()
(when (get-buffer "*Score Help*")
(kill-buffer "*Score Help*")
- (and gnus-score-help-winconf
- (set-window-configuration gnus-score-help-winconf))))
+ (when gnus-score-help-winconf
+ (set-window-configuration gnus-score-help-winconf))))
(defun gnus-summary-increase-score (&optional score)
"Make a score entry based on the current article.
(?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)
+ (?a at "at date" date)
(?n now "this date" date)
(?< < "less than number" number)
- (?> > "greater than number" number)
+ (?> > "greater than number" number)
(?= = "equal to number" number)))
(char-to-perm
- (list (list ?t (current-time-string) "temporary")
+ (list (list ?t (current-time-string) "temporary")
'(?p perm "permanent") '(?i now "immediate")))
(mimic gnus-score-mimic-keymap)
(hchar (and gnus-score-default-header
(if mimic (error "%c %c" prefix hchar) (error "")))
(when (/= (downcase hchar) hchar)
- ;; This was a majuscle, so we end reading and set the defaults.
+ ;; 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)))
(message "%s header '%s' with match type (%s?): "
(if increase "Increase" "Lower")
(nth 1 entry)
- (mapconcat (lambda (s)
- (if (eq (nth 4 entry)
+ (mapconcat (lambda (s)
+ (if (eq (nth 4 entry)
(nth 3 s))
(char-to-string (car s))
""))
(gnus-score-insert-help
"Match type"
(delq nil
- (mapcar (lambda (s)
- (if (eq (nth 4 entry)
+ (mapcar (lambda (s)
+ (if (eq (nth 4 entry)
(nth 3 s))
s nil))
- char-to-type ))
+ char-to-type))
2)))
(gnus-score-kill-help-buffer)
(if mimic (error "%c %c" prefix hchar) (error "")))
(when (/= (downcase tchar) tchar)
- ;; It was a majuscle, so we end reading and use the default.
+ ;; 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)))
(if mimic (message "%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 (- pchar 4) 111))
+ (error "You rang?"))
(if mimic
(error "%c %c %c %c" prefix hchar tchar pchar)
(error ""))))
(nth 1 entry) ; Header
match ; Match
type ; Type
- (if (eq 's score) nil score) ; Score
- (if (eq 'perm temporary) ; Temp
+ (if (eq score 's) nil score) ; Score
+ (if (eq temporary 'perm) ; Temp
nil
- temporary)
+ temporary)
(not (nth 3 entry))) ; Prompt
))
;; find the longest string to display
(while list
(setq n (length (nth idx (car list))))
- (or (> max n)
- (setq max n))
+ (unless (> max n)
+ (setq max n))
(setq list (cdr list)))
(setq max (+ max 4)) ; %c, `:', SPACE, a SPACE at end
- (setq n (/ (1- (window-width)) max)) ; items per line
+ (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'
(while alist
(defun gnus-newsgroup-score-alist ()
(or
- (let ((param-file (gnus-group-get-parameter
+ (let ((param-file (gnus-group-find-parameter
gnus-newsgroup-name 'score-file)))
(when param-file
(gnus-score-load param-file)))
gnus-score-alist
(gnus-newsgroup-score-alist)))))
-(defun gnus-summary-score-entry
- (header match type score date &optional prompt silent)
+(defun gnus-summary-score-entry (header match type score date
+ &optional prompt silent)
"Enter score file entry.
HEADER is the header being scored.
MATCH is the string we are looking for.
(current-time-string))
(t nil))))
;; Regexp is the default type.
- (if (eq type t) (setq type 'r))
+ (when (eq type t)
+ (setq type 'r))
;; Simplify matches...
(cond ((or (eq type 'r) (eq type 's) (eq type nil))
(setq match (if match (gnus-simplify-subject-re match) "")))
(let ((score (gnus-score-default score))
(header (format "%s" (downcase header)))
new)
- (and prompt (setq match (read-string
- (format "Match %s on %s, %s: "
- (cond ((eq date 'now)
- "now")
- ((stringp date)
- "temp")
- (t "permanent"))
- header
- (if (< score 0) "lower" "raise"))
- (if (numberp match)
- (int-to-string match)
- match))))
+ (when prompt
+ (setq match (read-string
+ (format "Match %s on %s, %s: "
+ (cond ((eq date 'now)
+ "now")
+ ((stringp date)
+ "temp")
+ (t "permanent"))
+ header
+ (if (< score 0) "lower" "raise"))
+ (if (numberp match)
+ (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.
- (and (eq (nth 2 (assoc header gnus-header-index)) 'gnus-score-integer)
- (setq match (string-to-int match)))
+ (when (eq (nth 2 (assoc header gnus-header-index)) 'gnus-score-integer)
+ (setq match (string-to-int match)))
(unless (eq date 'now)
;; Add the score entry to the score file.
(when (= score gnus-score-interactive-default-score)
- (setq score nil))
+ (setq score nil))
(let ((old (gnus-score-get header))
elem)
(setq new
(cond
- (type (list match score (and date (gnus-day-number date)) type))
+ (type
+ (list match score
+ (and date (if (numberp date) date
+ (gnus-day-number date)))
+ type))
(date (list match score (gnus-day-number date)))
(score (list match score))
(t (list match))))
;; We see whether we can collapse some score entries.
;; This isn't quite correct, because there may be more elements
- ;; later on with the same key that have matching elems... Hm.
+ ;; later on with the same key that have matching elems... Hm.
(if (and old
(setq elem (assoc match old))
(eq (nth 3 elem) (nth 3 new))
(or (and (numberp (nth 2 elem)) (numberp (nth 2 new)))
(and (not (nth 2 elem)) (not (nth 2 new)))))
;; Yup, we just add this new score to the old elem.
- (setcar (cdr elem) (+ (or (nth 1 elem)
+ (setcar (cdr elem) (+ (or (nth 1 elem)
gnus-score-interactive-default-score)
(or (nth 1 new)
gnus-score-interactive-default-score)))
(y-or-n-p "Use regexp match? ")
(prefix-numeric-value current-prefix-arg)))
(save-excursion
- (or (and (stringp match) (> (length match) 0))
- (error "No match"))
+ (unless (and (stringp match) (> (length match) 0))
+ (error "No match"))
(goto-char (point-min))
(let ((regexp (cond ((eq type 'f)
(gnus-simplify-subject-fuzzy match))
- ((eq type 'r)
+ ((eq type 'r)
match)
((eq type 'e)
(concat "\\`" (regexp-quote match) "\\'"))
(let ((content (gnus-summary-header header 'noerr))
(case-fold-search t))
(and content
- (if (if (eq type 'f)
- (string-equal (gnus-simplify-subject-fuzzy content)
- regexp)
- (string-match regexp content))
- (gnus-summary-raise-score score))))
+ (when (if (eq type 'f)
+ (string-equal (gnus-simplify-subject-fuzzy content)
+ regexp)
+ (string-match regexp content))
+ (gnus-summary-raise-score score))))
(beginning-of-line 2)))))
(defun gnus-summary-score-crossposting (score date)
(let ((xref (gnus-summary-header "xref"))
(start 0)
group)
- (or xref (error "This article is not crossposted"))
+ (unless xref
+ (error "This article is not crossposted"))
(while (string-match " \\([^ \t]+\\):" xref start)
(setq start (match-end 0))
- (if (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)))))
+ (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
;;;
(when (gnus-buffer-live-p gnus-summary-buffer)
(save-excursion
(save-restriction
- (goto-char (point-min))
+ (message-narrow-to-headers)
(let ((id (mail-fetch-field "message-id")))
(when id
(set-buffer gnus-summary-buffer)
"Raise the score of the current article by N."
(interactive "p")
(gnus-set-global-variables)
- (gnus-summary-set-score (+ (gnus-summary-article-score)
+ (gnus-summary-set-score (+ (gnus-summary-article-score)
(or n gnus-score-interactive-default-score ))))
(defun gnus-summary-set-score (n)
(gnus-summary-update-mark
(if (= n (or gnus-summary-default-score 0)) ?
(if (< n (or gnus-summary-default-score 0))
- gnus-score-below-mark gnus-score-over-mark)) 'score))
+ gnus-score-below-mark gnus-score-over-mark))
+ 'score))
(let* ((article (gnus-summary-article-number))
(score (assq article gnus-newsgroup-scored)))
(if score (setcdr score n)
- (setq gnus-newsgroup-scored
- (cons (cons article n) gnus-newsgroup-scored))))
+ (push (cons article n) gnus-newsgroup-scored)))
(gnus-summary-update-line)))
(defun gnus-summary-current-score ()
"Edit the current score alist."
(interactive (list gnus-current-score-file))
(let ((winconf (current-window-configuration)))
- (and (buffer-name gnus-summary-buffer) (gnus-score-save))
+ (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)
(interactive
(list (read-file-name "Edit score file: " gnus-kill-files-directory)))
(gnus-make-directory (file-name-directory file))
- (and (buffer-name gnus-summary-buffer) (gnus-score-save))
+ (when (buffer-name gnus-summary-buffer)
+ (gnus-score-save))
(let ((winconf (current-window-configuration)))
(setq gnus-score-edit-buffer (find-file-noselect file))
(gnus-configure-windows 'edit-score)
(let* ((file (expand-file-name
(or (and (string-match
(concat "^" (expand-file-name
- gnus-kill-files-directory))
+ gnus-kill-files-directory))
(expand-file-name file))
file)
(concat (file-name-as-directory gnus-kill-files-directory)
(setq alist (gnus-score-load-score-alist file))
;; We add '(touched) to the alist to signify that it hasn't been
;; touched (yet).
- (or (assq 'touched alist) (setq alist (cons (list 'touched nil) alist)))
+ (unless (assq 'touched alist)
+ (push (list 'touched nil) alist))
;; If it is a global score file, we make it read-only.
(and global
(not (assq 'read-only alist))
- (setq alist (cons (list 'read-only t) alist)))
- (setq gnus-score-cache
- (cons (cons file alist) gnus-score-cache)))
+ (push (list 'read-only t) alist))
+ (push (cons file alist) gnus-score-cache))
(let ((a alist)
found)
(while a
(car (gnus-score-get 'thread-mark-and-expunge alist)))
(adapt-file (car (gnus-score-get 'adapt-file alist)))
(local (gnus-score-get 'local 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)))))
+ (gnus-score-set 'touched '(t) alist)
+ (gnus-score-set 'decay (list (gnus-time-to-day (current-time)))))
;; We do not respect eval and files atoms from global score
projects / gnus / blobdiff