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 93c11cc66f771876496823e406ac372658781584..1f83616b0b43a21946e20e4a6c27eb96c4f7f5cc 100644 (file)
--- 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 f88e13a6de8a8f29071ccd109e3dd6845655510e..7b61031bd6e66325c31c1685f7604042952a32a7 100644 (file)
--- 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))
 \f
+(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)")))))
+\f
 ;;; These procedures are not specific to the process abstraction.
 
 (define (find-program program default-directory)