* 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
* bug#43413: 28.0.50; [PATCH] New gnus-score-func to support user-defined scoring functions
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
0 siblings, 1 reply; 7+ messages in thread
From: Lars Ingebrigtsen @ 2020-09-15 12:50 UTC (permalink / raw)
To: Alex Bochannek; +Cc: 43413
Alex Bochannek <alex@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
^ permalink raw reply [flat|nested] 7+ messages in thread
* bug#43413: 28.0.50; [PATCH] New gnus-score-func to support user-defined scoring functions
2020-09-15 12:50 ` Lars Ingebrigtsen
@ 2020-09-16 18:11 ` Alex Bochannek
2020-09-17 15:03 ` Lars Ingebrigtsen
0 siblings, 1 reply; 7+ messages in thread
From: Alex Bochannek @ 2020-09-16 18:11 UTC (permalink / raw)
To: Lars Ingebrigtsen; +Cc: 43413
[-- Attachment #1: Type: text/plain, Size: 796 bytes --]
Lars Ingebrigtsen <larsi@gnus.org> writes:
> Alex Bochannek <alex@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!
[-- 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: 3479 bytes --]
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)
[-- Attachment #3: Type: text/plain, Size: 35 bytes --]
--
Alex. <abochannek@google.com>
^ permalink raw reply related [flat|nested] 7+ messages in thread
* bug#43413: 28.0.50; [PATCH] New gnus-score-func to support user-defined scoring functions
2020-09-16 18:11 ` Alex Bochannek
@ 2020-09-17 15:03 ` Lars Ingebrigtsen
2020-09-17 17:41 ` Alex Bochannek
0 siblings, 1 reply; 7+ messages in thread
From: Lars Ingebrigtsen @ 2020-09-17 15:03 UTC (permalink / raw)
To: Alex Bochannek; +Cc: 43413
Alex Bochannek <alex@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
^ permalink raw reply [flat|nested] 7+ messages in thread
* bug#43413: 28.0.50; [PATCH] New gnus-score-func to support user-defined scoring functions
2020-09-17 15:03 ` Lars Ingebrigtsen
@ 2020-09-17 17:41 ` Alex Bochannek
2020-09-17 17:43 ` Lars Ingebrigtsen
0 siblings, 1 reply; 7+ messages in thread
From: Alex Bochannek @ 2020-09-17 17:41 UTC (permalink / raw)
To: Lars Ingebrigtsen; +Cc: 43413
Lars Ingebrigtsen <larsi@gnus.org> writes:
> Alex Bochannek <alex@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@google.com>
^ permalink raw reply [flat|nested] 7+ messages in thread
* bug#43413: 28.0.50; [PATCH] New gnus-score-func to support user-defined scoring functions
2020-09-17 17:41 ` Alex Bochannek
@ 2020-09-17 17:43 ` Lars Ingebrigtsen
2020-09-17 20:32 ` Alex Bochannek
0 siblings, 1 reply; 7+ messages in thread
From: Lars Ingebrigtsen @ 2020-09-17 17:43 UTC (permalink / raw)
To: Alex Bochannek; +Cc: 43413
Alex Bochannek <alex@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
^ permalink raw reply [flat|nested] 7+ messages in thread
* bug#43413: 28.0.50; [PATCH] New gnus-score-func to support user-defined scoring functions
2020-09-17 17:43 ` Lars Ingebrigtsen
@ 2020-09-17 20:32 ` Alex Bochannek
0 siblings, 0 replies; 7+ messages in thread
From: Alex Bochannek @ 2020-09-17 20:32 UTC (permalink / raw)
To: Lars Ingebrigtsen; +Cc: 43413
Lars Ingebrigtsen <larsi@gnus.org> writes:
> Alex Bochannek <alex@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.
^ permalink raw reply [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).