From: Stefan Monnier <monnier@iro.umontreal.ca>
Date: Wed, 13 Oct 1999 00:48:17 +0000 (+0000)
Subject: (shell-command, shell-command-on-region): use make-temp-file.
X-Git-Tag: emacs-pretest-21.0.90~6456
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=b005abd5c098532dd0b09654ac77a990bfe51510;p=emacs.git

(shell-command, shell-command-on-region): use make-temp-file.
(clone-buffer, clone-process, clone-buffer-hook): new functions.
---

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 742588131b8..f0f91cb3779 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,8 @@
 1999-10-12  Stefan Monnier  <monnier@cs.yale.edu>
 
+	* simple.el (shell-command, shell-command-on-region): use make-temp-file.
+	(clone-buffer, clone-process, clone-buffer-hook): new functions.
+
 	* subr.el (with-current-buffer): don't use backquotes to avoid
 	  bootstrapping problems.
 	loadup.el (load-path): add subdirs for bootstrapping.
diff --git a/lisp/simple.el b/lisp/simple.el
index 9a77e3de806..15fe04b4c7e 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -1118,7 +1118,7 @@ specifies the value of ERROR-BUFFER."
 	       (not (or (bufferp output-buffer)  (stringp output-buffer))))
 	  (let ((error-file
 		 (if error-buffer 
-		     (make-temp-name
+		     (make-temp-file
 		      (expand-file-name "scor"
 					(or small-temporary-file-directory
 					    temporary-file-directory)))
@@ -1253,7 +1253,7 @@ specifies the value of ERROR-BUFFER."
 		       shell-command-default-error-buffer)))
   (let ((error-file
 	 (if error-buffer
-	     (make-temp-name
+	     (make-temp-file
 	      (expand-file-name "scor"
 				(or small-temporary-file-directory
 				    temporary-file-directory)))
@@ -3991,4 +3991,101 @@ PREFIX is the string that represents this modifier in an event type symbol."
    (kp-divide ?/)
    (kp-equal ?=)))
 
+;;;; 
+;;;; forking a twin copy of a buffer.
+;;;; 
+
+(defvar clone-buffer-hook nil
+  "Normal hook to run in the new buffer at the end of `clone-buffer'.")
+
+(defun clone-process (process &optional newname)
+  "Create a twin copy of PROCESS.
+If NEWNAME is nil, it defaults to PROCESS' name;
+NEWNAME is modified by adding or incrementing <N> at the end as necessary.
+If PROCESS is associated with a buffer, the new process will be associated
+  with the current buffer instead.
+Returns nil if PROCESS has already terminated."
+  (setq newname (or newname (process-name process)))
+  (if (string-match "<[0-9]+>\\'" newname)
+      (setq newname (substring newname 0 (match-beginning 0))))
+  (when (memq (process-status process) '(run stop open))
+    (let* ((process-connection-type (process-tty-name process))
+	   (old-kwoq (process-kill-without-query process nil))
+	   (new-process
+	    (if (memq (process-status process) '(open))
+		(apply 'open-network-stream newname
+		       (if (process-buffer process) (current-buffer))
+		       (process-contact process))
+	      (apply 'start-process newname
+		     (if (process-buffer process) (current-buffer))
+		     (process-command process)))))
+      (process-kill-without-query new-process old-kwoq)
+      (process-kill-without-query process old-kwoq)
+      (set-process-inherit-coding-system-flag
+       new-process (process-inherit-coding-system-flag process))
+      (set-process-filter new-process (process-filter process))
+      (set-process-sentinel new-process (process-sentinel process))
+      new-process)))
+
+;; things to maybe add (currently partly covered by `funcall mode':
+;; - syntax-table
+;; - overlays
+(defun clone-buffer (&optional newname display-flag)
+  "Create a twin copy of the current buffer.
+If NEWNAME is nil, it defaults to the current buffer's name;
+NEWNAME is modified by adding or incrementing <N> at the end as necessary.
+
+If DISPLAY-FLAG is non-nil, the new buffer is shown with `pop-to-buffer'.
+This runs the normal hook `clone-buffer-hook' in the new buffer
+after it has been set up properly in other respects."
+  (interactive (list (if current-prefix-arg (read-string "Name: "))
+		     t))
+  (if buffer-file-name
+      (error "Cannot clone a file-visiting buffer"))
+  (if (get major-mode 'no-clone)
+      (error "Cannot clone a buffer in %s mode" mode-name))
+  (setq newname (or newname (buffer-name)))
+  (if (string-match "<[0-9]+>\\'" newname)
+      (setq newname (substring newname 0 (match-beginning 0))))
+  (let ((buf (current-buffer))
+	(ptmin (point-min))
+	(ptmax (point-max))
+	(pt (point))
+	(mk (if mark-active (mark t)))
+	(modified (buffer-modified-p))
+	(mode major-mode)
+	(lvars (buffer-local-variables))
+	(process (get-buffer-process (current-buffer)))
+	(new (generate-new-buffer (or newname (buffer-name)))))
+    (save-restriction
+      (widen)
+      (with-current-buffer new
+	(insert-buffer-substring buf)))
+    (with-current-buffer new
+      (narrow-to-region ptmin ptmax)
+      (goto-char pt)
+      (if mk (set-mark mk))
+      (set-buffer-modified-p modified)
+
+      ;; Clone the old buffer's process, if any.
+      (when process (clone-process process))
+
+      ;; Now set up the major mode.
+      (funcall mode)
+
+      ;; Set up other local variables.
+      (mapcar (lambda (v)
+		(condition-case ()	;in case var is read-only
+		    (if (symbolp v)
+			(makunbound v)
+		      (set (make-local-variable (car v)) (cdr v)))
+		  (error nil)))
+	      lvars)
+
+      ;; Run any hooks (typically set up by the major mode
+      ;; for cloning to work properly).
+      (run-hooks 'clone-buffer-hook))
+    (if display-flag (pop-to-buffer new))
+    new))
+
 ;;; simple.el ends here