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

classic Classic list List threaded Threaded
5 messages Options
Reply | Threaded
Open this post in threaded view
|

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

Alex Bochannek-2
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. <[hidden email]>
Reply | Threaded
Open this post in threaded view
|

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

Lars Ingebrigtsen
Alex Bochannek <[hidden email]> writes:

> 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.

Looks pretty good, but the main problem is neglecting to let-bind
variables.  byte-compiling is a good way to catch these errors:

In gnus-score-edit-file-at-point:
gnus/gnus-score.el:1190:23: Warning: assignment to free variable `move'
gnus/gnus-score.el:1190:23: Warning: reference to free variable `move'

In gnus-score-func:
gnus/gnus-score.el:1657:35: Warning: assignment to free variable `articles'
gnus/gnus-score.el:1654:36: Warning: assignment to free variable `alist'
gnus/gnus-score.el:1669:46: Warning: reference to free variable `alist'
gnus/gnus-score.el:1655:28: Warning: assignment to free variable `entries'
gnus/gnus-score.el:1655:28: Warning: reference to free variable `entries'
gnus/gnus-score.el:1670:35: Warning: reference to free variable `articles'
gnus/gnus-score.el:1667:32: Warning: assignment to free variable `art'
gnus/gnus-score.el:1659:22: Warning: reference to free variable `art'
gnus/gnus-score.el:1665:53: Warning: assignment to free variable
    `article-alist'
gnus/gnus-score.el:1665:67: Warning: assignment to free variable `score'
gnus/gnus-score.el:1665:67: Warning: reference to free variable
    `article-alist'
gnus/gnus-score.el:1666:34: Warning: reference to free variable `score'
gnus/gnus-score.el:1666:40: Warning: assignment to free variable `fn-score'
gnus/gnus-score.el:1670:44: Warning: reference to free variable `fn-score'

In end of data:
gnus/gnus-score.el:3146:1: Warning: the function `cl-pairlis' might not be
    defined at runtime.

> + (if (string-match "(.*)" rule)
> +    (setq move 0) (setq move -1))

Even if the branches here are short, we prefer to write that as

        (if (string-match "(.*)" rule)
            (setq move 0)
          (setq move -1))

Or even better:

(setq move
      (if (string-match "(.*)" rule)
          0
        -1))

             
> +    (dolist (score-fn (cdr entries))
> +      (let ((score-fn (car score-fn)))
> +    (while (setq art (pop articles))

And this could probably be a

  (dolist (art articles)


--
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no



Reply | Threaded
Open this post in threaded view
|

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

Lars Ingebrigtsen
Alex Bochannek <[hidden email]> writes:

> Please ignore the previous patch I sent that used let-forms, I found a
> bug in it. I cleaned it up some more and I am attaching a new
> patch. Thanks again for the feedback!

Thanks, applied to Emacs 28 with some minor stylistic changes.  Well,
they looked minor to me, but I didn't actually test the resulting code,
so you should probably do so.  :-)

--
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no



Reply | Threaded
Open this post in threaded view
|

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

Alex Bochannek-2
Lars Ingebrigtsen <[hidden email]> writes:

> Alex Bochannek <[hidden email]> writes:
>
>> Please ignore the previous patch I sent that used let-forms, I found a
>> bug in it. I cleaned it up some more and I am attaching a new
>> patch. Thanks again for the feedback!
>
> Thanks, applied to Emacs 28 with some minor stylistic changes.  Well,
> they looked minor to me, but I didn't actually test the resulting code,
> so you should probably do so.  :-)

Did some testing and it looks good. Is there a unit test framework I
could use for Elisp code, by the way? That could be useful for simple
utility functions that just transform some input (e.g., the patch I
suggested in #43441.)

Thanks!

--
Alex. <[hidden email]>



Reply | Threaded
Open this post in threaded view
|

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

Lars Ingebrigtsen
Alex Bochannek <[hidden email]> writes:

> Did some testing and it looks good. Is there a unit test framework I
> could use for Elisp code, by the way? That could be useful for simple
> utility functions that just transform some input (e.g., the patch I
> suggested in #43441.)

Yes, ert.  The test files are under test/lisp -- just have a peek at
them; it's pretty self-explanatory.

--
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no