;;; gnus-score.el --- scoring code for Gnus
-;; Copyright (C) 1995-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2012 Free Software Foundation, Inc.
;; Author: Per Abrahamsen <amanda@iesd.auc.dk>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
(defun gnus-summary-lower-score (&optional score symp)
"Make a score entry based on the current article.
The user will be prompted for header to score on, match type,
-permanence, and the string to be used. The numerical prefix will be
-used as score. A symbolic prefix of `a' says to use the `all.SCORE'
-file for the command instead of the current score file."
+permanence, and the string to be used. The numerical prefix will
+be used as SCORE. A symbolic prefix of `a' (the SYMP parameter)
+says to use the `all.SCORE' file for the command instead of the
+current score file."
(interactive (gnus-interactive "P\ny"))
(gnus-summary-increase-score (- (gnus-score-delta-default score)) symp))
(defun gnus-summary-increase-score (&optional score symp)
"Make a score entry based on the current article.
The user will be prompted for header to score on, match type,
-permanence, and the string to be used. The numerical prefix will be
-used as score. A symbolic prefix of `a' says to use the `all.SCORE'
-file for the command instead of the current score file."
+permanence, and the string to be used. The numerical prefix will
+be used as SCORE. A symbolic prefix of `a' (the SYMP parameter)
+says to use the `all.SCORE' file for the command instead of the
+current score file."
(interactive (gnus-interactive "P\ny"))
(let* ((nscore (gnus-score-delta-default score))
(prefix (if (< nscore 0) ?L ?I))
(gnus-summary-raise-score score))))
(beginning-of-line 2))))
(gnus-set-mode-line 'summary))
-
-(defun gnus-summary-score-crossposting (score date)
- ;; Enter score file entry for current crossposting.
- ;; SCORE is the score to add.
- ;; DATE is the expire date.
- (let ((xref (gnus-summary-header "xref"))
- (start 0)
- group)
- (unless xref
- (error "This article is not crossposted"))
- (while (string-match " \\([^ \t]+\\):" xref start)
- (setq start (match-end 0))
- (when (not (string=
- (setq group
- (substring xref (match-beginning 1) (match-end 1)))
- gnus-newsgroup-name))
- (gnus-summary-score-entry
- "xref" (concat " " group ":") nil score date t)))))
-
\f
;;;
;;; Gnus Score Files
;; Find fuzzy matches.
(when fuzzies
;; Simplify the entire buffer for easy matching.
- (gnus-simplify-buffer-fuzzy)
+ (gnus-simplify-buffer-fuzzy gnus-simplify-subject-fuzzy-regexp)
(while (setq kill (cadaar fuzzies))
(let* ((match (nth 0 kill))
(type (nth 3 kill))
;; handle the multiple match alist
(while alist
(when (string-match (caar alist) group)
- (setq score-files
- (nconc score-files (copy-sequence (cdar alist)))))
+ (setq score-files (append (cdar alist) score-files)))
(setq alist (cdr alist)))
(setq alist gnus-score-file-single-match-alist)
;; handle the single match alist
;; 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
- (setq score-files
- (nconc score-files (copy-sequence (cdar alist))))
+ (setq score-files (append (cdar alist) score-files))
(setq alist nil))
(setq alist (cdr alist)))
;; cache the score files
(when gnus-score-use-all-scores
;; Get the initial score files for this group.
(when funcs
- (setq score-files (nreverse (gnus-score-find-alist group))))
+ (setq score-files (copy-sequence (gnus-score-find-alist group))))
;; Add any home adapt files.
(let ((home (gnus-home-score-file group t)))
(when home
(defun gnus-current-home-score-file (group)
"Return the \"current\" regular score file."
- (car (nreverse (gnus-score-find-alist group))))
+ (car (gnus-score-find-alist group)))
;;;
;;; Score decays
(* (abs score)
gnus-score-decay-scale)))))))
(if (and (featurep 'xemacs)
- ;; XEmacs' floor can handle only the floating point
+ ;; XEmacs's floor can handle only the floating point
;; number below the half of the maximum integer.
(> (abs n) (lsh -1 -2)))
(string-to-number
;; Return whether this score file needs to be saved. By Je-haysuss!
updated))
-(defun gnus-score-regexp-bad-p (regexp)
- "Test whether REGEXP is safe for Gnus scoring.
-A regexp is unsafe if it matches newline or a buffer boundary.
-
-If the regexp is good, return nil. If the regexp is bad, return a
-cons cell (SYM . STRING), where the symbol SYM is `new' or `bad'.
-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 Info node `(gnus)Scoring Tips' for examples of good regular expressions."
- (let (case-fold-search)
- (and
- ;; First, try a relatively fast necessary condition.
- ;; Notice ranges (like [^:] or [\t-\r]), \s>, \Sw, \W, \', \`:
- (string-match "\n\\|\\\\[SsW`']\\|\\[\\^\\|[\0-\n]-" regexp)
- ;; Now break the regexp into tokens, and check each:
- (let ((tail regexp) ; remaining regexp to check
- tok ; current token
- bad ; nil, or bad subexpression
- new ; nil, or replacement regexp so far
- end) ; length of current token
- (while (and (not bad)
- (string-match
- "\\`\\(\\\\[sS]?.\\|\\[\\^?]?[^]]*]\\|[^\\]\\)"
- tail))
- (setq end (match-end 0)
- tok (substring tail 0 end)
- tail (substring tail end))
- (if;; Is token `bad' (matching newline or buffer ends)?
- (or (member tok '("\n" "\\W" "\\`" "\\'"))
- ;; This next handles "[...]", "\\s.", and "\\S.":
- (and (> end 2) (string-match tok "\n")))
- (let ((newtok
- ;; Try to suggest a replacement for tok ...
- (cond ((string-equal tok "\\`") "^") ; or "\\(^\\)"
- ((string-equal tok "\\'") "$") ; or "\\($\\)"
- ((string-match "\\[\\^" tok) ; very common
- (concat (substring tok 0 -1) "\n]")))))
- (if newtok
- (setq new
- (concat
- (or new
- ;; good prefix so far:
- (substring regexp 0 (- (+ (length tail) end))))
- newtok))
- ;; No replacement idea, so give up:
- (setq bad tok)))
- ;; tok is good, may need to extend new
- (and new (setq new (concat new tok)))))
- ;; Now return a value:
- (cond
- (bad (cons 'bad bad))
- (new (cons 'new new))
- (t nil))))))
-
(provide 'gnus-score)
;;; gnus-score.el ends here
projects / gnus / blobdiff