From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 11 Oct 1991 03:35:06 +0000 (+0000)
Subject: Implement M-x shell-command and M-x shell-command-on-region.  Bind
X-Git-Tag: 20090517-FFI~10157
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=a1944f801f5b73f1ae447ac7af5942a0f457c1c7;p=mit-scheme.git

Implement M-x shell-command and M-x shell-command-on-region.  Bind
them to M-! and M-| respectively.
---

diff --git a/v7/src/edwin/edwin.pkg b/v7/src/edwin/edwin.pkg
index 93c11cc66..1f83616b0 100644
--- a/v7/src/edwin/edwin.pkg
+++ b/v7/src/edwin/edwin.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/edwin.pkg,v 1.62 1991/09/20 20:47:00 arthur Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/edwin.pkg,v 1.63 1991/10/11 03:35:06 cph Exp $
 
 Copyright (c) 1989-91 Massachusetts Institute of Technology
 
@@ -833,6 +833,8 @@ MIT in each case. |#
 	  continue-process
 	  delete-process
 	  edwin-command$list-processes
+	  edwin-command$shell-command
+	  edwin-command$shell-command-on-region
 	  edwin-variable$exec-path
 	  edwin-variable$process-connection-type
 	  find-program
diff --git a/v7/src/edwin/process.scm b/v7/src/edwin/process.scm
index f88e13a6d..7b61031bd 100644
--- a/v7/src/edwin/process.scm
+++ b/v7/src/edwin/process.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/process.scm,v 1.8 1991/10/02 09:25:55 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/process.scm,v 1.9 1991/10/11 03:34:46 cph Exp $
 ;;;
 ;;;	Copyright (c) 1991 Massachusetts Institute of Technology
 ;;;
@@ -582,6 +582,58 @@ after the listing is made.)"
 (define system-call-error
   (condition-accessor condition-type:system-call-error 'ERROR-TYPE))
 
+(define-command shell-command
+  "Execute string COMMAND in inferior shell; display output, if any.
+Optional second arg true (prefix arg, if interactive) means
+insert output in current buffer after point (leave mark after it)."
+  "sShell command\nP"
+  (lambda (command insert-at-point?)
+    (if insert-at-point?
+	(begin
+	  (if (buffer-read-only? (current-buffer))
+	      (barf-if-read-only))
+	  (let ((point (current-point)))
+	    (push-current-mark! point)
+	    (shell-command command point))
+	  ((ref-command exchange-point-and-mark)))
+	(shell-command-pop-up-output
+	 (lambda (output-mark)
+	   (shell-command command output-mark))))))
+
+(define-command shell-command-on-region
+  "Execute string COMMAND in inferior shell with region as input.
+Normally display output (if any) in temp buffer;
+Prefix arg means replace the region with it."
+  "r\nsShell command on region\nP"
+  (lambda (region command replace-region?)
+    (if replace-region?
+	(let ((point (current-point))
+	      (mark (current-mark)))
+	  (let ((swap? (mark< point mark))
+		(temp (temporary-buffer " *shell-input*")))
+	    (let ((st (buffer-start temp)))
+	      (if swap?
+		  (insert-region point mark st)
+		  (insert-region mark point st))
+	      (delete-string point mark)
+	      (shell-command-region command
+				    point
+				    (make-region st (buffer-end temp))))
+	    (kill-buffer temp)
+	    (if swap? ((ref-command exchange-point-and-mark)))))
+	(shell-command-pop-up-output
+	 (lambda (output-mark)
+	   (shell-command-region command output-mark region))))))
+
+(define (shell-command-pop-up-output generate-output)
+  (let ((buffer (temporary-buffer "*Shell Command Output*")))
+    (let ((start (buffer-start buffer)))
+      (generate-output start)
+      (set-buffer-point! buffer start)
+      (if (mark< start (buffer-end buffer))
+	  (pop-up-buffer buffer false)
+	  (message "(Shell command completed with no output)")))))
+
 ;;; These procedures are not specific to the process abstraction.
 
 (define (find-program program default-directory)