From: Alex Bochannek <alex@bochannek.com>
Date: Tue, 8 Sep 2020 09:47:28 +0000 (+0200)
Subject: Introduce a new Gnus scoring method (for article age)
X-Git-Tag: emacs-28.0.90~6188
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=2630bbbcdf4a775d826c18c3209e7adb7a726ef6;p=emacs.git

Introduce a new Gnus scoring method (for article age)

* doc/misc/gnus.texi (Score File Format): Document it.

* lisp/gnus/gnus-score.el (gnus-score-check-syntax): Add support
for the new date methods < and > (bug#43270).
(gnus-score-date): Allow scoring on dates by age.
---

diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index 789b1dea52a..60441669d82 100644
--- a/doc/misc/gnus.texi
+++ b/doc/misc/gnus.texi
@@ -20347,6 +20347,24 @@ this will match articles that were posted when it was April 1st where
 the article was posted from.  Time zones are such wholesome fun for the
 whole family, eh?)
 
+Finally, two actually useful match types for dates: @code{<} and
+@code{>}.  These will allow scoring on the relative age (in days) of
+the articles.  Here's an example score file using the method:
+
+@example
+(("date"
+  (7 10 nil <)
+  (7 -10 nil >)
+  (14 -10 nil >)))
+@end example
+
+This results in articles less than a week old getting a 10 point
+increase, articles older than a week getting a 10 point decrease, and
+articles older than two weeks getting a cumulative 20 point decrease.
+
+The day can also be a floating point number: To score articles less
+than an hour old, you can say @samp{(0.04 10 nil <)}.
+
 @item Head, Body, All
 These three match keys use the same match types as the @code{From} (etc.)@:
 header uses.
diff --git a/etc/NEWS b/etc/NEWS
index 09f7da49532..407e1c41983 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -321,6 +321,11 @@ tags to be considered as well.
 
 ** Gnus
 
++++
+*** New scoring types for the Date header.
+You can now score based on the relative age of an article with the new
+'<' and '>' date scoring types.
+
 +++
 *** New backend 'nnselect'.
 The newly added 'nnselect' backend allows creating groups from an
diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el
index 46b70eaf275..c5156a195a3 100644
--- a/lisp/gnus/gnus-score.el
+++ b/lisp/gnus/gnus-score.el
@@ -1370,9 +1370,12 @@ If FORMAT, also format the current score file."
 	       (setq
 		err
 		(cond
-		 ((if (member (downcase type) '("lines" "chars"))
-		      (not (numberp (car s)))
-		    (not (stringp (car s))))
+		 ((cond ((member (downcase type) '("lines" "chars"))
+			 (not (numberp (car s))))
+			((string= (downcase type) "date")
+			 (not (or (numberp (car s))
+				  (stringp (car s)))))
+			(t (not (stringp (car s)))))
 		  (format "Invalid match %s in %s" (car s) file))
 		 ((and (cadr s) (not (integerp (cadr s))))
 		  (format "Non-integer score %s in %s" (cadr s) file))
@@ -1690,9 +1693,19 @@ score in `gnus-newsgroup-scored' by SCORE."
 	   ((eq type 'after)
 	    (setq match-func 'string<
 		  match (gnus-date-iso8601 (nth 0 kill))))
+	   ((eq type '<)
+	    (setq type 'after
+		  match-func 'gnus-string>
+		  match (gnus-time-iso8601
+			 (time-add (current-time) (* 86400 (nth 0 kill))))))
 	   ((eq type 'before)
 	    (setq match-func 'gnus-string>
 		  match (gnus-date-iso8601 (nth 0 kill))))
+	   ((eq type '>)
+	    (setq type 'before
+		  match-func 'gnus-string>
+		  match (gnus-time-iso8601
+			 (time-add (current-time) (* -86400 (nth 0 kill))))))
 	   ((eq type 'at)
 	    (setq match-func 'string=
 		  match (gnus-date-iso8601 (nth 0 kill))))