Commit 963b492b authored by Stefan Monnier's avatar Stefan Monnier

* 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
parent 93b6b5e1
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> 2011-08-23 Stefan Monnier <monnier@iro.umontreal.ca>
* emacs-lisp/eieio.el (eieio-defmethod, eieio-defgeneric): * emacs-lisp/eieio.el (eieio-defmethod, eieio-defgeneric):
......
...@@ -246,11 +246,12 @@ and HOST defaults to localhost." ...@@ -246,11 +246,12 @@ and HOST defaults to localhost."
(process-put proc 'ready t) (process-put proc 'ready t)
(unless (eq (match-end 0) (point-max)) (unless (eq (match-end 0) (point-max))
(error "Unexpected trailing text")) (error "Unexpected trailing text"))
(let ((error (match-string 1))) (let ((error-text (match-string 1)))
(delete-region (point) (point-max)) (delete-region (point) (point-max))
(let ((callback (process-get proc 'callback))) (let ((callback (process-get proc 'callback)))
(process-put proc 'callback nil) (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))))))))) (funcall callback)))))))))
(defun mpc--proc-connect (host) (defun mpc--proc-connect (host)
...@@ -314,19 +315,23 @@ and HOST defaults to localhost." ...@@ -314,19 +315,23 @@ and HOST defaults to localhost."
mpc-proc) mpc-proc)
(setq mpc-proc (mpc--proc-connect mpc-host)))) (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) (defun mpc-proc-sync (&optional proc)
"Wait for MPC process until it is idle again. "Wait for MPC process until it is idle again.
Return the buffer in which the process is/was running." Return the buffer in which the process is/was running."
(unless proc (setq proc (mpc-proc))) (unless proc (setq proc (mpc-proc)))
(unwind-protect (unwind-protect
(condition-case err (progn
(progn (while (and (not (process-get proc 'ready))
(while (and (not (process-get proc 'ready)) (accept-process-output proc)))
(accept-process-output proc))) (mpc-proc-check proc)
(if (process-get proc 'ready) (process-buffer proc) (if (process-get proc 'ready) (process-buffer proc)
;; (delete-process proc) (error "No response from MPD")))
(error "No response from MPD")))
(error (message "MPC: %s" err) (signal (car err) (cdr err))))
(unless (process-get proc 'ready) (unless (process-get proc 'ready)
;; (debug) ;; (debug)
(message "Killing hung process") (message "Killing hung process")
...@@ -358,13 +363,13 @@ which will be concatenated with proper quoting before passing them to MPD." ...@@ -358,13 +363,13 @@ which will be concatenated with proper quoting before passing them to MPD."
"\n"))) "\n")))
(if callback (if callback
;; (let ((buf (current-buffer))) ;; (let ((buf (current-buffer)))
(process-put proc 'callback (process-put proc 'callback
callback callback
;; (lambda () ;; (lambda ()
;; (funcall callback ;; (funcall callback
;; (prog1 (current-buffer) ;; (prog1 (current-buffer)
;; (set-buffer buf))))) ;; (set-buffer buf)))))
) )
;; If `callback' is nil, we're executing synchronously. ;; If `callback' is nil, we're executing synchronously.
(process-put proc 'callback 'ignore) (process-put proc 'callback 'ignore)
;; This returns the process's buffer. ;; This returns the process's buffer.
......
...@@ -5186,6 +5186,9 @@ read_process_output (Lisp_Object proc, register int channel) ...@@ -5186,6 +5186,9 @@ read_process_output (Lisp_Object proc, register int channel)
p->decoding_carryover = coding->carryover_bytes; p->decoding_carryover = coding->carryover_bytes;
} }
if (SBYTES (text) > 0) 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, internal_condition_case_1 (read_process_output_call,
Fcons (outstream, Fcons (outstream,
Fcons (proc, Fcons (text, Qnil))), Fcons (proc, Fcons (text, Qnil))),
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment