Mercurial > hg > xemacs-beta
changeset 5738:f6af091ac654
Use new language features in #'call-process-internal now they're available.
lisp/ChangeLog addition:
2013-06-17 Aidan Kehoe <kehoea@parhasard.net>
* process.el (process-synchronize-point): Moved to a label.
* process.el (call-process-internal):
Now we have better language features, use them rather than
creating a closure ourselves or exposing a utility function when
there is no need for that with a well-implemented labels function.
author | Aidan Kehoe <kehoea@parhasard.net> |
---|---|
date | Mon, 17 Jun 2013 20:37:47 +0100 |
parents | 165315eae1ab |
children | a2912073be85 f9e4d44504a4 |
files | lisp/ChangeLog lisp/process.el |
diffstat | 2 files changed, 49 insertions(+), 43 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/ChangeLog Mon Jun 17 19:54:02 2013 +0100 +++ b/lisp/ChangeLog Mon Jun 17 20:37:47 2013 +0100 @@ -1,3 +1,11 @@ +2013-06-17 Aidan Kehoe <kehoea@parhasard.net> + + * process.el (process-synchronize-point): Moved to a label. + * process.el (call-process-internal): + Now we have better language features, use them rather than + creating a closure ourselves or exposing a utility function when + there is no need for that with a well-implemented labels function. + 2013-06-17 Aidan Kehoe <kehoea@parhasard.net> * cl-macs.el:
--- a/lisp/process.el Mon Jun 17 19:54:02 2013 +0100 +++ b/lisp/process.el Mon Jun 17 20:37:47 2013 +0100 @@ -109,29 +109,6 @@ shell-command-switch (mapconcat 'identity (cons command args) " "))) -(defun process-synchronize-point (proc) - "Set the point(s) in buffer and stderr-buffer according to the process mark." - ;; We need this because the documentation says to insert *BEFORE* point, - ;; but we end up inserting after because only the process mark moves - ;; forward, not point. We synchronize after every place output might - ;; happen, in sentinels, and in an unwind-protect, to make *SURE* that - ;; point is correct. (We could do this more easily and perhaps more - ;; safely using a process filter, but that would create a LOT of garbage - ;; since all the data would get sent in strings.) We make this a separate - ;; function, not an flet, due to dynamic binding problems -- the flet may - ;; not still be in scope when the sentinel is called. - (let ((pb (process-buffer proc)) - (pm (process-mark proc))) - (if (and pb (buffer-live-p pb) (marker-buffer pm)) - (goto-char pm pb)) - (if (process-has-separate-stderr-p proc) - (let ((pseb (process-stderr-buffer proc)) - (psem (process-stderr-mark proc))) - (if (and pseb (not (eq pb pseb)) - (buffer-live-p pseb) - (marker-buffer psem)) - (goto-char psem pseb)))))) - (defun call-process-internal (program &optional infile buffer display &rest args) "Internal function to call PROGRAM synchronously in separate process. @@ -179,7 +156,33 @@ ;; note that we need to be *very* careful in this code to handle C-g ;; at any point. (unwind-protect - (progn + (labels + ((process-synchronize-point (proc) + ;; Set the point(s) in buffer and stderr-buffer according to + ;; the process mark. + ;; + ;; We need this because the documentation says to insert + ;; *BEFORE* point, but we end up inserting after because only + ;; the process mark moves forward, not point. We synchronize + ;; after every place output might happen, in sentinels, and + ;; in an unwind-protect, to make *SURE* that point is + ;; correct. (We could do this more easily and perhaps more + ;; safely using a process filter, but that would create a LOT + ;; of garbage since all the data would get sent in strings.) + ;; We make this a label, not an flet, due to dynamic binding + ;; problems -- the flet may not still be in scope when the + ;; sentinel is called. + (let ((pb (process-buffer proc)) + (pm (process-mark proc))) + (if (and pb (buffer-live-p pb) (marker-buffer pm)) + (goto-char pm pb)) + (if (process-has-separate-stderr-p proc) + (let ((pseb (process-stderr-buffer proc)) + (psem (process-stderr-mark proc))) + (if (and pseb (not (eq pb pseb)) + (buffer-live-p pseb) + (marker-buffer psem)) + (goto-char psem pseb))))))) ;; first handle INFILE. (cond ((stringp infile) (setq infile (expand-file-name infile)) @@ -263,25 +266,20 @@ ;; we finish. ;; ;; #### not clear if we should be doing this. - ;; - ;; NOTE NOTE NOTE: Due to the total bogosity of - ;; dynamic scoping, and the lack of closures, we - ;; have to be careful how we write the first - ;; sentinel below since it may be executed after - ;; this function has returned -- thus we fake a - ;; closure. (This doesn't apply to the second one, - ;; which only gets executed within the - ;; unwind-protect.) - `(lambda (proc status) - (set-process-sentinel proc nil) - (process-synchronize-point proc) - (with-current-buffer ,errbuf - (write-region-internal - 1 (1+ (buffer-size)) - ,stderr - nil 'major-rms-kludge-city nil - coding-system-for-write)) - (kill-buffer ,errbuf))) + (apply-partially + #'(lambda (errbuf stderr proc status) + (set-process-sentinel proc nil) + (process-synchronize-point proc) + (with-current-buffer errbuf + (write-region-internal + 1 (1+ (buffer-size)) + stderr + nil 'major-rms-kludge-city nil + coding-system-for-write)) + (kill-buffer errbuf)) + ;; Close around these two variables, the lambda may be + ;; called outside this enclosing unwind-protect. + errbuf stderr)) (no-wait nil) (t ;; normal sentinel: maybe write out stderr and return