Re: new NOV stuff in p0.40

[Karl Kleinpaste <karl@jprc.com>]

Karl Kleinpaste <karl@jprc.com> writes:
>> Since you consider this easy :-), I believe I'll wait a day or three
>> to see if you come up with something; if not, I'll see if I can get my
>> elisp karma worked up to produce something sensible.

Lars Magne Ingebrigtsen <larsi@gnus.org> writes:
> I think I'll leave it to you.  :-)

Well, you asked for it.

Here's a pile of updated code for p0.40.  Even though you recommended
against it, I thought I could get away with using gnus-score-string
directly, and I think I nearly succeeded. :-)  Unfortunately, there
may be a couple of sacrifices that were made in the attempt.

What's in the patch below:

1. Minor additions to tables in gnus-{cus,sum}.el.
2. A serious bugfix to gnus-nov-parse-extra in gnus-sum.el; this is
probably the bug you noticed a few evenings ago, and the fix is pretty 
obvious; I'd be surprised if it varies at all from what you now have.
3. Lots o' stuff (most of the patch) in gnus-score.el:
- Additions to doc strings & tables.
- Querying user for what extra header to score.
- Passing an extra arg to gnus-summary-score-entry and
  gnus-summary-score-effect.
- Hacking out a specific extra header in gnus-summary-header.
- Handling extra cases in gnus-score-string because the extras aren't
  a string.  There is dark evil here.  I really didn't know what I was 
  getting into until I got to this point and found myself facing what
  appeared to me to be a backward-ordered matching structure; this is
  probably the big argument in favor of not having used
  gnus-score-string in the 1st place...but frankly, I was too far in
  to let it go, because by then I'd slaughtered my working 0.40 tree
  and had to make it work before I could let myself get some sleep. :-)

I'm posting this to the list in the hopes that some folks out there
will be interested in taking a look (and perhaps telling me how
foolish I was for not taking that original suggestion to create
gnus-score-extra rather than retrofitting gnus-score-string the way
I've done here -- my elisp karma is not as strong as perhaps it ought
to be).

What these changes produce is scorefile behavior which uses elements
containing a 5th field, e.g.,
	(("extra"
	  ("gnus" nil nil s "Keywords")))
There is an add'l query during e.g. `I e s p' in which Gnus now asks
what header it is that you want scored.  This does a completing read
against the symbols in gnus-extra-headers, on the theory that you
probably should be concerned only with scoring extra headers of which
you have awareness anyhow.

Please give it a try.  I'm wide open to critique, addition, change, or
utter rewrite.

In a day or so, I'll send a module I've been using for a couple years 
to auto-generate Keywords within Gnus at posting time, too, so that
people who can score on Keywords have something useful to chew on.

--karl

--- gnus-cus.el.orig	Thu Sep 24 14:32:01 1998
+++ gnus-cus.el	Tue Oct 27 16:53:41 1998
@@ -581,12 +581,13 @@
 			 `(checklist :inline t
 				     :greedy t
 				     (gnus-score-string :tag "From")
 				     (gnus-score-string :tag "Subject")
 				     (gnus-score-string :tag "References")
 				     (gnus-score-string :tag "Xref")
+				     (gnus-score-string :tag "Extra")
 				     (gnus-score-string :tag "Message-ID")
 				     (gnus-score-integer :tag "Lines")
 				     (gnus-score-integer :tag "Chars")
 				     (gnus-score-date :tag "Date")
 				     (gnus-score-string :tag "Head"
 							:doc "\
--- gnus-sum.el.orig	Sun Oct 25 17:13:17 1998
+++ gnus-sum.el	Tue Oct 27 18:18:45 1998
@@ -1818,12 +1818,13 @@
       nil
     (let ((headers '(("author" "from" string)
 		     ("subject" "subject" string)
 		     ("article body" "body" string)
 		     ("article head" "head" string)
 		     ("xref" "xref" string)
+		     ("extra header" "extra" string)
 		     ("lines" "lines" number)
 		     ("followups to author" "followup" string)))
 	  (types '((number ("less than" <)
 			   ("greater than" >)
 			   ("equal" =))
 		   (string ("substring" s)
@@ -3125,14 +3126,14 @@
   '(buffer-substring (point) (if (gnus-nov-skip-field) (1- (point)) eol)))
 
 (defmacro gnus-nov-parse-extra ()
   '(let (out string)
      (while (not (memq (char-after) '(?\n nil)))
        (setq string (gnus-nov-field))
-       (when (string-match "^\\([^ :]\\): " string)
-	 (push (cons (intern (match-string 1))
+       (when (string-match "^\\([^ :]+\\): " string)
+	 (push (cons (intern (match-string 1 string))
 		     (substring string (match-end 0)))
 	       out)))
      out))
 
 ;; This function has to be called with point after the article number
 ;; on the beginning of the line.
--- gnus-score.el.orig	Sat Oct 10 20:32:03 1998
+++ gnus-score.el	Wed Oct 28 00:36:26 1998
@@ -305,12 +305,13 @@
  s: subject
  b: body
  h: head
  i: message-id
  t: references
  x: xref
+ e: `extra' (non-standard overview)
  l: lines
  d: date
  f: followup
 
 If nil, the user will be asked for a header."
   :group 'gnus-score-default
