Package: emacs;
Reported by: Jakub Ječmínek <kuba <at> kubajecminek.cz>
Date: Mon, 1 Apr 2024 21:45:01 UTC
Severity: normal
Tags: patch
Done: Jakub Ječmínek <kuba <at> kubajecminek.cz>
Bug is archived. No further changes may be made.
View this message in rfc822 format
From: Jakub Ječmínek <kuba <at> kubajecminek.cz> To: Alex Bochannek <alex <at> bochannek.com> Cc: Eric Abrahamsen <eric <at> ericabrahamsen.net>, "70134 <at> debbugs.gnu.org" <70134 <at> debbugs.gnu.org>, Eli Zaretskii <eliz <at> gnu.org>, "larsi <at> gnus.org" <larsi <at> gnus.org>, Richard Stallman <rms <at> gnu.org> Subject: bug#70134: [PATCH] Show all date options when adding Gnus scores interactively Date: Tue, 14 May 2024 19:57:20 +0000
"Alex Bochannek" <alex <at> bochannek.com> writes:
> I have done some more testing with a fresh build and the most recent
> patch works as Jakub intends. I would like to suggest to add a change to
> (gnus) Summary Score Commands to include the new match types. Otherwise,
> I believe this patch is good to go.
Thank you very much!
> diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
> index c5e4c885ccf..56f259db9a1 100644
> --- a/doc/misc/gnus.texi
> +++ b/doc/misc/gnus.texi
> @@ -20093,6 +20093,9 @@ Summary Score Commands
> @item date
> @table @kbd
>
> +@item r
> +Regexp matching.
> +
> @item b
> Before date.
>
> @@ -20101,6 +20104,12 @@ Summary Score Commands
>
> @item n
> This date.
> +
> +@item <
> +Less than days.
> +
> +@item >
> +Greater than days.
> @end table
>
> @item number
>
>
> --
I've applied the patch and added co-authored-by message.
From d69cf006f2e42da61714a179eb48a345a082fcf9 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Jakub=20Je=C4=8Dm=C3=ADnek?= <kuba <at> kubajecminek.cz>
Date: Thu, 9 May 2024 20:33:58 +0200
Subject: [PATCH] Show all date options when adding Gnus scores interactively
* lisp/gnus/gnus-score.el (gnus-summary-increase-score): Rename
'char-to-type' variable to 'char-to-types' and bind all legal types
for date header.
* lisp/gnus/gnus-score.el (gnus-summary-score-entry): Provide better
default values for each scoring type and cast 'match' to number only
if necessary.
Co-authored-by: Alex Bochannek <alex <at> bochannek.com>
---
doc/misc/gnus.texi | 9 ++++++++
lisp/gnus/gnus-score.el | 46 ++++++++++++++++++++---------------------
lisp/gnus/gnus-util.el | 2 +-
3 files changed, 33 insertions(+), 24 deletions(-)
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index c5e4c885ccf..56f259db9a1 100644
--- a/doc/misc/gnus.texi
+++ b/doc/misc/gnus.texi
@@ -20093,6 +20093,9 @@ Summary Score Commands
@item date
@table @kbd
+@item r
+Regexp matching.
+
@item b
Before date.
@@ -20101,6 +20104,12 @@ Summary Score Commands
@item n
This date.
+
+@item <
+Less than days.
+
+@item >
+Greater than days.
@end table
@item number
diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el
index 479b7496cf1..4e9e0083424 100644
--- a/lisp/gnus/gnus-score.el
+++ b/lisp/gnus/gnus-score.el
@@ -593,18 +593,18 @@ gnus-summary-increase-score
(?d "date" nil nil date)
(?f "followup" nil nil string)
(?t "thread" "message-id" nil string)))
- (char-to-type
+ (char-to-types
'((?s s "substring" string)
(?e e "exact string" string)
(?f f "fuzzy string" string)
- (?r r "regexp string" string)
+ (?r r "regexp string" string date)
(?z s "substring" body-string)
(?p r "regexp string" body-string)
(?b before "before date" date)
(?a after "after date" date)
(?n at "this date" date)
- (?< < "less than number" number)
- (?> > "greater than number" number)
+ (?< < "less than number" number date)
+ (?> > "greater than number" number date)
(?= = "equal to number" number)))
(current-score-file gnus-current-score-file)
(char-to-perm
@@ -652,10 +652,9 @@ gnus-summary-increase-score
(let ((legal-types
(delq nil
(mapcar (lambda (s)
- (if (eq (nth 4 entry)
- (nth 3 s))
+ (if (member (nth 4 entry) (nthcdr 3 s))
s nil))
- char-to-type))))
+ char-to-types))))
(setq header-string
(format "%s header `%s' with match type (%s?): "
(if increase "Increase" "Lower")
@@ -894,12 +893,16 @@ gnus-summary-score-entry
header
(if (< score 0) "lower" "raise"))
(cond ((numberp match) (int-to-string match))
+ ;; Provide better defaults if we're scoring on date header
((string= header "date")
- (int-to-string
- (-
- (/ (car (time-convert (current-time) 1)) 86400)
- (/ (car (time-convert (gnus-date-get-time match) 1))
- 86400))))
+ (if (or (eq type '<) (eq type '>))
+ ;; Determine the time difference in days between today
+ ;; and the article's date
+ (format-seconds "%d"
+ (time-subtract
+ (current-time)
+ (gnus-date-get-time match)))
+ (gnus-date-iso8601 match)))
(t match)))))
;; If this is an integer comparison, we transform from string to int.
@@ -909,16 +912,13 @@ gnus-summary-score-entry
(set-text-properties 0 (length match) nil match))
;; Modify match and type for article age scoring.
- (if (string= "date" (nth 0 (assoc header gnus-header-index)))
- (let ((age (string-to-number match)))
- (if (or (< age 0)
- (string= "0" match))
- (user-error "Article age must be a positive number"))
- (setq match age
- type (cond ((eq type 'after)
- '<)
- ((eq type 'before)
- '>)))))
+ (when (and (string= header "date")
+ (or (eq type '<) (eq type '>)))
+ (let ((age (string-to-number match)))
+ (if (or (< age 0)
+ (string= "0" match))
+ (user-error "Article age must be a positive number"))
+ (setq match age)))
(unless (eq date 'now)
;; Add the score entry to the score file.
@@ -1806,7 +1806,7 @@ gnus-score-date
((eq type 'at)
(setq match-func 'string=
match (gnus-date-iso8601 (nth 0 kill))))
- ((eq type 'regexp)
+ ((or (eq type 'regexp) (eq type 'r))
(setq match-func 'string-match
match (nth 0 kill)))
(t (error "Invalid match type: %s" type)))
diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el
index 0b0a9bbfc1d..6097f517be0 100644
--- a/lisp/gnus/gnus-util.el
+++ b/lisp/gnus/gnus-util.el
@@ -377,7 +377,7 @@ gnus-date-get-time
"Convert DATE string to Emacs time.
Cache the result as a text property stored in DATE."
;; Either return the cached value...
- `(let ((d ,date))
+ `(let ((d (copy-sequence ,date)))
(if (equal "" d)
0
(or (get-text-property 0 'gnus-time d)
--
2.34.1
Best
--
Kuba Ječmínek (http://kubajecminek.cz)
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.