(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
(?b "body" "" nil body-string)
(?h "head" "" nil body-string)
(?i "message-id" nil t string)
- (?t "references" "message-id" nil string)
+ (?r "references" "message-id" nil string)
(?x "xref" 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)
;; 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)
(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*"))
+ (set-buffer (gnus-get-buffer-create "*Score Help*"))
(buffer-disable-undo (current-buffer))
(delete-windows-on (current-buffer))
(erase-buffer)
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))))
;; Regexp is the default type.
(when (eq type t)
(setq type 'r))
;; Load score file FILE. Returns a list a retrieved score-alists.
(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)
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.
(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 (gnus-time-to-day (current-time))) alist))
;; We do not respect eval and files atoms from global score
;; files.
(when (and files (not global))
(read (current-buffer))
(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)))))
(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
gnus-scores-articles))))
(save-excursion
- (set-buffer (get-buffer-create "*Headers*"))
+ (set-buffer (gnus-get-buffer-create "*Headers*"))
(buffer-disable-undo (current-buffer))
(when (gnus-buffer-live-p gnus-summary-buffer)
(message-clone-locals gnus-summary-buffer))
(setq request-func 'gnus-request-article))
(while articles
(setq article (mail-header-number (caar articles)))
- (gnus-message 7 "Scoring on article %s of %s..." article last)
+ (gnus-message 7 "Scoring article %s of %s..." article last)
(when (funcall request-func article gnus-newsgroup-name)
(widen)
(goto-char (point-min))
(while (setq art (pop articles))
(setq this (aref (car art) gnus-score-index))
(if simplify
- (setq this (gnus-map-function gnus-simplify-subject-functions this)))
+ (setq this (gnus-map-function gnus-simplify-subject-functions this)))
(if (equal last this)
;; O(N*H) cons-cells used here, where H is the number of
;; headers.
(mt (aref (symbol-name type) 0))
(case-fold-search (not (memq mt '(?R ?S ?E ?F))))
(dmt (downcase mt))
- ; Assume user already simplified regexp and fuzzies
+ ; Assume user already simplified regexp and fuzzies
(match (if (and simplify (not (memq dmt '(?f ?r))))
(gnus-map-function
gnus-simplify-subject-functions
(cond
;; Fuzzy matches. We save these for later.
((= dmt ?f)
- (push (cons entries alist) fuzzies))
+ (push (cons entries alist) fuzzies)
+ (setq entries (cdr entries)))
;; Word matches. Save these for even later.
((= dmt ?w)
- (push (cons entries alist) words))
+ (push (cons entries alist) words)
+ (setq entries (cdr entries)))
;; Exact matches.
((= dmt ?e)
;; Do exact matching.
gnus-score-trace))
(while (setq art (pop arts))
(setcdr art (+ score (cdr art)))))))
- (forward-line 1)))
+ (forward-line 1))
+ ;; Update expiry date
+ (if trace
+ (setq entries (cdr entries))
+ (cond
+ ;; Permanent entry.
+ ((null date)
+ (setq entries (cdr entries)))
+ ;; We have a match, so we update the date.
+ ((and found gnus-update-score-entry-dates)
+ (gnus-score-set 'touched '(t) alist)
+ (setcar (nthcdr 2 kill) now)
+ (setq entries (cdr entries)))
+ ;; This entry has expired, so we remove it.
+ ((and expire (< date expire))
+ (gnus-score-set 'touched '(t) alist)
+ (setcdr entries (cddr entries)))
+ ;; No match; go to next entry.
+ (t
+ (setq entries (cdr entries))))))
;; Regexp and substring matching.
(t
(goto-char (point-min))
gnus-score-trace))
(while (setq art (pop arts))
(setcdr art (+ score (cdr art)))))
- (forward-line 1))))
- ;; Update expiry date
- (if trace
- (setq entries (cdr entries))
- (cond
- ;; Permanent entry.
- ((null date)
- (setq entries (cdr entries)))
- ;; We have a match, so we update the date.
- ((and found gnus-update-score-entry-dates)
- (gnus-score-set 'touched '(t) alist)
- (setcar (nthcdr 2 kill) now)
- (setq entries (cdr entries)))
- ;; This entry has expired, so we remove it.
- ((and expire (< date expire))
- (gnus-score-set 'touched '(t) alist)
- (setcdr entries (cddr entries)))
- ;; No match; go to next entry.
- (t
- (setq entries (cdr entries))))))))
+ (forward-line 1))
+ ;; Update expiry date
+ (if trace
+ (setq entries (cdr entries))
+ (cond
+ ;; Permanent entry.
+ ((null date)
+ (setq entries (cdr entries)))
+ ;; We have a match, so we update the date.
+ ((and found gnus-update-score-entry-dates)
+ (gnus-score-set 'touched '(t) alist)
+ (setcar (nthcdr 2 kill) now)
+ (setq entries (cdr entries)))
+ ;; This entry has expired, so we remove it.
+ ((and expire (< date expire))
+ (gnus-score-set 'touched '(t) alist)
+ (setcdr entries (cddr entries)))
+ ;; No match; go to next entry.
+ (t
+ (setq entries (cdr entries))))))))))
;; Find fuzzy matches.
(when fuzzies
(setcdr art (+ score (cdr art))))))
(forward-line 1))
;; Update expiry date
- (cond
- ;; Permanent.
- ((null date)
- )
- ;; Match, update date.
- ((and found gnus-update-score-entry-dates)
- (gnus-score-set 'touched '(t) (cdar fuzzies))
- (setcar (nthcdr 2 kill) now))
- ;; Old entry, remove.
- ((and expire (< date expire))
- (gnus-score-set 'touched '(t) (cdar fuzzies))
- (setcdr (caar fuzzies) (cddaar fuzzies))))
+ (if (not trace)
+ (cond
+ ;; Permanent.
+ ((null date)
+ )
+ ;; Match, update date.
+ ((and found gnus-update-score-entry-dates)
+ (gnus-score-set 'touched '(t) (cdar fuzzies))
+ (setcar (nthcdr 2 kill) now))
+ ;; Old entry, remove.
+ ((and expire (< date expire))
+ (gnus-score-set 'touched '(t) (cdar fuzzies))
+ (setcdr (caar fuzzies) (cddaar fuzzies)))))
(setq fuzzies (cdr fuzzies)))))
(when words
(while (setq art (pop arts))
(setcdr art (+ score (cdr art))))))
;; Update expiry date
- (cond
- ;; Permanent.
- ((null date)
- )
- ;; Match, update date.
- ((and found gnus-update-score-entry-dates)
- (gnus-score-set 'touched '(t) (cdar words))
- (setcar (nthcdr 2 kill) now))
- ;; Old entry, remove.
- ((and expire (< date expire))
- (gnus-score-set 'touched '(t) (cdar words))
- (setcdr (caar words) (cddaar words))))
+ (if (not trace)
+ (cond
+ ;; Permanent.
+ ((null date)
+ )
+ ;; Match, update date.
+ ((and found gnus-update-score-entry-dates)
+ (gnus-score-set 'touched '(t) (cdar words))
+ (setcar (nthcdr 2 kill) now))
+ ;; Old entry, remove.
+ ((and expire (< date expire))
+ (gnus-score-set 'touched '(t) (cdar words))
+ (setcdr (caar words) (cddaar words)))))
(setq words (cdr words))))))
nil))
1 "No score rules apply to the current article (default score %d)."
gnus-summary-default-score)
(set-buffer "*Score Trace*")
- (gnus-add-current-to-buffer-list)
(while trace
(insert (format "%S -> %s\n" (cdar trace)
(if (caar trace)
(while rules
(insert (format "%-5d: %s\n" (caar rules) (cdar rules)))
(pop rules))
- (gnus-add-current-to-buffer-list)
(goto-char (point-min))
(gnus-configure-windows 'score-words))))
(trans (cdr (assq ?: nnheader-file-name-translation-alist)))
ofiles not-match regexp)
(save-excursion
- (set-buffer (get-buffer-create "*gnus score files*"))
+ (set-buffer (gnus-get-buffer-create "*gnus score files*"))
(buffer-disable-undo (current-buffer))
;; Go through all score file names and create regexp with them
;; as the source.
(interactive (list gnus-global-score-files))
(let (out)
(while files
+ ;; #### /$ Unix-specific?
(if (string-match "/$" (car files))
(setq out (nconc (directory-files
(car files) t
(funcall elem group))
;; Regexp-file cons
((consp elem)
- (when (string-match (car elem) group)
- (cadr elem))))))
+ (when (string-match (gnus-globalify-regexp (car elem)) group)
+ (replace-match (cadr elem) t nil group ))))))
(when found
(nnheader-concat gnus-kill-files-directory found))))
(concat group (if (gnus-use-long-file-name 'not-score) "." "/")
gnus-adaptive-file-suffix)))
+(defun gnus-current-home-score-file (group)
+ "Return the \"current\" regular score file."
+ (car (nreverse (gnus-score-find-alist group))))
+
;;;
;;; Score decays
;;;
projects / elisp / gnus.git- / blobdiff