Function: gnus-summary-score-entry

gnus-summary-score-entry is a byte-compiled function defined in gnus-score.el.gz.

Signature

(gnus-summary-score-entry HEADER MATCH TYPE SCORE DATE &optional PROMPT SILENT EXTRA)

Documentation

Enter score file entry.

HEADER is the header being scored. MATCH is the string we are looking for. TYPE is the match type: substring, regexp, exact, fuzzy. SCORE is the score to add. DATE is the expire date, or nil for no expire, or now for immediate expire. If optional argument PROMPT is non-nil, allow user to edit match. If optional argument SILENT is nil, show effect of score entry. If optional argument EXTRA is non-nil, it's a non-standard overview header.

Source Code

;; Defined in /usr/src/emacs/lisp/gnus/gnus-score.el.gz
(defun gnus-summary-score-entry (header match type score date
					&optional prompt silent extra)
  "Enter score file entry.
HEADER is the header being scored.
MATCH is the string we are looking for.
TYPE is the match type: substring, regexp, exact, fuzzy.
SCORE is the score to add.
DATE is the expire date, or nil for no expire, or `now' for immediate expire.
If optional argument `PROMPT' is non-nil, allow user to edit match.
If optional argument `SILENT' is nil, show effect of score entry.
If optional argument `EXTRA' is non-nil, it's a non-standard overview header."
  ;; Regexp is the default type.
  (when (eq type t)
    (setq type 'r))
  ;; Simplify matches...
  (cond ((or (eq type 'r) (eq type 's) (eq type nil))
	 (setq match (if match (gnus-simplify-subject-re match) "")))
	((eq type 'f)
	 (setq match (gnus-simplify-subject-fuzzy match))))
  (let ((score (gnus-score-delta-default score))
	(header (downcase header))
	new)
    (set-text-properties 0 (length header) nil header)
    (when prompt
      (setq match (read-string
		   (format "Match %s on %s, %s: "
			   (cond ((eq date 'now)
				  "now")
				 ((stringp date)
				  "temp")
				 (t "permanent"))
			   header
			   (if (< score 0) "lower" "raise"))
		   (if (numberp match)
		       (int-to-string match)
		     match))))

    ;; If this is an integer comparison, we transform from string to int.
    (if (eq (nth 2 (assoc header gnus-header-index)) 'gnus-score-integer)
	(if (stringp match)
	    (setq match (string-to-number match)))
      (set-text-properties 0 (length match) nil match))

    ;; Modify match and type for article age scoring.
    (if (string= "date" (nth 0 (assoc header gnus-header-index)))
	(let ((age (string-to-number match)))
	  (if (or (< age 0)
		  (string= "0" match))
	      (user-error "Article age must be a positive number"))
	  (setq match age
		type (cond ((eq type 'after)
			    '<)
			   ((eq type 'before)
			    '>)))))

    (unless (eq date 'now)
      ;; Add the score entry to the score file.
      (when (= score gnus-score-interactive-default-score)
	(setq score nil))
      (let ((old (gnus-score-get header))
	    elem)
	(setq new
	      (cond
	       (extra
		(list match score
		      (and date (if (numberp date) date
				  (date-to-day date)))
		      type (symbol-name extra)))
	       (type
		(list match score
		      (and date (if (numberp date) date
				  (date-to-day date)))
		      type))
	       (date (list match score (date-to-day date)))
	       (score (list match score))
	       (t (list match))))
	;; We see whether we can collapse some score entries.
	;; This isn't quite correct, because there may be more elements
	;; later on with the same key that have matching elems...  Hm.
	(if (and old
		 (setq elem (assoc match old))
		 (eq (nth 3 elem) (nth 3 new))
		 (or (and (numberp (nth 2 elem)) (numberp (nth 2 new)))
		     (and (not (nth 2 elem)) (not (nth 2 new)))))
	    ;; Yup, we just add this new score to the old elem.
	    (setcar (cdr elem) (+ (or (nth 1 elem)
				      gnus-score-interactive-default-score)
				  (or (nth 1 new)
				      gnus-score-interactive-default-score)))
	  ;; Nope, we have to add a new elem.
	  (gnus-score-set header (if old (cons new old) (list new)) nil t))
	(gnus-score-set 'touched '(t))))

    ;; Score the current buffer.
    (unless silent
      (if (and (>= (nth 1 (assoc header gnus-header-index)) 0)
	       (eq (nth 2 (assoc header gnus-header-index))
		   'gnus-score-string))
	  (gnus-summary-score-effect header match type score extra)
	(gnus-summary-rescore)))

    ;; Return the new scoring rule.
    new))