@@ -318,12 +319,13 @@
 		 (const :tag "subject" s)
 		 (const :tag "body" b)
 		 (const :tag "head" h)
 		 (const :tag "message-id" i)
 		 (const :tag "references" t)
 		 (const :tag "xref" x)
+		 (const :tag "extra" e)
 		 (const :tag "lines" l)
 		 (const :tag "date" d)
 		 (const :tag "followup" f)
 		 (const :tag "ask" nil)))
 
 (defcustom gnus-score-default-type nil
@@ -441,12 +443,13 @@
     ("date" 3 gnus-score-date)
     ("message-id" 4 gnus-score-string)
     ("references" 5 gnus-score-string)
     ("chars" 6 gnus-score-integer)
     ("lines" 7 gnus-score-integer)
     ("xref" 8 gnus-score-string)
+    ("extra" 9 gnus-score-string)
     ("head" -1 gnus-score-body)
     ("body" -1 gnus-score-body)
     ("all" -1 gnus-score-body)
     ("followup" 2 gnus-score-followup)
     ("thread" 5 gnus-score-thread)))
 
@@ -499,12 +502,13 @@
 	    (?s "subject" nil nil string)
 	    (?b "body" "" nil body-string)
 	    (?h "head" "" nil body-string)
 	    (?i "message-id" nil t string)
 	    (?r "references" "message-id" nil string)
 	    (?x "xref" nil nil string)
+	    (?e "extra" nil nil string)
 	    (?l "lines" nil nil number)
 	    (?d "date" nil nil date)
 	    (?f "followup" nil nil string)
 	    (?t "thread" "message-id" nil string)))
 	 (char-to-type
 	  '((?s s "substring" string)
@@ -527,13 +531,13 @@
 	 (hchar (and gnus-score-default-header
 		     (aref (symbol-name gnus-score-default-header) 0)))
 	 (tchar (and gnus-score-default-type
 		     (aref (symbol-name gnus-score-default-type) 0)))
 	 (pchar (and gnus-score-default-duration
 		     (aref (symbol-name gnus-score-default-duration) 0)))
-	 entry temporary type match)
+	 entry temporary type match extra)
 
     (unwind-protect
 	(progn
 
 	  ;; First we read the header to score.
 	  (while (not hchar)
@@ -619,15 +623,32 @@
 	    (if mimic
 		(error "%c %c %c %c" prefix hchar tchar pchar)
 	      (error "Illegal match duration"))))
       ;; Always kill the score help buffer.
       (gnus-score-kill-help-buffer))
 
