;;; gnus-score.el --- scoring code for Gnus
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
;; 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
(gnus-score-insert-help "Match permanence" char-to-perm 2)))
(gnus-score-kill-help-buffer)
- (if mimic (message "%c %c %c" prefix hchar tchar pchar)
+ (if mimic (message "%c %c %c %c" prefix hchar tchar pchar)
(message ""))
(unless (setq temporary (cadr (assq pchar char-to-perm)))
;; Deal with der(r)ided superannuated paradigms.
(setq i (1+ i))))
(goto-char (point-min))
;; display ourselves in a small window at the bottom
- (gnus-appt-select-lowest-window)
+ (gnus-select-lowest-window)
(if (< (/ (window-height) 2) window-min-height)
(switch-to-buffer "*Score Help*")
(split-window)
4 (substitute-command-keys
"\\<gnus-score-mode-map>\\[gnus-score-edit-exit] to save edits"))))
+(defun gnus-score-edit-all-score ()
+ "Edit the all.SCORE file."
+ (interactive)
+ (find-file (gnus-score-file-name "all"))
+ (gnus-score-mode))
+
(defun gnus-score-edit-file (file)
"Edit a score file."
(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-edit-file-at-point (&optional format)
+ "Edit score file at point in Score Trace buffers.
+If FORMAT, also format the current score file."
+ (let* ((rule (save-excursion
+ (beginning-of-line)
+ (read (current-buffer))))
+ (sep "[ \n\r\t]*")
+ ;; Must be synced with `gnus-score-find-trace':
+ (reg " -> +")
+ (file (save-excursion
+ (end-of-line)
+ (if (and (re-search-backward reg (point-at-bol) t)
+ (re-search-forward reg (point-at-eol) t))
+ (buffer-substring (point) (point-at-eol))
+ nil))))
+ (if (or (not file)
+ (string-match "\\<\\(non-file rule\\|A file\\)\\>" file)
+ ;; (see `gnus-score-find-trace' and `gnus-score-advanced')
+ (string= "" file))
+ (gnus-error 3 "Can't find a score file in current line.")
+ (gnus-score-edit-file file)
+ (when format
+ (gnus-score-pretty-print))
+ (when (consp rule) ;; the rule exists
+ (setq rule (mapconcat #'(lambda (obj)
+ (regexp-quote (format "%S" obj)))
+ rule
+ sep))
+ (goto-char (point-min))
+ (re-search-forward rule nil t)
+ ;; make it easy to use `kill-sexp':
+ (goto-char (1- (match-beginning 0)))))))
(defun gnus-score-load-file (file)
;; Load score file FILE. Returns a list a retrieved score-alists.
;; files.
(when (and files (not global))
(setq lists (apply 'append lists
- (mapcar (lambda (file)
- (gnus-score-load-file file))
+ (mapcar 'gnus-score-load-file
(if adapt-file (cons adapt-file files)
files)))))
(when (and eval (not global))
(goto-char (point-min))
(if (= dmt ?e)
(while (funcall search-func match nil t)
- (and (= (gnus-point-at-bol)
+ (and (= (point-at-bol)
(match-beginning 0))
(= (progn (end-of-line) (point))
(match-end 0))
(funcall search-func match nil t))
;; Is it really exact?
(and (eolp)
- (= (gnus-point-at-bol) (match-beginning 0))
+ (= (point-at-bol) (match-beginning 0))
;; Yup.
(progn
(setq found (setq arts (get-text-property
(goto-char (point-min))
(while (and (not (eobp))
(search-forward match nil t))
- (when (and (= (gnus-point-at-bol) (match-beginning 0))
+ (when (and (= (point-at-bol) (match-beginning 0))
(eolp))
(setq found (setq arts (get-text-property (point) 'articles)))
(if trace
(defun gnus-enter-score-words-into-hashtb (hashtb)
;; Find all the words in the buffer and enter them into
;; the hashtable.
- (let ((syntab (syntax-table))
- word val)
+ (let (word val)
(goto-char (point-min))
- (unwind-protect
- (progn
- (set-syntax-table gnus-adaptive-word-syntax-table)
- (while (re-search-forward "\\b\\w+\\b" nil t)
- (setq val
- (gnus-gethash
- (setq word (downcase (buffer-substring
- (match-beginning 0) (match-end 0))))
- hashtb))
- (gnus-sethash
- word
- (append (get-text-property (gnus-point-at-eol) 'articles) val)
- hashtb)))
- (set-syntax-table syntab))
+ (with-syntax-table gnus-adaptive-word-syntax-table
+ (while (re-search-forward "\\b\\w+\\b" nil t)
+ (setq val
+ (gnus-gethash
+ (setq word (downcase (buffer-substring
+ (match-beginning 0) (match-end 0))))
+ hashtb))
+ (gnus-sethash
+ word
+ (append (get-text-property (point-at-eol) 'articles) val)
+ hashtb)))
;; Make all the ignorable words ignored.
(let ((ignored (append gnus-ignored-adaptive-words
(if gnus-adaptive-word-no-group-words
(let* ((hashtb (gnus-make-hashtable 1000))
(date (date-to-day (current-time-string)))
(data gnus-newsgroup-data)
- (syntab (syntax-table))
word d score val)
- (unwind-protect
- (progn
- (set-syntax-table gnus-adaptive-word-syntax-table)
- ;; Go through all articles.
- (while (setq d (pop data))
- (when (and
- (not (gnus-data-pseudo-p d))
- (setq score
- (cdr (assq
- (gnus-data-mark d)
- gnus-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.
- (insert (mail-header-subject (gnus-data-header d)))
- (downcase-region (point-min) (point-max))
- (goto-char (point-min))
- (while (re-search-forward "\\b\\w+\\b" nil t)
- ;; Put the word and score into the hashtb.
- (setq val (gnus-gethash (setq word (match-string 0))
- 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))
+ (with-syntax-table gnus-adaptive-word-syntax-table
+ ;; Go through all articles.
+ (while (setq d (pop data))
+ (when (and
+ (not (gnus-data-pseudo-p d))
+ (setq score
+ (cdr (assq
+ (gnus-data-mark d)
+ gnus-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.
+ (insert (mail-header-subject (gnus-data-header d)))
+ (downcase-region (point-min) (point-max))
+ (goto-char (point-min))
+ (while (re-search-forward "\\b\\w+\\b" nil t)
+ ;; Put the word and score into the hashtb.
+ (setq val (gnus-gethash (setq word (match-string 0))
+ 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))))
;; Make all the ignorable words ignored.
(let ((ignored (append gnus-ignored-adaptive-words
(if gnus-adaptive-word-no-group-words
(when winconf
(set-window-configuration winconf))
(gnus-score-remove-from-cache bufnam)
- (gnus-score-load-file bufnam)))
+ (gnus-score-load-file bufnam)
+ (run-hooks 'gnus-score-edit-done-hook)))
(defun gnus-score-find-trace ()
"Find all score rules that applies to the current article."
(let ((gnus-newsgroup-headers
(list (gnus-summary-article-header)))
(gnus-newsgroup-scored nil)
- trace)
+ ;; Must be synced with `gnus-score-edit-file-at-point':
+ (frmt "%S [%s] -> %s\n")
+ trace
+ file)
(save-excursion
(nnheader-set-temp-buffer "*Score Trace*"))
(setq gnus-score-trace nil)
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?
+ ;; 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)
+ (local-set-key "k"
+ (lambda ()
+ (interactive)
+ (kill-buffer (current-buffer))
+ (gnus-summary-expand-window)))
+ (local-set-key "e" (lambda ()
+ "Run `gnus-score-edit-file-at-point'."
+ (interactive)
+ (gnus-score-edit-file-at-point)))
+ (local-set-key "f" (lambda ()
+ "Run `gnus-score-edit-file-at-point'."
+ (interactive)
+ (gnus-score-edit-file-at-point 'format)))
+ (local-set-key "t" 'toggle-truncate-lines)
(setq truncate-lines t)
- (while trace
- (insert (format "%S -> %s\n" (cdar trace)
- (or (caar trace) "(non-file rule)")))
- (setq trace (cdr trace)))
+ (dolist (entry trace)
+ (setq file (or (car entry)
+ ;; Must be synced with
+ ;; `gnus-score-edit-file-at-point':
+ "(non-file rule)"))
+ (insert
+ (format frmt
+ (cdr entry)
+ ;; Don't use `file-name-sans-extension' to see .SCORE and
+ ;; .ADAPT directly:
+ (file-name-nondirectory file)
+ (abbreviate-file-name file))))
+ (insert
+ "\n\nQuick help:
+
+Type `e' to edit score file corresponding to the score rule on current line,
+`f' to format (pretty print) the score file and edit it,
+`t' toggle to truncate long lines in this buffer,
+`q' to quit, `k' to kill score trace buffer.
+
+The first sexp on each line is the score rule, followed by the file name of
+the score file and its full name, including the directory.")
(goto-char (point-min))
(gnus-configure-windows 'score-trace)))
(set-buffer gnus-summary-buffer)
(lambda (file)
(cons (inline (gnus-score-file-rank file)) file))
files)))
- (mapcar
- (lambda (f) (cdr f))
- (sort alist 'car-less-than-car)))))
+ (mapcar 'cdr (sort alist 'car-less-than-car)))))
(defun gnus-score-find-alist (group)
"Return list of score files for GROUP.