;;; gnus-score.el --- scoring code for Gnus
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001
-;; Free Software Foundation, Inc.
+
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
+;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Per Abrahamsen <amanda@iesd.auc.dk>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
;; 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:
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-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.)
:type '(choice string
(repeat (choice string
(cons regexp (repeat file))
- (function :value fun)))
+ function))
(function-item gnus-hierarchial-home-score-file)
(function-item gnus-current-home-score-file)
- (function :value fun)))
+ function))
(defcustom gnus-home-adapt-file nil
"Variable to control where new adaptive score entries are to go.
:type '(choice string
(repeat (choice string
(cons regexp (repeat file))
- (function :value fun)))
- (function :value fun)))
+ function))
+ function))
(defcustom gnus-default-adaptive-score-alist
- '((gnus-kill-file-mark)
+ `((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."
+ (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"
(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 'integer)
+ :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."
: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.
(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-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.
"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."
+used as score. A symbolic prefix of `a' 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))
"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."
+used as score. A symbolic prefix of `a' 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))
(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.
(and gnus-extra-headers
(equal (nth 1 entry) "extra")
(intern ; need symbol
- (gnus-completing-read
+ (gnus-completing-read-with-default
(symbol-name (car gnus-extra-headers)) ; default response
- "Score extra header:" ; prompt
+ "Score extra header" ; prompt
(mapcar (lambda (x) ; completion list
(cons (symbol-name x) x))
gnus-extra-headers)
(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 (gnus-get-buffer-window gnus-summary-buffer t))))
;; 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-int match)))
+ (setq match (string-to-number match)))
(set-text-properties 0 (length match) nil match))
(unless (eq date 'now)
;; Return the new scoring rule.
new))
-(defun gnus-summary-score-effect (header match type score extra)
+(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.
(lambda (x) (fboundp (nth 2 x)))
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"))
;; 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
(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))
"Automatically expunge articles with score below SCORE."
(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)))
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
4 (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
(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)))
;; 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))
(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
(or thread-mark-and-expunge gnus-thread-expunge-below))
(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.
(let ((lisp-mode-syntax-table score-mode-syntax-table))
- (pp score (current-buffer)))))
+ (gnus-pp score))))
(gnus-make-directory (file-name-directory file))
;; If the score file is empty, we delete it.
(if (zerop (buffer-size))
(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
"Lower the score on THREAD with SCORE-ADJUST.
THREAD is expected to contain a list of the form `(PARENT [CHILD1
CHILD2 ...])' where PARENT is a header array and each CHILD is a list
-of the same form as THREAD. The empty list `nil' is valid. For each
+of the same form as THREAD. The empty list nil is valid. For each
article in the tree, the score of the corresponding entry in
`gnus-newsgroup-scored' is adjusted by SCORE-ADJUST."
(while thread
(setq found t)
(when trace
(push
- (cons (car-safe (rassq alist gnus-score-cache)) kill)
+ (cons (car-safe (rassq alist gnus-score-cache))
+ kill)
gnus-score-trace)))
;; Update expire date
(unless trace
(goto-char (point-min))
(if (= dmt ?e)
(while (funcall search-func match nil t)
- (and (= (progn (beginning-of-line) (point))
+ (and (= (point-at-bol)
(match-beginning 0))
(= (progn (end-of-line) (point))
(match-end 0))
(setq found (setq arts (get-text-property (point) 'articles)))
;; Found a match, update scores.
(while (setq art (pop arts))
+ (setcdr art (+ score (cdr art)))
+ (when trace
+ (push (cons
+ (car-safe (rassq alist gnus-score-cache))
+ kill)
+ gnus-score-trace))
(when (setq new (gnus-score-add-followups
(car art) score all-scores thread))
(push new news)))))
;; with working on them as a group. What a hassle.
;; Just wait 'til you see what horrors we commit against `match'...
(if (= gnus-score-index 9)
- (setq this (prin1-to-string this))) ; ick.
+ (setq this (gnus-prin1-to-string this))) ; ick.
(if simplify
(setq this (gnus-map-function gnus-simplify-subject-functions this)))
(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
(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
(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)
- (while (re-search-forward "\\b\\w+\\b" nil t)
- (setq val
- (gnus-gethash
- (setq word (downcase (buffer-substring
- (match-beginning 0) (match-end 0))))
- hashtb))
- (gnus-sethash
- word
- (append (get-text-property (gnus-point-at-eol) 'articles) val)
- hashtb)))
- (set-syntax-table syntab))
+ (with-syntax-table gnus-adaptive-word-syntax-table
+ (while (re-search-forward "\\b\\w+\\b" nil t)
+ (setq val
+ (gnus-gethash
+ (setq word (downcase (buffer-substring
+ (match-beginning 0) (match-end 0))))
+ hashtb))
+ (gnus-sethash
+ word
+ (append (get-text-property (point-at-eol) 'articles) val)
+ hashtb)))
;; Make all the ignorable words ignored.
(let ((ignored (append gnus-ignored-adaptive-words
(if gnus-adaptive-word-no-group-words
(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)
- ;; Go through all articles.
- (while (setq d (pop data))
- (when (and
- (not (gnus-data-pseudo-p d))
- (setq score
- (cdr (assq
- (gnus-data-mark d)
- gnus-adaptive-word-score-alist))))
- ;; This article has a mark that should lead to
- ;; adaptive word rules, so we insert the subject
- ;; and find all words in that string.
- (insert (mail-header-subject (gnus-data-header d)))
- (downcase-region (point-min) (point-max))
- (goto-char (point-min))
- (while (re-search-forward "\\b\\w+\\b" nil t)
- ;; Put the word and score into the hashtb.
- (setq val (gnus-gethash (setq word (match-string 0))
- hashtb))
- (when (or (not gnus-adaptive-word-length-limit)
- (> (length word)
- gnus-adaptive-word-length-limit))
- (setq val (+ score (or val 0)))
- (if (and gnus-adaptive-word-minimum
- (< val gnus-adaptive-word-minimum))
- (setq val gnus-adaptive-word-minimum))
- (gnus-sethash word val hashtb)))
- (erase-buffer))))
- (set-syntax-table syntab))
+ (with-syntax-table gnus-adaptive-word-syntax-table
+ ;; Go through all articles.
+ (while (setq d (pop data))
+ (when (and
+ (not (gnus-data-pseudo-p d))
+ (setq score
+ (cdr (assq
+ (gnus-data-mark d)
+ gnus-adaptive-word-score-alist))))
+ ;; This article has a mark that should lead to
+ ;; adaptive word rules, so we insert the subject
+ ;; and find all words in that string.
+ (insert (mail-header-subject (gnus-data-header d)))
+ (downcase-region (point-min) (point-max))
+ (goto-char (point-min))
+ (while (re-search-forward "\\b\\w+\\b" nil t)
+ ;; Put the word and score into the hashtb.
+ (setq val (gnus-gethash (setq word (match-string 0))
+ hashtb))
+ (when (or (not gnus-adaptive-word-length-limit)
+ (> (length word)
+ gnus-adaptive-word-length-limit))
+ (setq val (+ score (or val 0)))
+ (if (and gnus-adaptive-word-minimum
+ (< val gnus-adaptive-word-minimum))
+ (setq val gnus-adaptive-word-minimum))
+ (gnus-sethash word val hashtb)))
+ (erase-buffer))))
;; Make all the ignorable words ignored.
(let ((ignored (append gnus-ignored-adaptive-words
(if gnus-adaptive-word-no-group-words
(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."
(let ((gnus-newsgroup-headers
(list (gnus-summary-article-header)))
(gnus-newsgroup-scored nil)
- trace)
+ ;; Must be synced with `gnus-score-edit-file-at-point':
+ (frmt "%S [%s] -> %s\n")
+ trace
+ file)
(save-excursion
(nnheader-set-temp-buffer "*Score Trace*"))
(setq gnus-score-trace nil)
1 "No score rules apply to the current article (default score %d)."
gnus-summary-default-score)
(set-buffer "*Score Trace*")
+ ;; Use a keymap instead?
+ (local-set-key "q"
+ (lambda ()
+ (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)
+ (gnus-score-edit-file-at-point)))
+ (local-set-key "f" (lambda ()
+ "Run `gnus-score-edit-file-at-point'."
+ (interactive)
+ (gnus-score-edit-file-at-point 'format)))
+ (local-set-key "t" 'toggle-truncate-lines)
(setq truncate-lines t)
- (while trace
- (insert (format "%S -> %s\n" (cdar trace)
- (or (caar trace) "(non-file rule)")))
- (setq trace (cdr trace)))
+ (dolist (entry trace)
+ (setq file (or (car entry)
+ ;; Must be synced with
+ ;; `gnus-score-edit-file-at-point':
+ "(non-file rule)"))
+ (insert
+ (format frmt
+ (cdr entry)
+ ;; Don't use `file-name-sans-extension' to see .SCORE and
+ ;; .ADAPT directly:
+ (file-name-nondirectory file)
+ (abbreviate-file-name file))))
+ (insert
+ "\n\nQuick help:
+
+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, `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.")
(goto-char (point-min))
(gnus-configure-windows 'score-trace)))
(set-buffer gnus-summary-buffer)
(ignore-errors (string-match regexp group-trans))))
(push (car sfiles) ofiles)))
(setq sfiles (cdr sfiles)))
- (kill-buffer (current-buffer))
+ (gnus-kill-buffer (current-buffer))
;; Slight kludge here - the last score file returned should be
;; the local score file, whether it exists or not. This is so
;; that any score commands the user enters will go to the right
(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.
;; Go through all the functions for finding score files (or actual
;; scores) and add them to a list.
(while funcs
- (when (gnus-functionp (car funcs))
+ (when (functionp (car funcs))
(setq score-files
(append score-files
(nreverse (funcall (car funcs) group)))))
((stringp elem)
elem)
;; Function.
- ((gnus-functionp elem)
+ ((functionp elem)
(funcall elem group))
;; Regexp-file cons.
((consp elem)
(defun gnus-decay-score (score)
"Decay SCORE according to `gnus-score-decay-constant' and `gnus-score-decay-scale'."
- (floor
- (- score
- (* (if (< score 0) -1 1)
- (min (abs score)
- (max gnus-score-decay-constant
- (* (abs score)
- gnus-score-decay-scale)))))))
+ (let ((n (- score
+ (* (if (< score 0) -1 1)
+ (min (abs score)
+ (max gnus-score-decay-constant
+ (* (abs score)
+ gnus-score-decay-scale)))))))
+ (if (and (featurep 'xemacs)
+ ;; XEmacs' floor can handle only the floating point
+ ;; number below the half of the maximum integer.
+ (> (abs n) (lsh -1 -2)))
+ (string-to-number
+ (car (split-string (number-to-string n) "\\.")))
+ (floor n))))
(defun gnus-decay-scores (alist day)
"Decay non-permanent scores in ALIST."
In the `bad' case, the string is a unsafe subexpression of REGEXP,
and we do not have a simple replacement to suggest.
-See `(Gnus)Scoring Tips' for examples of good regular expressions."
+See Info node `(gnus)Scoring Tips' for examples of good regular expressions."
(let (case-fold-search)
(and
;; First, try a relatively fast necessary condition.
(provide 'gnus-score)
+;; arch-tag: d3922589-764d-46ae-9954-9330fd192634
;;; gnus-score.el ends here
projects / gnus / blobdiff