+    ;; If scoring an extra (non-standard overview) header,
+    ;; we must find out which header is in question.
+    (setq extra
+	  (and gnus-extra-headers
+	       (equal (nth 1 entry) "extra")
+	       (intern					; need symbol
+		(gnus-completing-read
+		 (symbol-name (car gnus-extra-headers))	; default response
+		 "Score extra header:"			; prompt
+		 (mapcar (lambda (x)			; completion list
+			   (cons (symbol-name x) x))
+			 gnus-extra-headers)
+		 nil					; no completion limit
+		 t))))					; require match
+    ;; extra is now nil or a symbol.
+
     ;; We have all the data, so we enter this score.
     (setq match (if (string= (nth 2 entry) "") ""
-		  (gnus-summary-header (or (nth 2 entry) (nth 1 entry)))))
+		  (gnus-summary-header (or (nth 2 entry) (nth 1 entry))
+				       nil extra)))
 
     ;; Modify the match, perhaps.
     (cond
      ((equal (nth 1 entry) "xref")
       (when (string-match "^Xref: *" match)
 	(setq match (substring match (match-end 0))))
@@ -657,13 +678,15 @@
      match				; Match
      type				; Type
      (if (eq score 's) nil score)	; Score
      (if (eq temporary 'perm)		; Temp
 	 nil
        temporary)
-     (not (nth 3 entry)))		; Prompt
+     (not (nth 3 entry))		; Prompt
+     nil				; not silent 
+     extra)				; non-standard overview.
 
     (when (eq symp 'a)
       ;; We change the score file back to the previous one.
       (save-excursion
 	(set-buffer gnus-summary-buffer)
 	(gnus-score-load-file current-score-file)))))
@@ -706,20 +729,22 @@
     (split-window)
     (pop-to-buffer "*Score Help*")
     (let ((window-min-height 1))
       (shrink-window-if-larger-than-buffer))
     (select-window (get-buffer-window gnus-summary-buffer))))
 
