mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-27 07:37:33 +00:00
Code Issues Releases Activity

* lisp/mpc.el (mpc--proc-filter): Don't signal mpc-proc-error since signals

Browse Source 
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
This commit is contained in:
Stefan Monnier 2011-08-23 21:55:10 -04:00
parent 93b6b5e15d
commit 963b492b63
3 changed files with 33 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
lisp/ChangeLog
View File

@ -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):

39
lisp/mpc.el
View File

@ -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.

3
src/process.c
View File

@ -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))),