;;; gnus-score.el --- scoring code for Gnus
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001
;; Free Software Foundation, Inc.
;; Author: Per Abrahamsen <amanda@iesd.auc.dk>
(setq gnus-global-score-files
'(\"/ftp.gnus.org:/pub/larsi/ding/score/soc.motss.SCORE\"
- \"/ftp.some-where:/pub/score\"))"
+ \"/ftp.some-where:/pub/score\"))"
:group 'gnus-score-files
:type '(repeat file))
(symbol :tag "other"))
(integer :tag "Score"))))))
+(defcustom gnus-adaptive-word-length-limit nil
+ "*Words of a length lesser than this limit will be ignored when doing adaptive scoring."
+ :group 'gnus-score-adapt
+ :type 'integer)
+
(defcustom gnus-ignored-adaptive-words nil
"List of words to be ignored when doing adaptive word scoring."
:group 'gnus-score-adapt
(defcustom gnus-score-after-write-file-function nil
"Function called with the name of the score file just written to disk."
:group 'gnus-score-files
- :type 'function)
+ :type '(choice (const nil) function))
(defcustom gnus-score-thread-simplify nil
"If non-nil, subjects will simplified as in threading."
(int-to-string match)
match))))
- (set-text-properties 0 (length match) nil match)
-
;; If this is an integer comparison, we transform from string to int.
- (when (eq (nth 2 (assoc header gnus-header-index)) 'gnus-score-integer)
- (setq match (string-to-int match)))
+ (if (eq (nth 2 (assoc header gnus-header-index)) 'gnus-score-integer)
+ (if (stringp match)
+ (setq match (string-to-int match)))
+ (set-text-properties 0 (length match) nil match))
(unless (eq date 'now)
;; Add the score entry to the score file.
gnus-kill-files-directory)))
(expand-file-name file))
file)
- (concat (file-name-as-directory gnus-kill-files-directory)
- file))))
+ (expand-file-name file gnus-kill-files-directory))))
(cached (assoc file gnus-score-cache))
(global (member file gnus-internal-global-score-files))
lists alist)
(mark-and-expunge (car (gnus-score-get 'mark-and-expunge alist)))
(files (gnus-score-get 'files alist))
(exclude-files (gnus-score-get 'exclude-files alist))
- (orphan (car (gnus-score-get 'orphan alist)))
+ (orphan (car (gnus-score-get 'orphan alist)))
(adapt (gnus-score-get 'adapt alist))
(thread-mark-and-expunge
(car (gnus-score-get 'thread-mark-and-expunge alist)))
(headers gnus-newsgroup-headers)
(current-score-file gnus-current-score-file)
entry header new)
- (gnus-message 5 "Scoring...")
+ (gnus-message 7 "Scoring...")
;; Create articles, an alist of the form `(HEADER . SCORE)'.
(while (setq header (pop headers))
;; WARNING: The assq makes the function O(N*S) while it could
(gnus-score-advanced (car score) trace))
(pop score))))
- (gnus-message 5 "Scoring...done"))))))
+ (gnus-message 7 "Scoring...done"))))))
(defun gnus-score-lower-thread (thread score-adjust)
- "Lower the socre on THREAD with SCORE-ADJUST.
+ "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
which has references, but is not connected via its references to a
root article. This function finds all the orphans, and adjusts their
score in GNUS-NEWSGROUP-SCORED by SCORE."
- (let ((threads (gnus-make-threads)))
- ;; gnus-make-threads produces a list, where each entry is a "thread"
- ;; as described in the gnus-score-lower-thread docs. This function
- ;; will be called again (after limiting has been done) if the display
- ;; is threaded. It would be nice to somehow save this info and use
- ;; it later.
- (while threads
- (let* ((thread (car threads))
- (id (aref (car thread) gnus-score-index)))
- ;; If the parent of the thread is not a root, lower the score of
- ;; it and its descendants. Note that some roots seem to satisfy
- ;; (eq id nil) and some (eq id ""); not sure why.
- (if (and id (not (string= id "")))
- (gnus-score-lower-thread thread score)))
- (setq threads (cdr threads)))))
+ ;; gnus-make-threads produces a list, where each entry is a "thread"
+ ;; as described in the gnus-score-lower-thread docs. This function
+ ;; will be called again (after limiting has been done) if the display
+ ;; is threaded. It would be nice to somehow save this info and use
+ ;; it later.
+ (dolist (thread (gnus-make-threads))
+ (let ((id (aref (car thread) gnus-score-index)))
+ ;; If the parent of the thread is not a root, lower the score of
+ ;; it and its descendants. Note that some roots seem to satisfy
+ ;; (eq id nil) and some (eq id ""); not sure why.
+ (when (and id
+ (not (string= id "")))
+ (gnus-score-lower-thread thread score)))))
(defun gnus-score-integer (scores header now expire &optional trace)
(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
new news)
-
+
;; Change score file to the adaptive score file. All entries that
;; this function makes will be put into this file.
(save-excursion
(gnus-score-file-name
gnus-newsgroup-name gnus-adaptive-file-suffix))))
- (setq gnus-scores-articles (sort gnus-scores-articles
+ (setq gnus-scores-articles (sort gnus-scores-articles
'gnus-score-string<)
articles gnus-scores-articles)
(put-text-property (1- (point)) (point) 'articles alike))
(setq alike (list art)
last this)))
- (when last ; Bwadr, duplicate code.
+ (when last ; Bwadr, duplicate code.
(insert last ?\n)
(put-text-property (1- (point)) (point) 'articles alike))
(setq alist (car scores)
scores (cdr scores)
entries (assoc header alist))
- (while (cdr entries) ;First entry is the header index.
+ (while (cdr entries) ;First entry is the header index.
(let* ((rest (cdr entries))
(kill (car rest))
(match (nth 0 kill))
(push new news)))))
;; Update expire date
(cond ((null date)) ;Permanent entry.
- ((and found gnus-update-score-entry-dates)
+ ((and found gnus-update-score-entry-dates)
;Match, update date.
(gnus-score-set 'touched '(t) alist)
(setcar (nthcdr 2 kill) now))
;; 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.
- (simplify (and gnus-score-thread-simplify
- (string= "subject" header)))
+ (simplify (and gnus-score-thread-simplify
+ (string= "subject" header)))
alike last this art entries alist articles
fuzzies arts words kill)
(dmt (downcase mt))
;; Assume user already simplified regexp and fuzzies
(match (if (and simplify (not (memq dmt '(?f ?r))))
- (gnus-map-function
- gnus-simplify-subject-functions
- (nth 0 kill))
- (nth 0 kill)))
+ (gnus-map-function
+ gnus-simplify-subject-functions
+ (nth 0 kill))
+ (nth 0 kill)))
(search-func
(cond ((= dmt ?r) 're-search-forward)
((or (= dmt ?e) (= dmt ?s) (= dmt ?f)) 'search-forward)
;; Evil hackery to make match usable in non-standard headers.
(when extra
(setq match (concat "[ (](" extra " \\. \"[^)]*"
- match "[^(]*\")[ )]")
+ match "[^\"]*\")[ )]")
search-func 're-search-forward)) ; XXX danger?!?
(cond
;; Put the word and score into the hashtb.
(setq val (gnus-gethash (setq word (match-string 0))
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))
+ (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))
;; Make all the ignorable words ignored.
(defun gnus-summary-lower-thread (&optional score)
"Lower score of articles in the current thread with SCORE."
(interactive "P")
- (gnus-summary-raise-thread (- (1- (gnus-score-delta-default score)))))
+ (gnus-summary-raise-thread (- (gnus-score-delta-default score))))
;;; Finding score files.
(push file out))))
(or out
;; Return a dummy value.
- (list "~/News/this.file.does.not.exist.SCORE"))))
+ (list (expand-file-name "this.file.does.not.exist.SCORE"
+ gnus-kill-files-directory)))))
(defun gnus-score-file-regexp ()
"Return a regexp that match all score files."
;; too much.
(delete-char (min (1- (point-max)) klen))
(goto-char (point-max))
- (search-backward (string directory-sep-char))
- (delete-region (1+ (point)) (point-min)))
+ (if (search-backward (string directory-sep-char) nil t)
+ (delete-region (1+ (point)) (point-min))
+ (gnus-message 1 "Can't find directory separator in %s"
+ (car sfiles))))
;; If short file names were used, we have to translate slashes.
(goto-char (point-min))
(let ((regexp (concat
- "[/:" (if trans (char-to-string trans) "") "]")))
+ "[/:" (if trans (char-to-string trans)) "]")))
(while (re-search-forward regexp nil t)
(replace-match "." t t)))
;; Kludge to get rid of "nntp+" problems.
;; we add this score file to the list of score files
;; applicable to this group.
(when (or (and not-match
- (ignore-errors
+ (ignore-errors
(not (string-match regexp group-trans))))
- (and (not not-match)
- (ignore-errors (string-match regexp group-trans))))
+ (and (not not-match)
+ (ignore-errors (string-match regexp group-trans))))
(push (car sfiles) ofiles)))
(setq sfiles (cdr sfiles)))
(kill-buffer (current-buffer))
(while funcs
(when (gnus-functionp (car funcs))
(setq score-files
- (nconc score-files (nreverse (funcall (car funcs) group)))))
+ (append score-files
+ (nreverse (funcall (car funcs) group)))))
(setq funcs (cdr funcs)))
(when gnus-score-use-all-scores
;; Add any home score files.
(let (out)
(while files
;; #### /$ Unix-specific?
- (if (string-match "/$" (car files))
+ (if (file-directory-p (car files))
(setq out (nconc (directory-files
(car files) t
(concat (gnus-score-file-regexp) "$"))))
(when (string-match (gnus-globalify-regexp (car elem)) group)
(replace-match (cadr elem) t nil group))))))
(when found
+ (setq found (nnheader-translate-file-chars found))
(if (file-name-absolute-p found)
- found
- (nnheader-concat gnus-kill-files-directory found)))))
+ found
+ (nnheader-concat gnus-kill-files-directory found)))))
(defun gnus-hierarchial-home-score-file (group)
"Return the score file of the top-level hierarchy of GROUP."
projects / gnus / blobdiff