extensions to nnmail-split-fancy

extensions to nnmail-split-fancy

[Mark Eichin]

I wanted to be able to do a split of the form:
	(any "debian-\\(\\w*\\)@lists.debian.org" "mail.debian.\\1")

[actually I use X-Mailing-List, so I seperate out personals and list
copies, but that's not important here.]  I've kludged something
together, but thought I'd ask for improvements and suggestsions on how
to do it "right"...

The kludge part: it *only* handles \1, I'm not sure if there's a
generic interface to that kind of substitution that works on strings
instead of buffers.  Also, it "knows" that this is really match-string
3, with 1=the header line, 2=the whole pattern (from the ^\(\) wrapping)
so 3 is anything extra. 

It would seem that a *much* more general extension would be to allow
arbitrary functions in a split, but lacking functionp it would need to
use something like eq car lambda/function/byte-foo and that wouldn't
be fun.  (Or perhaps just grab another special character, like & | are
now, and have it mean eval? hmm.)  But that wouldn't make the above
that much easier, just possible...
					_Mark_ <eichin@cygnus.com>
					Cygnus Support, Eastern USA

ps. the nnmail-split-it below is from 5.2.39, where I last stopped
keeping up :-)

(defun mwegnus-subst-1 (str repl1)
  (let (
	(strind (string-match "\\\\1$" str))
	)
    (if strind (concat (substring str 0 strind) repl1)
      str)))

