: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-score-mimic-keymap nil
"*Have the score entry functions pretend that they are a keymap."
:group 'gnus-score-default
permanence, and the string to be used. The numerical prefix will be
used as score."
(interactive (gnus-interactive "P\ny"))
- (gnus-set-global-variables)
(let* ((nscore (gnus-score-default score))
(prefix (if (< nscore 0) ?L ?I))
(increase (> nscore 0))
(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))
(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)
(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
- "\\<gnus-score-mode-map>\\[gnus-score-edit-exit] to save edits")))
+ (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 (substitute-command-keys
+ "\\<gnus-score-mode-map>\\[gnus-score-edit-exit] to save edits"))))
(defun gnus-score-edit-file (file)
"Edit a score file."
(eval (car (gnus-score-get 'eval alist))))
;; Perform possible decays.
(when (and gnus-decay-scores
+ (or cached (file-exists-p file))
(or (not decay)
(gnus-decay-scores alist decay)))
(gnus-score-set 'touched '(t) alist)
(set-buffer gnus-summary-buffer)
(gnus-score-load-file
(or gnus-newsgroup-adaptive-score-file
+ (gnus-home-score-file gnus-newsgroup-name t)
(gnus-score-file-name
gnus-newsgroup-name gnus-adaptive-file-suffix))))
;; Perform ordinary line scoring.
(alist malist)
(date (current-time-string))
(data gnus-newsgroup-data)
- elem headers match)
+ elem headers match func)
;; First we transform the adaptive rule alist into something
;; that's faster to process.
(while malist
(setcar elem (symbol-value (car elem))))
(setq elem (cdr elem))
(while elem
- (setcdr (car elem)
- (cons (if (eq (caar elem) 'followup)
- "references"
- (symbol-name (caar elem)))
- (cdar elem)))
- (setcar (car elem)
- `(lambda (h)
- (,(intern
+ (when (fboundp
+ (setq func
+ (intern
(concat "mail-header-"
(if (eq (caar elem) 'followup)
"message-id"
- (downcase (symbol-name (caar elem))))))
- h)))
+ (downcase (symbol-name (caar elem))))))))
+ (setcdr (car elem)
+ (cons (if (eq (caar elem) 'followup)
+ "references"
+ (symbol-name (caar elem)))
+ (cdar elem)))
+ (setcar (car elem)
+ `(lambda (h)
+ (,func h))))
(setq elem (cdr elem)))
(setq malist (cdr malist)))
;; Then we score away.
;; Put the word and score into the hashtb.
(setq val (gnus-gethash (setq word (match-string 0))
hashtb))
- (gnus-sethash word (+ (or val 0) score) hashtb))
+ (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))
;; Make all the ignorable words ignored.
(let ((funcs gnus-score-find-score-files-function)
(group (or group gnus-newsgroup-name))
score-files)
- ;; Make sure funcs is a list.
- (and funcs
- (not (listp funcs))
- (setq funcs (list funcs)))
- ;; Get the initial score files for this group.
- (when funcs
- (setq score-files (nreverse (gnus-score-find-alist group))))
- ;; Add any home adapt files.
- (let ((home (gnus-home-score-file group t)))
- (when home
- (push home score-files)
- (setq gnus-newsgroup-adaptive-score-file home)))
- ;; Check whether there is a `adapt-file' group parameter.
- (let ((param-file (gnus-group-find-parameter group 'adapt-file)))
- (when param-file
- (push param-file score-files)
- (setq gnus-newsgroup-adaptive-score-file param-file)))
- ;; 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))
- (setq score-files
- (nconc score-files (nreverse (funcall (car funcs) group)))))
- (setq funcs (cdr funcs)))
- ;; Add any home score files.
- (let ((home (gnus-home-score-file group)))
- (when home
- (push home score-files)))
- ;; Check whether there is a `score-file' group parameter.
- (let ((param-file (gnus-group-find-parameter group 'score-file)))
- (when param-file
- (push param-file score-files)))
- ;; Expand all files names.
- (let ((files score-files))
- (while files
- (when (stringp (car files))
- (setcar files (expand-file-name
- (car files) gnus-kill-files-directory)))
- (pop files)))
- (setq score-files (nreverse score-files))
- ;; Remove any duplicate score files.
- (while (and score-files
- (member (car score-files) (cdr score-files)))
- (pop score-files))
- (let ((files score-files))
- (while (cdr files)
- (if (member (cadr files) (cddr files))
- (setcdr files (cddr files))
- (pop files))))
- ;; Do the scoring if there are any score files for this group.
- score-files))
+ (when group
+ ;; Make sure funcs is a list.
+ (and funcs
+ (not (listp funcs))
+ (setq funcs (list funcs)))
+ ;; Get the initial score files for this group.
+ (when funcs
+ (setq score-files (nreverse (gnus-score-find-alist group))))
+ ;; Add any home adapt files.
+ (let ((home (gnus-home-score-file group t)))
+ (when home
+ (push home score-files)
+ (setq gnus-newsgroup-adaptive-score-file home)))
+ ;; Check whether there is a `adapt-file' group parameter.
+ (let ((param-file (gnus-group-find-parameter group 'adapt-file)))
+ (when param-file
+ (push param-file score-files)
+ (setq gnus-newsgroup-adaptive-score-file param-file)))
+ ;; 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))
+ (setq score-files
+ (nconc score-files (nreverse (funcall (car funcs) group)))))
+ (setq funcs (cdr funcs)))
+ ;; Add any home score files.
+ (let ((home (gnus-home-score-file group)))
+ (when home
+ (push home score-files)))
+ ;; Check whether there is a `score-file' group parameter.
+ (let ((param-file (gnus-group-find-parameter group 'score-file)))
+ (when param-file
+ (push param-file score-files)))
+ ;; Expand all files names.
+ (let ((files score-files))
+ (while files
+ (when (stringp (car files))
+ (setcar files (expand-file-name
+ (car files) gnus-kill-files-directory)))
+ (pop files)))
+ (setq score-files (nreverse score-files))
+ ;; Remove any duplicate score files.
+ (while (and score-files
+ (member (car score-files) (cdr score-files)))
+ (pop score-files))
+ (let ((files score-files))
+ (while (cdr files)
+ (if (member (cadr files) (cddr files))
+ (setcdr files (cddr files))
+ (pop files))))
+ ;; Do the scoring if there are any score files for this group.
+ score-files)))
(defun gnus-possibly-score-headers (&optional trace)
"Do scoring if scoring is required."
projects / elisp / gnus.git- / blobdiff