[COMMIT] Use new language features in #'call-process-internal now they're available.

APPROVE COMMIT NOTE: This patch has been committed. # HG changeset patch # User Aidan Kehoe <kehoea(a)parhasard.net&gt; # Date 1371497867 -3600 # Node ID f6af091ac6548f5e840cb3c31107474eda04f1cb # Parent 165315eae1ab4d64ecc4a2d7e919fa4f13844421 Use new language features in #'call-process-internal now they're available. lisp/ChangeLog addition: 2013-06-17 Aidan Kehoe <kehoea(a)parhasard.net&gt; * 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. diff -r 165315eae1ab -r f6af091ac654 lisp/ChangeLog --- 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(a)parhasard.net&gt; + + * 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(a)parhasard.net&gt; * cl-macs.el: diff -r 165315eae1ab -r f6af091ac654 lisp/process.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 -- ‘Liston operated so fast that he once accidentally amputated an assistant’s fingers along with a patient’s leg, […] The patient and the assistant both died of sepsis, and a spectator reportedly died of shock, resulting in the only known procedure with a 300% mortality.’ (Atul Gawande, NEJM, 2012) _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches