;;; gnus-score.el --- scoring code for Gnus
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
;; Free Software Foundation, Inc.
;; Author: Per Abrahamsen <amanda@iesd.auc.dk>
(require 'message)
(require 'score-mode)
+(autoload 'ffap-string-at-point "ffap")
+
(defcustom gnus-global-score-files nil
"List of global score files and directories.
Set this variable if you want to use people's score files. One entry
(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
(mapcar (lambda (x) ; completion list
(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*")
+ (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))))
;; 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
4 (substitute-command-keys
"\\<gnus-score-mode-map>\\[gnus-score-edit-exit] to save edits")))
+(defun gnus-score-edit-file-at-point ()
+ "Edit score file at point. Useful especially after `V t'."
+ (interactive)
+ (let* ((string (ffap-string-at-point))
+ ;; FIXME: Should be the full `match element', not just string at
+ ;; point.
+ file)
+ (save-excursion
+ (end-of-line)
+ (setq file (ffap-string-at-point)))
+ (gnus-score-edit-file file)
+ (unless (string= string file)
+ (goto-char (point-min))
+ ;; Goto first match
+ (search-forward string nil t))))
+
(defun gnus-score-load-file (file)
;; Load score file FILE. Returns a list a retrieved score-alists.
(let* ((file (expand-file-name
(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))
(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 (= (gnus-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)))
1 "No score rules apply to the current article (default score %d)."
gnus-summary-default-score)
(set-buffer "*Score Trace*")
+ ;; ToDo: Use a keymap instead?
+ (local-set-key "q"
+ (lambda ()
+ (interactive)
+ (bury-buffer nil)
+ (gnus-summary-expand-window)))
+ (local-set-key "e" 'gnus-score-edit-file-at-point)
(setq truncate-lines t)
(while trace
(insert (format "%S -> %s\n" (cdar trace)
(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
;; 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)
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.