GNU bug report logs - #70134
[PATCH] Show all date options when adding Gnus scores interactively

Previous Next

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.

Full log


View this message in rfc822 format

From: Jakub Ječmínek <kuba <at> kubajecminek.cz>
To: Eric Abrahamsen <eric <at> ericabrahamsen.net>
Cc: "70134 <at> debbugs.gnu.org" <70134 <at> debbugs.gnu.org>, Eli Zaretskii <eliz <at> gnu.org>, "larsi <at> gnus.org" <larsi <at> gnus.org>, Alex Bochannek <alex <at> bochannek.com>, Richard Stallman <rms <at> gnu.org>
Subject: bug#70134: [PATCH] Show all date options when adding Gnus scores interactively
Date: Sun, 26 May 2024 22:09:40 +0000
Jakub Ječmínek <kuba <at> kubajecminek.cz> writes:

> "Eric Abrahamsen" <eric <at> ericabrahamsen.net> writes:
>
>> Can we maybe hoist the `copy-sequence` up into the caller, to get a
>> similar effect?
>
> We can strip the text properties right before the end of
> `gnus-score-date' function.  What do you think?

Oops, forgot to attach a patch.

From 2a8081c9a7b3d6ce6842f3559d15a8f1b7872b83 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Jakub=20Je=C4=8Dm=C3=ADnek?= <kuba <at> kubajecminek.cz>
Date: Thu, 16 May 2024 21:38:01 +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 | 48 +++++++++++++++++++++--------------------
 2 files changed, 34 insertions(+), 23 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..31ce1328e37 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)))
@@ -1833,6 +1833,8 @@ gnus-score-date
 		 (gnus-score-set 'touched '(t) alist)
 		 (setcdr entries (cdr rest))
 		 (setq rest entries)))
+          (when (stringp (nth 0 kill))
+            (set-text-properties 0 1 nil (nth 0 kill)))
 	  (setq entries rest)))))
   nil)
 
-- 
2.34.1







This bug report was last modified 345 days ago.

Previous Next


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