🚀 go-pugleaf

Julian Bradfield <jcb@inf.ed.ac.uk> writes:
> On 2010-01-05, blueman <NOSPAM@nospam.com> wrote:
>> Well, that was the whole reason that Robert *added* the command
>> vm-pipe-messages-to-command (where the 's' is plural) ... You keep
>> talking about this command as if it is yet to exist...
>
> Oh dear. I owe you an apology.
Appreciated but not necessary. 
>
> Yes, I didn't notice the the "s". That's because it doesn't exist in
> my VM (where almost nothing Rob added is included, except a few known
> safe bits from rfaddons, so when I looked for it, auto-completion of
> course gave me vm-pipe-message-to-command and my brain failed to
> observe the inconsistency.
Makes sense - though as an FYI, it has been in vm-save.el since 8.0 or so.
>

> However, looking at that function, I see that Rob has already
> anticipated your need: you can simply set
>
> (setq vm-pipe-messages-to-command-start
>       "From Bogus From Line to Satisfy sa-learn\n")
> or however much it needs to look like a real From line to satisfy 
> sa-learn.
>

That is helpful and would work in most cases (though sa-learn might
even benefit from a real 'From' line since it might be able to learn
from spoofed From_ vs. From:)

But more generally for those cases where you want to preserve the
original separators intact, I would propose the following simple
extension which doesn't change any existing functionality and which
would be consistent with the existing notation and common emacs/vm usage:

1. First add additional options to the underlying vm-pipe-message-part routine
   (you will see the logic of this and the number sequencing later)

(defun vm-pipe-message-part (m arg)
  "Return (START END) bounds for piping to external command, based on ARG."
  (cond ((equal prefix-arg '(4))
	 (list (vm-text-of m) (vm-text-end-of m)))
	((equal prefix-arg '(16))
	 (list (vm-headers-of m) (vm-text-of m)))
	((equal prefix-arg '(64))
	 (list (vm-vheaders-of m) (vm-text-end-of m)))
+	((equal prefix-arg '(256)) ; Same as '(4)' plus message end separator
+	 (list (vm-text-of m) (vm-end-of m)))
+	((equal prefix-arg '(1024)) ; Same as '(16)' plus message start separator
+	 (list (vm-start-of m) (vm-text-of m)))
+	((equal prefix-arg '(4096)) ; Same as '(64)' plus start & end separators
+	 (list (vm-start-of m) (vm-end-of m)))
	(t 
	 (list (vm-headers-of m) (vm-text-end-of m)))))

2. Now add the following explanation to the definition of
   vm-pipe-messages-to-command-start:

(defvar vm-pipe-messages-to-command-start ""
-  "*Inserted by `vm-pipe-messages-to-command' before a message.")
+  "*Inserted by `vm-pipe-messages-to-command' before a message.
+If set to 't', then vm-pipe-mesages-to-command includes the original message separators instead (and also ignores vm-pipe-message-to-command-end)"

3. Now make the following simple change to vm-pipe-messages-to-command
so that when the above variable is set to 't':
  - The prefix arg is multiplied by 256 [or set to 4096 if not an element of 
    (4 16 64)]
  - Insertions for the variable vm-pipe-message-to-command-start/end are 
    ignored. 

The result is that when the variable is set to 't' then 'vm-start-of' 
replaces 'vm-headers-of' and 'vm-end-of' replaces 'vm-text-end-of'


Note I am also including a critical bugfix (that I posted
over the weekend) where the macro variable ,no-wait wasn't quoted

(defun vm-pipe-messages-to-command (command &optional prefix-arg 
					    discard-output no-wait)
  "Run a shell command with contents from messages as input.

Similar to `vm-pipe-message-to-command', but it will call process
just once and pipe all messages to it.  For bulk operations this
is much faster than calling the command on each message.  This is
more like saving to a pipe.

Before a message it will insert `vm-pipe-messages-to-command-start'
and after a message `vm-pipe-messages-to-command-end'.

Output, if any, is displayed unless DISCARD-OUTPUT is t.

If NO-WAIT is t, then do not wait for process to finish, if it is
a function then call it with the COMMAND and OUTPUT-BUFFER as
arguments after the command finished."
  (interactive
   ;; protect value of last-command
   (let ((last-command last-command)
	 (this-command this-command))
     (vm-follow-summary-cursor)
     (vm-select-folder-buffer)
+	 ((vm-pipe-messages-to-command-start vm-pipe-messages-to-command-start))
+	 ((vm-pipe-messages-to-command-end vm-pipe-messages-to-command-end))
     (list (read-string "Pipe to command: " vm-last-pipe-command)
	   current-prefix-arg)))
+    (when (equal vm-pipe-messages-to-command-start t) ; Include original separators
+	  (if (member prefix-arg '(4 16 64))
+		  (setq prefix-arg (* prefix-arg 64))
+		  (setq prefix-arg 4096))
+	  (setq vm-pipe-messages-to-command-start "")
+	  (setq vm-pipe-messages-to-command-end ""))
  (vm-select-folder-buffer)
  (vm-check-for-killed-summary)
  (vm-error-if-folder-empty)
  (setq vm-last-pipe-command command)
  (let ((buffer (get-buffer-create "*Shell Command Output*"))
	(pop-up-windows (and pop-up-windows (eq vm-mutable-windows t)))
	;; prefix arg doesn't have "normal" meaning here, so only call
	;; vm-select-marked-or-prefixed-messages if we're using marks.
	(mlist (if (eq last-command 'vm-next-command-uses-marks)
		   (vm-select-marked-or-prefixed-messages 0)
		 (list (car vm-message-pointer))))
	m process)
    (save-excursion
      (set-buffer buffer)
      (erase-buffer))
    (setq process (start-process command buffer 
				 (or shell-file-name "sh")
				 shell-command-switch command))
    (set-process-sentinel 
     process 
     `(lambda (process status) 
	(setq status (process-status process))
	(if (eq 'exit status)
	    (if ,no-wait
		(vm-pipe-command-exit-handler 
		 process ,command ,discard-output 
		 (if (and ,no-wait (functionp ,no-wait))
-		     no-wait)))
+		     ,no-wait)))
	  (message "Command '%s' changed state to %s."
		   ,command status))))
    (while mlist
      (setq m (vm-real-message-of (car mlist)))
      (set-buffer (vm-buffer-of m))
	  (process-send-string process vm-pipe-messages-to-command-start)
      (save-restriction
	(widen)
	(let ((region (vm-pipe-message-part m prefix-arg)))
	  (process-send-region process (nth 0 region) (nth 1 region))))
	  (process-send-string process vm-pipe-messages-to-command-end)
      (setq mlist (cdr mlist)))

    (process-send-eof process)

    (when (not no-wait) 
      (while (and (eq 'run (process-status process)))
	(accept-process-output process)
	(sit-for 0))
      (vm-pipe-command-exit-handler process command discard-output))
    buffer))