unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
* bug#43413: 28.0.50; [PATCH] New gnus-score-func to support user-defined scoring functions
@ 2020-09-15  7:25 Alex Bochannek
  2020-09-15 12:50 ` Lars Ingebrigtsen
  0 siblings, 1 reply; 7+ messages in thread
From: Alex Bochannek @ 2020-09-15  7:25 UTC (permalink / raw)
  To: 43413

[-- Attachment #1: Type: text/plain, Size: 625 bytes --]

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!


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: New gnus-score-func to support user-defined scoring functions (code) --]
[-- Type: text/x-patch, Size: 3237 bytes --]

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)

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: New gnus-score-func to support user-defined scoring functions (doc) --]
[-- Type: text/x-patch, Size: 1514 bytes --]

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.

[-- Attachment #4: Type: text/plain, Size: 35 bytes --]


-- 
Alex. <abochannek@google.com>

^ permalink raw reply related	[flat|nested] 7+ messages in thread
end of thread, other threads:[~2020-09-17 20:32 UTC | newest]

Thread overview: 7+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2020-09-15  7:25 bug#43413: 28.0.50; [PATCH] New gnus-score-func to support user-defined scoring functions Alex Bochannek
2020-09-15 12:50 ` Lars Ingebrigtsen
2020-09-16 18:11   ` Alex Bochannek
2020-09-17 15:03     ` Lars Ingebrigtsen
2020-09-17 17:41       ` Alex Bochannek
2020-09-17 17:43         ` Lars Ingebrigtsen
2020-09-17 20:32           ` Alex Bochannek

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).