X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-score.el;h=b2188ed1786688bb4741074537586048bc2741f4;hb=ca01e52e2b1397e26d4fd7ba510e38fe6f109e12;hp=a10fb63e4b671d87ca6d9af95d583e517d308a5f;hpb=1933264aa7c81ed66395bfc323b30b9993789e91;p=gnus diff --git a/lisp/gnus-score.el b/lisp/gnus-score.el index a10fb63e4..b2188ed17 100644 --- a/lisp/gnus-score.el +++ b/lisp/gnus-score.el @@ -1,5 +1,5 @@ ;;; gnus-score.el --- scoring code for Gnus -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002 +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 ;; Free Software Foundation, Inc. ;; Author: Per Abrahamsen @@ -36,6 +36,8 @@ (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 @@ -735,10 +737,13 @@ used as score." (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)))) @@ -932,7 +937,6 @@ EXTRA is the possible non-standard header." ;; All score code written by Per Abrahamsen . -;; Added by Per Abrahamsen . (defun gnus-score-set-mark-below (score) "Automatically mark articles with score below SCORE as read." (interactive @@ -1099,6 +1103,22 @@ EXTRA is the possible non-standard header." 4 (substitute-command-keys "\\\\[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 @@ -1475,7 +1495,7 @@ EXTRA is the possible non-standard header." (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 @@ -1500,7 +1520,7 @@ EXTRA is the possible non-standard header." "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 @@ -1721,7 +1741,8 @@ score in `gnus-newsgroup-scored' by SCORE." (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 @@ -1808,7 +1829,7 @@ score in `gnus-newsgroup-scored' by SCORE." (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)) @@ -1827,6 +1848,12 @@ score in `gnus-newsgroup-scored' by SCORE." (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))))) @@ -1900,7 +1927,7 @@ score in `gnus-newsgroup-scored' by SCORE." ;; 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))) @@ -2334,6 +2361,13 @@ score in `gnus-newsgroup-scored' by SCORE." 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) @@ -2610,7 +2644,7 @@ GROUP using BNews sys file syntax." (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 @@ -2742,7 +2776,7 @@ The list is determined from the variable `gnus-score-file-alist'." ;; 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))))) @@ -2845,7 +2879,7 @@ If ADAPT, return the home adaptive file instead." ((stringp elem) elem) ;; Function. - ((gnus-functionp elem) + ((functionp elem) (funcall elem group)) ;; Regexp-file cons. ((consp elem) @@ -2922,7 +2956,7 @@ In the `new' case, the string is a safe replacement for REGEXP. 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.