(defun nnmail-split-it (split)
  ;; Return a list of groups matching SPLIT.
  (cond ((stringp split)
	 ;; A group.
	 (list split))
	((eq (car split) '&)
	 (apply 'nconc (mapcar 'nnmail-split-it (cdr split))))
	((eq (car split) '|)
	 (let (done)
	   (while (and (not done) (cdr split))
	     (setq split (cdr split)
		   done (nnmail-split-it (car split))))
	   done))
	((assq split nnmail-split-cache)
	 ;; A compiled match expression.
	 (goto-char (point-max))
	 (if (re-search-backward (cdr (assq split nnmail-split-cache)) nil t)
	     (nnmail-split-it ;; change 1
	      (if (stringp (nth 2 split))
		  (mwegnus-subst-1 (nth 2 split) (match-string 3))
		(nth 2 split)))))
	(t
	 ;; An uncompiled match.
	 (let* ((field (nth 0 split))
		(value (nth 1 split))
		(result (nth 2 split)) ;; change 2a
		(regexp (concat "^\\(" 
				(if (symbolp field)
				    (cdr (assq field 
					       nnmail-split-abbrev-alist))
				  field)
				"\\):.*\\<\\("
				(if (symbolp value)
				    (cdr (assq value
					       nnmail-split-abbrev-alist))
				  value)
				"\\)\\>")))
	   (setq nnmail-split-cache
		 (cons (cons split regexp) nnmail-split-cache))
	   (goto-char (point-max))
	   (if (re-search-backward regexp nil t)
	       (nnmail-split-it ;; change 2b
		(if (stringp result)
		    (mwegnus-subst-1 result (match-string 3))
		  result)
		))))))

Re: extensions to nnmail-split-fancy

[David Moore]

Mark Eichin <eichin@cygnus.com> writes:

> I wanted to be able to do a split of the form:
> 	(any "debian-\\(\\w*\\)@lists.debian.org" "mail.debian.\\1")

> It would seem that a *much* more general extension would be to allow
> arbitrary functions in a split, but lacking functionp it would need to
> use something like eq car lambda/function/byte-foo and that wouldn't
> be fun.  (Or perhaps just grab another special character, like & | are
> now, and have it mean eval? hmm.)  But that wouldn't make the above
> that much easier, just possible...

	The following replacement for nnmail-split-it provides both
arbitrary \N and \& substitutions, as well as supporting calling a
function.  For calling a function, I introduced a new special split
character ':'.

	Note that using \N subs might not always give you the most
desired result.  If someone mails to both "debian-foo" and "debian-bar",
the message will only be posted to one of them.  Namely the match which
comes latest in the message headers.  Getting it to crosspost to all of
the appropriate groups is a bit more work, and is likely to be much
slower.


;;; dmoore@ucsd.edu 5.11.1996
;;; Change nnmail-split-it to support splits of the form:
;;; (any "debian-\(\\w*\\)@lists.debian.org" "mail.debian.\\1")
;;; Also add a new split type :, which specifies a function to
;;; be called to compute the group name:
;;; (: func arg1 arg2 ...)
;;; func is called in a buffer with the message headers, with the
;;; specified arguments.  The function should return nil for no match,
;;; or another split to operate on (this split could just be a group
;;; name string, for example).

(defun nnmail-split-it (split)
  ;; Return a list of groups matching SPLIT.
  (cond
   ;; nil split
   ((null split)
    nil)

   ;; A group name.  Do the \& and \N subs into the string.
   ((stringp split)
    (list (nnmail-expand-newtext split)))

   ;; Junk the message.
   ((eq split 'junk)
    (list 'junk))

   ;; Builtin & operation.
   ((eq (car split) '&)
    (apply 'nconc (mapcar 'nnmail-split-it (cdr split))))

   ;; Builtin | operation.
   ((eq (car split) '|)
    (let (done)
      (while (and (not done) (cdr split))
	(setq split (cdr split)
	      done (nnmail-split-it (car split))))
      done))

   ;; Builtin : operation.
   ((eq (car split) ':)
    (nnmail-split-it (eval (cdr split))))

   ;; Check the cache for the regexp for this split.
   ;; FIX FIX FIX could avoid calling assq twice here
   ((assq split nnmail-split-cache)
    (goto-char (point-max))
    ;; FIX FIX FIX problem with re-search-backward is that if you have
    ;; a split: (from "foo-\\(bar\\|baz\\)@gnus.org "mail.foo.\\1")
    ;; and someone mails a message with 'To: foo-bar@gnus.org' and
    ;; 'CC: foo-baz@gnus.org', we'll pick 'mail.foo.baz' as the group
    ;; if the cc line is a later header, even though the other choice
    ;; is probably better.  Also, this routine won't do a crosspost
    ;; when there are two different matches.
    ;; I guess you could just make this more determined, and it could
    ;; look for still more matches prior to this one, and recurse
    ;; on each of the multiple matches hit.  Of course, then you'd
    ;; want to make sure that nnmail-article-group or nnmail-split-fancy
    ;; removed duplicates, since there might be more of those.
    ;; I guess we could also remove duplicates in the & split case, since
    ;; that's the only thing that can introduce them.
    (when (re-search-backward (cdr (assq split nnmail-split-cache)) nil t)
      ;; Someone might want to do a \N sub on this match, so get the
      ;; correct match positions.
      (goto-char (match-end 0))
      (re-search-backward (nth 1 split) (match-end 1))
      (nnmail-split-it (nth 2 split))))

   ;; Not in cache, compute a regexp for the field/value pair.
   (t
    (let* ((field (nth 0 split))
	   (value (nth 1 split))
	   ;; note this regexp changed from rgnus-0.53
	   (regexp (concat "^\\(\\("
			   (if (symbolp field)
			       (cdr (assq field nnmail-split-abbrev-alist))
			     field)
			   "\\):.*\\)\\<\\("
			   (if (symbolp value)
			       (cdr (assq value nnmail-split-abbrev-alist))
			     value)
			   "\\)\\>")))
      (push (cons split regexp) nnmail-split-cache)
      ;; now that it's in the cache, just call nnmail-split-it again
      ;; on the same split, which will find it immediately in the cache.
      (nnmail-split-it split)))
   ))


;;; based on bbdb-auto-expand-newtext, except for getting the
;;; text from the current buffer, not a string.
;;; FIX FIX FIX, this could be sped up, if it ends up being slow
(defun nnmail-expand-newtext (newtext)
  (let ((pos 0)
	(len (length newtext))
	(expanded-newtext ""))
    (while (< pos len)
      (setq expanded-newtext
	    (concat expanded-newtext
		    (let ((c (aref newtext pos)))
		      (if (= ?\\ c)
			  (cond ((= ?\& (setq c (aref newtext
						      (setq pos (1+ pos)))))
				 (buffer-substring (match-beginning 0)
						   (match-end 0)))
				((and (>= c ?1) 
				      (<= c ?9))
				 ;; return empty string if N'th
				 ;; sub-regexp did not match:
				 (let ((n (- c ?0)))
				   (if (match-beginning n)
				       (buffer-substring (match-beginning n)
							 (match-end n))
				     "")))
				(t (char-to-string c)))
			(char-to-string c)))))
      (setq pos (1+ pos)))
    expanded-newtext))

-- 
David Moore <dmoore@ucsd.edu>       | Computer Systems Lab      __o
UCSD Dept. Computer Science - 0114  | Work: (619) 534-8604    _ \<,_
La Jolla, CA 92093-0114             | Fax:  (619) 534-1445   (_)/ (_)
<URL:http://oj.egbt.org/dmoore/>    | Solo Furnace Creek 508 -- 1996!

Re: extensions to nnmail-split-fancy

[Mark Eichin]

excellent, that is *much* improved.  as for posting to only one:
debian lists are in particular fed through qmail, so you get an
X-mailing-list header for each copy, which is why I was matching on
that first... though I agree, that wouldn't help in the more common
case.

Still, with the : extension it's a lot easier to experiment with that
sort of thing (since if I recall correctly, the eval can return a
list, and the message will go to multiple places...)  In the mean
time, this makes things a lot easier for me :-)