🚀 go-pugleaf

RetroBBS NetNews Server

Inspired by RockSolid Light RIP Retro Guy

Article View: gnu.emacs.vm.bug
Article #224

Re: Suggested fix to vm-pipe-message-part

#224
From: blueman
Date: Tue, 05 Jan 2010 23:50
118 lines
5961 bytes
Here is an alternative approach - that I think is better and more robust...

1. First change the definition string for the 
   vm-pipe-messages-to-command-start/end as follows:

(defvar vm-pipe-messages-to-command-start ""
  "*Inserted by `vm-pipe-messages-to-command' before a message.
If set to 't', then use the actual start message separator.")

(defvar vm-pipe-messages-to-command-end "\n"
  "*Inserted by `vm-pipe-messages-to-command' after a message.
If set to 't', then use the actual end message separator.")


2. Add these inline functions to vm-message.el

;;Start message separator
(defsubst vm-start-separator-of (message)
  (list (vm-start-of message)
		(vm-headers-of message))

;;End message separator
(defsubst vm-end-separator-of (message)
  (list (vm-text-end-of message)
		(vm-end-of message)))


3. Change vm-pipe-messages-to-command to either use the "global" 
   vm-pipe-messages-to-command-start/end variable (as is currently the
   case) or the per message separators depending on whether set to 't'
   or not

;;;###autoload
(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)
     (list (read-string "Pipe to command: " vm-last-pipe-command)
	   current-prefix-arg)))
  (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)))
	  (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)
+	(if (equal vm-pipe-messages-to-command-start t)
+		  (apply 'process-send-region process (vm-start-separator-of m))
+		  (process-send-string process vm-pipe-messages-to-command-start))
-	(let ((region (vm-pipe-message-part m prefix-arg)))
-	  (process-send-region process (nth 0 region) (nth 1 region)))
+   (apply 'process-send-region process (vm-pipe-message-part m prefix-arg))
+   (if (equal vm-pipe-messages-to-command-end t)
+		  (apply 'process-send-region process (vm-end-separator-of m))
+		  (process-send-string process vm-pipe-messages-to-command-end)))
-      (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))


NOTE: I haven't tested the above code and there may be syntax
errors... but I will test if people agree that this is the right approach...
Technical Details
Message-ID: <m2pr5o3ycq.fsf@consult.pretender>
Path: arc1-ca.pugleaf.net!g2news1.google.com!news2.google.com!goblin1!goblin.stu.neva.ru!feeder.eternal-september.org!eternal-september.org!.POSTED!not-for-mail
References: <m2d41p7sho.fsf@consult.pretender> <hht5o0$9pd$1@scotsman.ed.ac.uk> <m23a2l7myy.fsf@consult.pretender> <hhti24$9ua$1@scotsman.ed.ac.uk> <m2tyv15eaz.fsf@consult.pretender> <hhv7u9$bf4$1@scotsman.ed.ac.uk> <m2iqbg5zjg.fsf@consult.pretender> <hi0018$1gk$1@north.jnrs.ja.net> <m21vi45kxy.fsf@consult.pretender> <hi0e67$5b2$1@north.jnrs.ja.net> <m2tyv03yq9.fsf@consult.pretender>

Show Full Headers
Complete Article Headers
X-Google-Thread: a16957f451,747cd7667796b3e3
X-Google-Attributes: gida16957f451,public,usenet
X-Google-NewGroupId: yes
X-Google-Language: ENGLISH,ASCII-7-bit
Path: arc1-ca.pugleaf.net!g2news1.google.com!news2.google.com!goblin1!goblin.stu.neva.ru!feeder.eternal-september.org!eternal-september.org!.POSTED!not-for-mail
From: blueman <NOSPAM@nospam.com>
Newsgroups: gnu.emacs.vm.bug
Subject: Re: Suggested fix to vm-pipe-message-part
Date: Tue, 05 Jan 2010 18:50:45 -0500
Organization: A noiseless patient Spider
Lines: 118
Message-ID: <m2pr5o3ycq.fsf@consult.pretender>
References: <m2d41p7sho.fsf@consult.pretender>
 <hht5o0$9pd$1@scotsman.ed.ac.uk> <m23a2l7myy.fsf@consult.pretender>
 <hhti24$9ua$1@scotsman.ed.ac.uk> <m2tyv15eaz.fsf@consult.pretender>
 <hhv7u9$bf4$1@scotsman.ed.ac.uk> <m2iqbg5zjg.fsf@consult.pretender>
 <hi0018$1gk$1@north.jnrs.ja.net> <m21vi45kxy.fsf@consult.pretender>
 <hi0e67$5b2$1@north.jnrs.ja.net> <m2tyv03yq9.fsf@consult.pretender>
Mime-Version: 1.0
Content-Type: text/plain; charset=us-ascii
Injection-Date: Tue, 5 Jan 2010 23:50:45 +0000 (UTC)
Injection-Info: feeder.eternal-september.org; posting-host="o0xooYC/dlyFpPxuXQpbEw";
 logging-data="28462"; mail-complaints-to="abuse@eternal-september.org"; posting-account="U2FsdGVkX197IqXFBsgoA6Osvx61lqumAN6z1nmsyJM="
User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/23.1 (gnu/linux)
Cancel-Lock: sha1:RQoN/PP5zZz4vlv9PHYshk1PF74=
 sha1:96mYLEDCI8Mwo5Hr5+tWVrLkbXU=