* 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 fe3d15f67c327c6c93856396585ad5b18029bb08..85253feacc54be5023423946496416231de8b337 100644 (file)
--- 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 5319ea43898133acfe297d50c88d1e567a4a16da..932fb5926fd0c02d999cb38c63c42446a0d9854c 100644 (file)
--- 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 2125478907f5badddbd85426723dc3e0f207112c..977cfb964e214054ebd963b04d19626506e2fef7 100644 (file)
--- 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))),