Subject: bug#70134: [PATCH] Show all date options when adding Gnus scores interactively

From: Alex Bochannek <[email-masked]>
Date: Wed, 29 May 2024 17:16:25 -0700

Jakub,

Jakub Ječmínek <[email-masked]> writes:

> Ping.
>
> Jakub Ječmínek <[email-masked]> writes:
>
>> Oops, forgot to attach a patch.

Tested it again against top-of-tree and this patch resolves the previous
issue. I think it's ready to merge!

I am curious if you think adding support of the `=' match type for the
date header makes sense? As I was testing this change, I found myself
reaching for that, but I am not entirely convinced it's actually a
useful feature. Either way, please don't hold up this change for that.

As I mentioned before, I would be happy to merge if someone points me at
instructions. In the past, eliz and larsi have merged changes I have
submitted.

>>>>From 2a8081c9a7b3d6ce6842f3559d15a8f1b7872b83 Mon Sep 17 00:00:00 2001
>> From: =?UTF-8?q?Jakub=20Je=C4=8Dm=C3=ADnek?= <[email-masked]>
>> 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 <[email-masked]>
>> ---
>>  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)
>

-- 
Alex.