Function: gnus-summary-increase-score
gnus-summary-increase-score is an autoloaded, interactive and
byte-compiled function defined in gnus-score.el.gz.
Signature
(gnus-summary-increase-score &optional SCORE SYMP)
Documentation
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 (the SYMP parameter)
says to use the all.SCORE file for the command instead of the
current score file.
Key Bindings
Source Code
;; Defined in /usr/src/emacs/lisp/gnus/gnus-score.el.gz
(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' (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-article-mode gnus-summary-mode)
(let* ((nscore (gnus-score-delta-default score))
(prefix (if (< nscore 0) ?L ?I))
(increase (> nscore 0))
(char-to-header
'((?a "from" nil nil string)
(?s "subject" nil nil string)
(?b "body" "" nil body-string)
(?h "head" "" nil body-string)
(?i "message-id" nil nil string)
(?r "references" "message-id" nil string)
(?x "xref" nil nil string)
(?e "extra" nil nil string)
(?l "lines" nil nil number)
(?d "date" nil nil date)
(?f "followup" nil nil string)
(?t "thread" "message-id" nil string)))
(char-to-type
'((?s s "substring" string)
(?e e "exact string" string)
(?f f "fuzzy string" string)
(?r r "regexp string" string)
(?z s "substring" body-string)
(?p r "regexp string" body-string)
(?b before "before date" date)
(?a after "after date" date)
(?n at "this date" date)
(?< < "less than number" number)
(?> > "greater than number" number)
(?= = "equal to number" number)))
(current-score-file gnus-current-score-file)
(char-to-perm
(list (list ?t (current-time-string) "temporary")
'(?p perm "permanent") '(?i now "immediate")))
(mimic gnus-score-mimic-keymap)
(hchar (and gnus-score-default-header
(aref (symbol-name gnus-score-default-header) 0)))
(tchar (and gnus-score-default-type
(aref (symbol-name gnus-score-default-type) 0)))
(pchar (and gnus-score-default-duration
(aref (symbol-name gnus-score-default-duration) 0)))
entry temporary type match extra)
(unwind-protect
(progn
;; First we read the header to score.
(while (not hchar)
(if mimic
(progn
(sit-for 1)
(message "%c-" prefix))
(message "%s header (%s?): " (if increase "Increase" "Lower")
(mapconcat (lambda (s) (char-to-string (car s)))
char-to-header "")))
(setq hchar (read-char))
(when (or (= hchar ??) (= hchar ?\C-h))
(setq hchar nil)
(gnus-score-insert-help "Match on header" char-to-header 1)))
(gnus-score-kill-help-buffer)
(unless (setq entry (assq (downcase hchar) char-to-header))
(if mimic (error "%c %c" prefix hchar)
(error "Invalid header type")))
(when (/= (downcase hchar) hchar)
;; This was a majuscule, so we end reading and set the defaults.
(if mimic (message "%c %c" prefix hchar) (message ""))
(setq tchar (or tchar ?s)
pchar (or pchar ?t)))
(let ((legal-types
(delq nil
(mapcar (lambda (s)
(if (eq (nth 4 entry)
(nth 3 s))
s nil))
char-to-type))))
;; We continue reading - the type.
(while (not tchar)
(if mimic
(progn
(sit-for 1) (message "%c %c-" prefix hchar))
(message "%s header `%s' with match type (%s?): "
(if increase "Increase" "Lower")
(nth 1 entry)
(mapconcat (lambda (s) (char-to-string (car s)))
legal-types "")))
(setq tchar (read-char))
(when (or (= tchar ??) (= tchar ?\C-h))
(setq tchar nil)
(gnus-score-insert-help "Match type" legal-types 2)))
(gnus-score-kill-help-buffer)
(unless (setq type (nth 1 (assq (downcase tchar) legal-types)))
(if mimic (error "%c %c" prefix hchar)
(error "Invalid match type"))))
(when (/= (downcase tchar) tchar)
;; It was a majuscule, so we end reading and use the default.
(if mimic (message "%c %c %c" prefix hchar tchar)
(message ""))
(setq pchar (or pchar ?t)))
;; We continue reading.
(while (not pchar)
(if mimic
(progn
(sit-for 1) (message "%c %c %c-" prefix hchar tchar))
(message "%s permanence (%s?): " (if increase "Increase" "Lower")
(mapconcat (lambda (s) (char-to-string (car s)))
char-to-perm "")))
(setq pchar (read-char))
(when (or (= pchar ??) (= pchar ?\C-h))
(setq pchar nil)
(gnus-score-insert-help "Match permanence" char-to-perm 2)))
(gnus-score-kill-help-buffer)
(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.
(when (and (eq (1+ prefix) 77)
(eq (+ hchar 12) 109)
(eq (1- tchar) 113)
(eq (- pchar 4) 111))
(error "You rang?"))
(if mimic
(error "%c %c %c %c" prefix hchar tchar pchar)
(error "Invalid match duration"))))
;; Always kill the score help buffer.
(gnus-score-kill-help-buffer))
;; If scoring an extra (non-standard overview) header,
;; we must find out which header is in question.
(setq extra
(and gnus-extra-headers
(equal (nth 1 entry) "extra")
(intern ; need symbol
(let ((collection (mapcar #'symbol-name gnus-extra-headers)))
(gnus-completing-read
"Score extra header" ; prompt
collection ; completion list
t ; require match
nil ; no history
nil ; no initial-input
(car collection)))))) ; default value
;; extra is now nil or a symbol.
;; We have all the data, so we enter this score.
(setq match (if (string= (nth 2 entry) "") ""
(gnus-summary-header (or (nth 2 entry) (nth 1 entry))
nil extra)))
;; Modify the match, perhaps.
(cond
((equal (nth 1 entry) "xref")
(when (string-match "^Xref: *" match)
(setq match (substring match (match-end 0))))
(when (string-match "^[^:]* +" match)
(setq match (substring match (match-end 0))))))
(when (memq type '(r R regexp Regexp))
(setq match (regexp-quote match)))
;; Change score file to the "all.SCORE" file.
(when (eq symp 'a)
(with-current-buffer gnus-summary-buffer
(gnus-score-load-file
;; This is a kludge; yes...
(cond
((eq gnus-score-find-score-files-function
'gnus-score-find-hierarchical)
(gnus-score-file-name ""))
((eq gnus-score-find-score-files-function 'gnus-score-find-single)
current-score-file)
(t
(gnus-score-file-name "all"))))))
(gnus-summary-score-entry
(nth 1 entry) ; Header
match ; Match
type ; Type
(if (eq score 's) nil score) ; Score
(if (eq temporary 'perm) ; Temp
nil
temporary)
(not (nth 3 entry)) ; Prompt
nil ; not silent
extra) ; non-standard overview.
(when (eq symp 'a)
;; We change the score file back to the previous one.
(with-current-buffer gnus-summary-buffer
(gnus-score-load-file current-score-file)))))