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.")
+ "*All orphans get this score added. Set in the score file.")
(defvar gnus-decay-scores nil
"*If non-nil, decay non-permanent scores.")
"*Decay all \"big\" scores with this factor.")
(defvar gnus-home-score-file nil
- "Variable to control where interative score entries are to go.
+ "Variable to control where interactive score entries are to go.
It can be:
* A string
"re")
"Default list of words to be ignored when doing adaptive word scoring.")
-(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))
- table)
- "Syntax table used when doing adaptive word scoring.")
-
(defvar gnus-default-adaptive-word-score-alist
`((,gnus-read-mark . 30)
(,gnus-catchup-mark . -10)
;; 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)
"f" gnus-score-edit-file
"F" gnus-score-flush-cache
"t" gnus-score-find-trace
- "w" gnus-score-find-favourite-words
- "C" gnus-score-customize)
+ "w" gnus-score-find-favourite-words)
;; Summary score file commands
(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)))
(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 (eq 's score) nil score) ; Score
(if (eq 'perm temporary) ; Temp
nil
- temporary)
+ temporary)
(not (nth 3 entry))) ; Prompt
))
(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
(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
(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))
(interactive (list gnus-current-score-file))
(let ((winconf (current-window-configuration)))
(and (buffer-name gnus-summary-buffer) (gnus-score-save))
- (make-directory (file-name-directory file) t)
+ (gnus-make-directory (file-name-directory file))
(setq gnus-score-edit-buffer (find-file-noselect file))
(gnus-configure-windows 'edit-score)
(gnus-score-mode)
"Edit a score file."
(interactive
(list (read-file-name "Edit score file: " gnus-kill-files-directory)))
- (make-directory (file-name-directory file) t)
+ (gnus-make-directory (file-name-directory file))
(and (buffer-name gnus-summary-buffer) (gnus-score-save))
(let ((winconf (current-window-configuration)))
(setq gnus-score-edit-buffer (find-file-noselect file))
(eval (car (gnus-score-get 'eval alist))))
;; Perform possible decays.
(when (and gnus-decay-scores
- (gnus-decay-scores alist decay))
+ (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
entry score file)
(save-excursion
(setq gnus-score-alist nil)
- (nnheader-set-temp-buffer "*Score*")
+ (nnheader-set-temp-buffer " *Gnus Scores*")
(while cache
(current-buffer)
(setq entry (pop cache)
;; This is a normal score file, so we print it very
;; prettily.
(pp score (current-buffer))))
- (if (and (not (file-exists-p (file-name-directory file)))
- (make-directory (file-name-directory file) t))
- (gnus-error 1 "Can't create directory %s"
- (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.
- (when (file-writable-p file)
- (write-region (point-min) (point-max) file nil 'silent)
- (when gnus-score-after-write-file-function
- (funcall gnus-score-after-write-file-function file)))))
- (and gnus-score-uncacheable-files
- (string-match gnus-score-uncacheable-files file)
- (gnus-score-remove-from-cache file))))
+ (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.
+ (when (file-writable-p file)
+ (write-region (point-min) (point-max) file nil 'silent)
+ (when gnus-score-after-write-file-function
+ (funcall gnus-score-after-write-file-function file)))))
+ (and gnus-score-uncacheable-files
+ (string-match gnus-score-uncacheable-files file)
+ (gnus-score-remove-from-cache file)))
(kill-buffer (current-buffer)))))
(defun gnus-score-load-files (score-files)
new-thread-ids (cdr new-thread-ids))
(goto-char (point-min))
(while (search-forward this-id nil t)
- ;; found a match. remove this line
+ ;; found a match. remove this line
(beginning-of-line)
(kill-line 1)))
;; time than one would gain.
(while articles
(when (funcall match-func
- (or (aref (caar articles) gnus-score-index) 0)
- match)
+ (or (aref (caar articles) gnus-score-index) 0)
+ match)
(when trace
(push (cons (car-safe (rassq alist gnus-score-cache)) kill)
gnus-score-trace))
((and found gnus-update-score-entry-dates) ;Match, update date.
(gnus-score-set 'touched '(t) alist)
(setcar (nthcdr 2 kill) now))
- ((and expire (< date expire)) ;Old entry, remove.
+ ((and expire (< date expire)) ;Old entry, remove.
(gnus-score-set 'touched '(t) alist)
(setcdr entries (cdr rest))
(setq rest entries)))
((and found gnus-update-score-entry-dates) ;Match, update date.
(gnus-score-set 'touched '(t) alist)
(setcar (nthcdr 2 kill) now))
- ((and expire (< date expire)) ;Old entry, remove.
+ ((and expire (< date expire)) ;Old entry, remove.
(gnus-score-set 'touched '(t) alist)
(setcdr entries (cdr rest))
(setq rest entries)))
;; Insert the unique article headers in the buffer.
(let ((gnus-score-index (nth 1 (assoc header gnus-header-index)))
;; gnus-score-index is used as a free variable.
- alike last this art entries alist articles scores
+ alike last this art entries alist articles
fuzzies arts words kill)
;; Sorting the articles costs os O(N*log N) but will allow us to
;; Find all the words in the buffer and enter them into
;; the hashtable.
(let ((syntab (syntax-table))
- word val)
+ word val)
(goto-char (point-min))
(unwind-protect
(progn
(set-syntax-table syntab)
;; Go through all articles.
(while (setq d (pop data))
- (when (setq score
- (cdr (assq
- (gnus-data-mark d)
- gnus-default-adaptive-word-score-alist)))
+ (when (and
+ (not (gnus-data-pseudo-p d))
+ (setq score
+ (cdr (assq
+ (gnus-data-mark d)
+ gnus-default-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.
"List words used in scoring."
(interactive)
(let ((alists (gnus-score-load-files (gnus-all-score-files)))
- alist rule rules)
+ alist rule rules kill)
;; Go through all the score alists for this group
;; and find all `w' rules.
(while (setq alist (pop alists))
- (when (and (stringp (setq rule (pop alist)))
- (equal "subject" (downcase (pop rule))))
- (while rule
- (when (memq (nth 3 (car rule)) '(w W word Word))
- (push (cons (or (nth 1 rule) gnus-score-interactive-default-score)
- (car rule))
- rules))
- (pop rule))))
+ (while (setq rule (pop alist))
+ (when (and (stringp (car rule))
+ (equal "subject" (downcase (pop rule))))
+ (while (setq kill (pop rule))
+ (when (memq (nth 3 kill) '(w W word Word))
+ (push (cons (or (nth 1 kill)
+ gnus-score-interactive-default-score)
+ (car kill))
+ rules))))))
(setq rules (sort rules (lambda (r1 r2)
(string-lessp (cdr r1) (cdr r2)))))
;; Add up words that have appeared several times.
(pop r))))
;; Insert the words.
(nnheader-set-temp-buffer "*Score Words*")
- (setq rules (sort rules (lambda (r1 r2) (> (car r1) (car r2)))))
- (while rules
- (insert (format "%-5d: %s\n" (caar rules) (cdar rules)))
- (pop rules))
- (gnus-add-current-to-buffer-list)
- (gnus-configure-windows 'score-words)))
+ (if (not (setq rules (sort rules (lambda (r1 r2) (> (car r1) (car r2))))))
+ (gnus-error 3 "No word score rules")
+ (while rules
+ (insert (format "%-5d: %s\n" (caar rules) (cdar rules)))
+ (pop rules))
+ (gnus-add-current-to-buffer-list)
+ (gnus-configure-windows 'score-words))))
(defun gnus-summary-rescore ()
"Redo the entire scoring process in the current summary."
"[/:" (if trans (char-to-string trans) "") "]")))
(while (re-search-forward regexp nil t)
(replace-match "." t t)))
- ;; Cludge to get rid of "nntp+" problems.
+ ;; Kludge to get rid of "nntp+" problems.
(goto-char (point-min))
(and (looking-at "nn[a-z]+\\+")
(progn
(setq sfiles (cdr sfiles)))
(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
+ ;; the local score file, whether it exists or not. This is so
;; that any score commands the user enters will go to the right
;; file, and not end up in some global score file.
(let ((localscore (gnus-score-file-name group)))
(setq ofiles (cons localscore (delete localscore ofiles))))
- (nreverse ofiles))))
+ (gnus-sort-score-files (nreverse ofiles)))))
(defun gnus-score-find-single (group)
"Return list containing the score file for GROUP."
(setq all (nreverse all)))
(mapcar 'gnus-score-file-name all))))
+(defun gnus-score-file-rank (file)
+ "Return a number that says how specific score FILE is.
+Destroys the current buffer."
+ (when (string-match
+ (concat "^" (regexp-quote
+ (expand-file-name
+ (file-name-as-directory gnus-kill-files-directory))))
+ file)
+ (setq file (substring file (match-end 0))))
+ (insert file)
+ (goto-char (point-min))
+ (let ((beg (point))
+ elems)
+ (while (re-search-forward "[./]" nil t)
+ (push (buffer-substring beg (1- (point)))
+ elems))
+ (erase-buffer)
+ (setq elems (delete "all" elems))
+ (length elems)))
+
+(defun gnus-sort-score-files (files)
+ "Sort FILES so that the most general files come first."
+ (nnheader-temp-write nil
+ (let ((alist
+ (mapcar
+ (lambda (file)
+ (cons (inline (gnus-score-file-rank file)) file))
+ files)))
+ (mapcar
+ (lambda (f) (cdr f))
+ (sort alist (lambda (f1 f2) (< (car f1) (car f2))))))))
+
(defun gnus-score-find-alist (group)
"Return list of score files for GROUP.
The list is determined from the variable gnus-score-file-alist."
(while alist
(and (string-match (caar alist) group)
;; progn used just in case ("regexp") has no files
- ;; and score-files is still nil. -sj
+ ;; and score-files is still nil. -sj
;; this can be construed as a "stop searching here" feature :>
;; and used to simplify regexps in the single-alist
(progn
"Decay non-permanent scores in ALIST."
(let ((times (- (gnus-time-to-day (current-time)) day))
kill entry updated score n)
- (unless (zerop times) ;Done decays today already?
+ (unless (zerop times) ;Done decays today already?
(while (setq entry (pop alist))
(when (stringp (car entry))
(setq entry (cdr entry))
projects / gnus / blobdiff