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

Previous Next

To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 43413 in the body.
You can then email your comments to 43413 AT debbugs.gnu.org in the normal way.

Toggle the display of automated, internal messages from the tracker.

Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):

From: Alex Bochannek <alex <at> bochannek.com>
To: bug-gnu-emacs <at> gnu.org
Subject: 28.0.50; [PATCH] New gnus-score-func to support user-defined
 scoring functions
Date: Tue, 15 Sep 2020 00:25:02 -0700

[Message part 1 (text/plain, inline)]

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!

[gnus-score.el.diff (text/x-patch, inline)]

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)

[gnus.texi.diff (text/x-patch, inline)]

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.

[Message part 4 (text/plain, inline)]

-- 
Alex. <abochannek <at> google.com>

Message #8 received at 43413 <at> debbugs.gnu.org (full text, mbox):

From: Lars Ingebrigtsen <larsi <at> gnus.org>
To: Alex Bochannek <alex <at> bochannek.com>
Cc: 43413 <at> debbugs.gnu.org
Subject: Re: bug#43413: 28.0.50; [PATCH] New gnus-score-func to support
 user-defined scoring functions
Date: Tue, 15 Sep 2020 14:50:15 +0200

Alex Bochannek <alex <at> bochannek.com> 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

Message #11 received at 43413 <at> debbugs.gnu.org (full text, mbox):

From: Alex Bochannek <alex <at> bochannek.com>
To: Lars Ingebrigtsen <larsi <at> gnus.org>
Cc: 43413 <at> debbugs.gnu.org
Subject: Re: bug#43413: 28.0.50; [PATCH] New gnus-score-func to support
 user-defined scoring functions
Date: Wed, 16 Sep 2020 11:11:57 -0700

[Message part 1 (text/plain, inline)]

Lars Ingebrigtsen <larsi <at> gnus.org> writes:

> Alex Bochannek <alex <at> bochannek.com> 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:

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!

[Message part 2 (text/x-patch, inline)]

diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el
index ffc6b8ca34..2bc9980852 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,20 @@ 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))
-	(goto-char (point-min))
-	(re-search-forward rule nil t)
-	;; make it easy to use `kill-sexp':
-	(goto-char (1- (match-beginning 0)))))))
+	(let (move)
+	  (setq rule (if (symbolp (car rule))
+			 (format "(%S)" (car rule))
+		       (mapconcat #'(lambda (obj)
+				      (regexp-quote (format "%S" obj)))
+				  rule
+				  sep)))
+	  (goto-char (point-min))
+	  (setq move (if (string-match "(.*)" rule)
+			 0
+		       -1))
+	  (re-search-forward rule nil t)
+	  ;; make it easy to use `kill-sexp':
+	  (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 +1239,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 +1575,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 +1648,35 @@ gnus-score-orphans
 		 (not (string= id "")))
 	(gnus-score-lower-thread thread score)))))
 
+(declare-function cl-pairlis "cl-lib")
+
+(defun gnus-score-func (scores &optional trace)
+  (let (articles alist entries)
+    (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))
+	      article-alist score fn-score)
+	  (dolist (art 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
+	      (if (integerp fn-score)
+		  (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)

[Message part 3 (text/plain, inline)]

-- 
Alex. <abochannek <at> google.com>

Message #14 received at 43413 <at> debbugs.gnu.org (full text, mbox):

From: Lars Ingebrigtsen <larsi <at> gnus.org>
To: Alex Bochannek <alex <at> bochannek.com>
Cc: 43413 <at> debbugs.gnu.org
Subject: Re: bug#43413: 28.0.50; [PATCH] New gnus-score-func to support
 user-defined scoring functions
Date: Thu, 17 Sep 2020 17:03:55 +0200

Alex Bochannek <alex <at> bochannek.com> 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

Message #21 received at 43413 <at> debbugs.gnu.org (full text, mbox):

From: Alex Bochannek <alex <at> bochannek.com>
To: Lars Ingebrigtsen <larsi <at> gnus.org>
Cc: 43413 <at> debbugs.gnu.org
Subject: Re: bug#43413: 28.0.50; [PATCH] New gnus-score-func to support
 user-defined scoring functions
Date: Thu, 17 Sep 2020 10:41:28 -0700

Lars Ingebrigtsen <larsi <at> gnus.org> writes:

> Alex Bochannek <alex <at> bochannek.com> 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. <abochannek <at> google.com>

Message #24 received at 43413 <at> debbugs.gnu.org (full text, mbox):

From: Lars Ingebrigtsen <larsi <at> gnus.org>
To: Alex Bochannek <alex <at> bochannek.com>
Cc: 43413 <at> debbugs.gnu.org
Subject: Re: bug#43413: 28.0.50; [PATCH] New gnus-score-func to support
 user-defined scoring functions
Date: Thu, 17 Sep 2020 19:43:41 +0200

Alex Bochannek <alex <at> bochannek.com> 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

Message #27 received at 43413 <at> debbugs.gnu.org (full text, mbox):

From: Alex Bochannek <alex <at> bochannek.com>
To: Lars Ingebrigtsen <larsi <at> gnus.org>
Cc: 43413 <at> debbugs.gnu.org
Subject: Re: bug#43413: 28.0.50; [PATCH] New gnus-score-func to support
 user-defined scoring functions
Date: Thu, 17 Sep 2020 13:32:39 -0700

Lars Ingebrigtsen <larsi <at> gnus.org> writes:

> Alex Bochannek <alex <at> bochannek.com> 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. 

Thanks, that helps. Should have probably looked first before asking and
it's good to get an authoritative answer that this is the recommended
approach.

-- 
Alex.

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.