[Emacs-diffs] /srv/bzr/emacs/trunk r105548: * lisp/mpc.el (mpc--proc-filter): Don't signal mpc-proc-error since signals

[Stefan Monnier]

------------------------------------------------------------
revno: 105548
fixes bug(s): http://debbugs.gnu.org/cgi/bugreport.cgi?bug=8293
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Tue 2011-08-23 21:55:10 -0400
message:
  * 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
modified:
  lisp/ChangeLog
  lisp/mpc.el
  src/process.c

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2011-08-23 18:53:51 +0000
+++ b/lisp/ChangeLog    2011-08-24 01:55:10 +0000
@@ -1,3 +1,11 @@
+2011-08-24  Stefan Monnier  <address@hidden>
+
+       * 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  <address@hidden>
 
        * emacs-lisp/eieio.el (eieio-defmethod, eieio-defgeneric):

=== modified file 'lisp/mpc.el'
--- a/lisp/mpc.el       2011-06-02 11:24:12 +0000
+++ b/lisp/mpc.el       2011-08-24 01:55:10 +0000
@@ -246,11 +246,12 @@
             (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 @@
            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 @@
                       "\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.

=== modified file 'src/process.c'
--- a/src/process.c     2011-08-18 15:33:22 +0000
+++ b/src/process.c     2011-08-24 01:55:10 +0000
@@ -5186,6 +5186,9 @@
          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))),