From mboxrd@z Thu Jan 1 00:00:00 1970 X-Msuck: nntp://news.gmane.io/gmane.emacs.gnus.general/18251 Path: main.gmane.org!not-for-mail From: Karl Kleinpaste Newsgroups: gmane.emacs.gnus.general Subject: Re: new NOV stuff in p0.40 Date: 28 Oct 1998 00:51:53 -500 Sender: owner-ding@hpc.uh.edu Message-ID: References: NNTP-Posting-Host: coloc-standby.netfonds.no X-Trace: main.gmane.org 1035156807 5165 80.91.224.250 (20 Oct 2002 23:33:27 GMT) X-Complaints-To: usenet@main.gmane.org NNTP-Posting-Date: Sun, 20 Oct 2002 23:33:27 +0000 (UTC) Keywords: extra headers,keywords,scoring Return-Path: Original-Received: from fisher.math.uh.edu (fisher.math.uh.edu [129.7.128.35]) by sclp3.sclp.com (8.8.5/8.8.5) with ESMTP id AAA19369 for ; Wed, 28 Oct 1998 00:53:16 -0500 (EST) Original-Received: from sina.hpc.uh.edu (lists@Sina.HPC.UH.EDU [129.7.3.5]) by fisher.math.uh.edu (8.9.1/8.9.1) with ESMTP id XAB16591; Tue, 27 Oct 1998 23:52:58 -0600 (CST) Original-Received: by sina.hpc.uh.edu (TLB v0.09a (1.20 tibbs 1996/10/09 22:03:07)); Tue, 27 Oct 1998 23:52:44 -0600 (CST) Original-Received: from sclp3.sclp.com (root@sclp3.sclp.com [209.195.19.139]) by sina.hpc.uh.edu (8.7.3/8.7.3) with ESMTP id XAA26837 for ; Tue, 27 Oct 1998 23:52:26 -0600 (CST) Original-Received: from pocari-sweat.jprc.com (POCARI-SWEAT.JPRC.COM [207.86.147.217]) by sclp3.sclp.com (8.8.5/8.8.5) with ESMTP id AAA19359 for ; Wed, 28 Oct 1998 00:52:24 -0500 (EST) Original-Received: (from karl@localhost) by pocari-sweat.jprc.com (8.8.7/8.8.7) id AAA24420; Wed, 28 Oct 1998 00:51:53 -0500 Original-To: ding@gnus.org X-Face: "5(T0tZd{6}pd~YzBG8O/*EW,.]6]@`m^e;fv65W^Y&=d"M\1H}>T~4_.kcDD.O~y3k)a6h R;Nmi>9|>Nm${2IpM0^RcUEa\jcq?KOP)C&~x51l~zCHTulL^_T|u0I^kB'z@]{`2YjQu In-Reply-To: Lars Magne Ingebrigtsen's message of "26 Oct 1998 03:48:55 +0100" Original-Lines: 412 User-Agent: Gnus/5.07004 (Pterodactyl Gnus v0.40) XEmacs/20.4 (Emerald) Precedence: list X-Majordomo: 1.94.jlt7 Xref: main.gmane.org gmane.emacs.gnus.general:18251 X-Report-Spam: http://spam.gmane.org/gmane.emacs.gnus.general:18251 Karl Kleinpaste 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 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.