-(defun gnus-summary-header (header &optional no-err)
+(defun gnus-summary-header (header &optional no-err extra)
   ;; Return HEADER for current articles, or error.
   (let ((article (gnus-summary-article-number))
 	headers)
     (if article
 	(if (and (setq headers (gnus-summary-article-header article))
 		 (vectorp headers))
-	    (aref headers (nth 1 (assoc header gnus-header-index)))
+	    (if extra			; `header' must be "extra"
+		(or (cdr (assq extra (mail-header-extra headers))) "")
+	      (aref headers (nth 1 (assoc header gnus-header-index))))
 	  (if no-err
 	      nil
 	    (error "Pseudo-articles can't be scored")))
       (if no-err
 	  (error "No article on current line")
 	nil))))
@@ -739,22 +764,23 @@
   (cdr (assoc symbol
 	      (or alist
 		  gnus-score-alist
 		  (gnus-newsgroup-score-alist)))))
 
 (defun gnus-summary-score-entry (header match type score date
-					&optional prompt silent)
+					&optional prompt silent extra)
   (interactive)
   "Enter score file entry.
 HEADER is the header being scored.
 MATCH is the string we are looking for.
 TYPE is the match type: substring, regexp, exact, fuzzy.
 SCORE is the score to add.
 DATE is the expire date, or nil for no expire, or 'now for immediate expire.
 If optional argument `PROMPT' is non-nil, allow user to edit match.
-If optional argument `SILENT' is nil, show effect of score entry."
+If optional argument `SILENT' is nil, show effect of score entry.
+If optional argument `EXTRA' is non-nil, it's a non-standard overview header."
   ;; Regexp is the default type.
   (when (eq type t)
     (setq type 'r))
   ;; Simplify matches...
   (cond ((or (eq type 'r) (eq type 's) (eq type nil))
 	 (setq match (if match (gnus-simplify-subject-re match) "")))
@@ -789,12 +815,17 @@
       (when (= score gnus-score-interactive-default-score)
 	(setq score nil))
       (let ((old (gnus-score-get header))
 	    elem)
 	(setq new
 	      (cond
+	       (extra
+		(list match score
+		      (and date (if (numberp date) date
+				  (date-to-day date)))
+		      type (symbol-name extra)))
 	       (type
 		(list match score
 		      (and date (if (numberp date) date
 				  (date-to-day date)))
 		      type))
 	       (date (list match score (date-to-day date)))
@@ -819,24 +850,25 @@
 
     ;; Score the current buffer.
     (unless silent
       (if (and (>= (nth 1 (assoc header gnus-header-index)) 0)
 	       (eq (nth 2 (assoc header gnus-header-index))
 		   'gnus-score-string))
-	  (gnus-summary-score-effect header match type score)
+	  (gnus-summary-score-effect header match type score extra)
 	(gnus-summary-rescore)))
 
     ;; Return the new scoring rule.
     new))
 
-(defun gnus-summary-score-effect (header match type score)
+(defun gnus-summary-score-effect (header match type score extra)
   "Simulate the effect of a score file entry.
 HEADER is the header being scored.
 MATCH is the string we are looking for.
 TYPE is the score type.
-SCORE is the score to add."
+SCORE is the score to add.
+EXTRA is the possible non-standard header."
   (interactive (list (completing-read "Header: "
 				      gnus-header-index
 				      (lambda (x) (fboundp (nth 2 x)))
 				      t)
 		     (read-string "Match: ")
 		     (y-or-n-p "Use regexp match? ")
@@ -851,13 +883,13 @@
 			 match)
 			((eq type 'e)
 			 (concat "\\`" (regexp-quote match) "\\'"))
 			(t
 			 (regexp-quote match)))))
       (while (not (eobp))
-	(let ((content (gnus-summary-header header 'noerr))
+	(let ((content (gnus-summary-header header 'noerr extra))
 	      (case-fold-search t))
 	  (and content
 	       (when (if (eq type 'f)
 			 (string-equal (gnus-simplify-subject-fuzzy content)
 				       regexp)
 		       (string-match regexp content))
@@ -1863,18 +1895,29 @@
     ;; Sorting the articles costs os O(N*log N) but will allow us to
     ;; only match with each unique header.  Thus the actual matching
     ;; will be O(M*U) where M is the number of strings to match with,
     ;; and U is the number of unique headers.  It is assumed (but
     ;; untested) this will be a net win because of the large constant
     ;; factor involved with string matching.
-    (setq gnus-scores-articles (sort gnus-scores-articles 'gnus-score-string<)
+    (setq gnus-scores-articles
+	  ;; We cannot string-sort the extra headers list.  *sigh*
+	  (if (= gnus-score-index 9)
+	      gnus-scores-articles
+	    (sort gnus-scores-articles 'gnus-score-string<))
 	  articles gnus-scores-articles)
 
     (erase-buffer)
     (while (setq art (pop articles))
       (setq this (aref (car art) gnus-score-index))
+
+      ;; If we're working with non-standard headers, we are stuck
+      ;; with working on them as a group.  What a hassle.
+      ;; Just wait 'til you see what horrors we commit against `match'...
+      (if (= gnus-score-index 9)
+	  (setq this (prin1-to-string this)))	; ick.
+
       (if simplify
 	  (setq this (gnus-map-function gnus-simplify-subject-functions this)))
       (if (equal last this)
 	  ;; O(N*H) cons-cells used here, where H is the number of
 	  ;; headers.
 	  (push art alike)
@@ -1899,12 +1942,13 @@
 	    entries (assoc header alist))
       (while (cdr entries)		;First entry is the header index.
 	(let* ((kill (cadr entries))
 	       (type (or (nth 3 kill) 's))
 	       (score (or (nth 1 kill) gnus-score-interactive-default-score))
 	       (date (nth 2 kill))
+	       (extra (nth 4 kill))	; non-standard header; string.
 	       (found nil)
 	       (mt (aref (symbol-name type) 0))
 	       (case-fold-search (not (memq mt '(?R ?S ?E ?F))))
 	       (dmt (downcase mt))
 					; Assume user already simplified regexp and fuzzies
 	       (match (if (and simplify (not (memq dmt '(?f ?r))))
@@ -1914,12 +1958,18 @@
                         (nth 0 kill)))
 	       (search-func
 		(cond ((= dmt ?r) 're-search-forward)
 		      ((or (= dmt ?e) (= dmt ?s) (= dmt ?f)) 'search-forward)
 		      ((= dmt ?w) nil)
 		      (t (error "Illegal match type: %s" type)))))
+
+	  ;; Evil hackery to make match usable in non-standard headers.
+	  (when extra
+	    (setq match (concat "[ (](" extra " \\. \".*" match ".*\")[ )]")
+		  search-func 're-search-forward))	; XXX danger?!?
+
 	  (cond
 	   ;; Fuzzy matches.  We save these for later.
 	   ((= dmt ?f)
 	    (push (cons entries alist) fuzzies)
 	    (setq entries (cdr entries)))
 	   ;; Word matches.  Save these for even later.