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