aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier <[email protected]>2011-08-23 21:55:10 -0400
committerStefan Monnier <[email protected]>2011-08-23 21:55:10 -0400
commit963b492b635cd33a6a5dd46119208a378e3e6378 (patch)
tree3b30cd705b80039a1cb81ee7dd60c64b45894160
parent93b6b5e15dd860ed4c8928475349fc92a0299b43 (diff)
* 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
-rw-r--r--lisp/ChangeLog8
-rw-r--r--lisp/mpc.el39
-rw-r--r--src/process.c3
3 files changed, 33 insertions, 17 deletions
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 <[email protected]>
+
+ * 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 <[email protected]>
* 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))),