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

[Alex Bochannek]

Jakub,

Jakub Ječmínek <kuba@kubajecminek.cz> writes:

> Ping.
>
> Jakub Ječmínek <kuba@kubajecminek.cz> 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?= <kuba@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@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)
>

-- 
Alex.