bug#43413: 28.0.50; [PATCH] New gnus-score-func to support user-defined scoring functions

[Alex Bochannek]

Hello!

As I was modifying gnus-score.el, it occurred to me that a way to
specify user-defined scoring functions could be useful in cases where
even advanced scoring isn't sufficient. I put together some code and
documentation for that.

Although it's only ~40 lines of Elisp and ~30 lines of Texinfo, I am
pretty sure it's the largest code change I have submitted to Emacs and I
would not be surprised if I violated some coding standards. I have spent
a fair amount of time with testing, but cannot rule out corner cases, of
course. Let me know if you want me to make any improvements before
accepting this patch.

Thanks!

diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el
index ffc6b8ca34..b1b9082d9f 100644
--- a/lisp/gnus/gnus-score.el
+++ b/lisp/gnus/gnus-score.el
@@ -497,6 +497,7 @@ gnus-header-index
     ("head" -1 gnus-score-body)
     ("body" -1 gnus-score-body)
     ("all" -1 gnus-score-body)
+    (score-fn -1 nil)
     ("followup" 2 gnus-score-followup)
     ("thread" 5 gnus-score-thread)))
 
@@ -1175,14 +1176,18 @@ gnus-score-edit-file-at-point
       (when format
        (gnus-score-pretty-print))
       (when (consp rule) ;; the rule exists
-       (setq rule (mapconcat #'(lambda (obj)
-                                 (regexp-quote (format "%S" obj)))
-                             rule
-                             sep))
+       (setq rule (if (symbolp (car rule))
+                      (format "(%S)" (car rule))
+                    (mapconcat #'(lambda (obj)
+                                   (regexp-quote (format "%S" obj)))
+                               rule
+                               sep)))
        (goto-char (point-min))
+       (if (string-match "(.*)" rule)
+           (setq move 0) (setq move -1))
        (re-search-forward rule nil t)
        ;; make it easy to use `kill-sexp':
-       (goto-char (1- (match-beginning 0)))))))
+       (goto-char (+ move (match-beginning 0)))))))
 
 (defun gnus-score-load-file (file)
   ;; Load score file FILE.  Returns a list a retrieved score-alists.
@@ -1232,6 +1237,7 @@ gnus-score-load-file
     (let ((mark (car (gnus-score-get 'mark alist)))
          (expunge (car (gnus-score-get 'expunge alist)))
          (mark-and-expunge (car (gnus-score-get 'mark-and-expunge alist)))
+         (score-fn (car (gnus-score-get 'score-fn alist)))
          (files (gnus-score-get 'files alist))
          (exclude-files (gnus-score-get 'exclude-files alist))
          (orphan (car (gnus-score-get 'orphan alist)))
@@ -1567,10 +1573,14 @@ gnus-score-headers
                            (gnus-message
                             7 "Scoring on headers or body skipped.")
                            nil)
+                       ;; Run score-fn
+                       (if (eq header 'score-fn)
+                           (setq new (gnus-score-func scores trace))
                        ;; Call the scoring function for this type of "header".
                        (setq new (funcall (nth 2 entry) scores header
-                                          now expire trace)))
+                                          now expire trace))))
                  (push new news))))
+
            (when (gnus-buffer-live-p gnus-summary-buffer)
              (let ((scored gnus-newsgroup-scored))
                (with-current-buffer gnus-summary-buffer
@@ -1636,6 +1646,30 @@ gnus-score-orphans
                 (not (string= id "")))
        (gnus-score-lower-thread thread score)))))
 
+(defun gnus-score-func (scores &optional trace)
+  (while scores
+    (setq articles gnus-scores-articles
+         alist (car scores)
+         scores (cdr scores)
+         entries (assoc 'score-fn alist))
+    (dolist (score-fn (cdr entries))
+      (let ((score-fn (car score-fn)))
+           (while (setq art (pop articles))
+             (setq article-alist
+                   (cl-pairlis
+                    '(number subject from date id
+                             refs chars lines xref extra)
+                    (car art))
+                   score (cdr art))
+             (if (integerp (setq fn-score (funcall score-fn
+                                                   article-alist score)))
+                 (setcdr art (+ score fn-score)))
+             (setq score (cdr art))
+             (when trace
+               (push (cons (car-safe (rassq alist gnus-score-cache))
+                           (list score-fn fn-score))
+                     gnus-score-trace)))))))
+
 (defun gnus-score-integer (scores header now expire &optional trace)
   (let ((gnus-score-index (nth 1 (assoc header gnus-header-index)))
        entries alist)

diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index 50eeb3efa3..c9f7491d5b 100644
--- a/doc/misc/gnus.texi
+++ b/doc/misc/gnus.texi
@@ -20394,6 +20394,36 @@ Score File Format
 @end enumerate
 
 @cindex score file atoms
+@item score-fn
+The value of this entry should be one or more user-defined function
+names in parentheses. Each function will be called in order and the
+returned value is required to be an integer.
+
+@example
+        (score-fn (custom-scoring))
+@end example
+
+The user-defined function is called with an associative list with the
+keys @code{number subject from date id refs chars lines xref extra}
+followed by the article's score before the function is run.
+
+The following (somewhat contrived) example shows how to use a
+user-defined function that increases an article's score by 10 if the
+year of the article's date is also mentioned in its subject.
+
+@example
+        (defun custom-scoring (article-alist score)
+          (let ((subject (cdr (assoc 'subject article-alist)))
+                (date (cdr (assoc 'date article-alist))))
+            (if (string-match (number-to-string
+                               (nth 5 (parse-time-string date)))
+                              subject)
+                10)))
+@end example
+
+@code{score-fn} entries are permanent and can only be added or
+modified directly in the @code{SCORE} file.
+
 @item mark
 The value of this entry should be a number.  Any articles with a score
 lower than this number will be marked as read.

-- 
Alex. <abochannek@google.com>