From: Stefan Monnier <monnier@iro.umontreal.ca>
Date: Wed, 24 Aug 2011 01:55:10 +0000 (-0400)
Subject: * lisp/mpc.el (mpc--proc-filter): Don't signal mpc-proc-error since signals
X-Git-Url: https://git.hcoop.net/bpt/emacs.git/commitdiff_plain/963b492b635cd33a6a5dd46119208a378e3e6378

* lisp/mpc.el (mpc--proc-filter): Don't signal mpc-proc-error since signals
from process filters aren't reliably transmitted to the surrounding
accept-process-output.
(mpc-proc-check): New function.
(mpc-proc-sync): Use it

Fixes: debbugs:8293
---

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index fe3d15f67c..85253feacc 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,11 @@
+2011-08-24  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+	* mpc.el (mpc--proc-filter): Don't signal mpc-proc-error since signals
+	from process filters aren't reliably transmitted to the surrounding
+	accept-process-output.
+	(mpc-proc-check): New function.
+	(mpc-proc-sync): Use it (bug#8293)
+
 2011-08-23  Stefan Monnier  <monnier@iro.umontreal.ca>
 
 	* emacs-lisp/eieio.el (eieio-defmethod, eieio-defgeneric):
diff --git a/lisp/mpc.el b/lisp/mpc.el
index 5319ea4389..932fb5926f 100644
--- a/lisp/mpc.el
+++ b/lisp/mpc.el
@@ -246,11 +246,12 @@ and HOST defaults to localhost."
             (process-put proc 'ready t)
             (unless (eq (match-end 0) (point-max))
               (error "Unexpected trailing text"))
-            (let ((error (match-string 1)))
+            (let ((error-text (match-string 1)))
               (delete-region (point) (point-max))
               (let ((callback (process-get proc 'callback)))
                 (process-put proc 'callback nil)
-                (if error (signal 'mpc-proc-error error))
+                (if error-text
+                    (process-put proc 'mpc-proc-error error-text))
                 (funcall callback)))))))))
 
 (defun mpc--proc-connect (host)
@@ -314,19 +315,23 @@ and HOST defaults to localhost."
            mpc-proc)
       (setq mpc-proc (mpc--proc-connect mpc-host))))
 
+(defun mpc-proc-check (proc)
+  (let ((error-text (process-get proc 'mpc-proc-error)))
+    (when error-text
+      (process-put proc 'mpc-proc-error nil)
+      (signal 'mpc-proc-error error-text))))
+
 (defun mpc-proc-sync (&optional proc)
   "Wait for MPC process until it is idle again.
 Return the buffer in which the process is/was running."
   (unless proc (setq proc (mpc-proc)))
   (unwind-protect
-      (condition-case err
-          (progn
-            (while (and (not (process-get proc 'ready))
-                        (accept-process-output proc)))
-            (if (process-get proc 'ready) (process-buffer proc)
-              ;; (delete-process proc)
-              (error "No response from MPD")))
-        (error (message "MPC: %s" err) (signal (car err) (cdr err))))
+      (progn
+        (while (and (not (process-get proc 'ready))
+                    (accept-process-output proc)))
+        (mpc-proc-check proc)
+        (if (process-get proc 'ready) (process-buffer proc)
+          (error "No response from MPD")))
     (unless (process-get proc 'ready)
       ;; (debug)
       (message "Killing hung process")
@@ -358,13 +363,13 @@ which will be concatenated with proper quoting before passing them to MPD."
                       "\n")))
       (if callback
           ;; (let ((buf (current-buffer)))
-            (process-put proc 'callback
-                         callback
-                         ;; (lambda ()
-                         ;;   (funcall callback
-                         ;;            (prog1 (current-buffer)
-                         ;;              (set-buffer buf)))))
-                         )
+          (process-put proc 'callback
+                       callback
+                       ;; (lambda ()
+                       ;;   (funcall callback
+                       ;;            (prog1 (current-buffer)
+                       ;;              (set-buffer buf)))))
+                       )
         ;; If `callback' is nil, we're executing synchronously.
         (process-put proc 'callback 'ignore)
         ;; This returns the process's buffer.
diff --git a/src/process.c b/src/process.c
index 2125478907..977cfb964e 100644
--- a/src/process.c
+++ b/src/process.c
@@ -5186,6 +5186,9 @@ read_process_output (Lisp_Object proc, register int channel)
 	  p->decoding_carryover = coding->carryover_bytes;
 	}
       if (SBYTES (text) > 0)
+	/* FIXME: It's wrong to wrap or not based on debug-on-error, and
+	   sometimes it's simply wrong to wrap (e.g. when called from
+	   accept-process-output).  */
 	internal_condition_case_1 (read_process_output_call,
 				   Fcons (outstream,
 					  Fcons (proc, Fcons (text, Qnil))),