Implement completion of commands.

diff --git a/v7/src/edwin/dosfile.scm b/v7/src/edwin/dosfile.scm
index d1492c409027dc35bc404383455c9e4e58bfd3a4..33c5ace46ead15d4e9e431b12301a9585ad760a7 100644 (file)
--- a/v7/src/edwin/dosfile.scm
+++ b/v7/src/edwin/dosfile.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Id: dosfile.scm,v 1.17 1998/06/29 04:14:27 cph Exp $
+;;;    $Id: dosfile.scm,v 1.18 1998/08/30 02:06:45 cph Exp $
 ;;;
 ;;;    Copyright (c) 1994-98 Massachusetts Institute of Technology
 ;;;
@@ -563,16 +563,22 @@ Switches may be concatenated, e.g. `-lt' is equivalent to `-l -t'."
 (define dos/executable-pathname-types
   '("exe" "com" "bat"))
 
-(define (os/default-shell-prompt-pattern)
-  "^\\[[^]]*] *")
-
 (define (os/default-shell-args)
   '())
 
+(define (os/default-shell-prompt-pattern)
+  "^\\[[^]]*] *")
+
 (define (os/comint-filename-region start point end)
   (let ((chars "]\\\\A-Za-z0-9!#$%&'()+,.:;=@[^_`{}~---"))
     (let ((start (skip-chars-backward chars point start)))
       (make-region start (skip-chars-forward chars start end)))))
+
+(define (os/shell-command-separators)
+  "&|")
+
+(define (os/shell-command-regexp)
+  (string-append "[^" (os/shell-command-separators) "\n]+"))
 \f
 ;;;; File-Encoding Methods
 

diff --git a/v7/src/edwin/shell.scm b/v7/src/edwin/shell.scm
index 34c080bb6bba8597163ba6e0bf388e364de6d00c..f8a3b3bc8aa52226ebf54c95aa78dc81ec2de551 100644 (file)
--- a/v7/src/edwin/shell.scm
+++ b/v7/src/edwin/shell.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: shell.scm,v 1.14 1997/03/04 06:43:37 cph Exp $
+$Id: shell.scm,v 1.15 1998/08/30 02:06:37 cph Exp $
 
-Copyright (c) 1991-97 Massachusetts Institute of Technology
+Copyright (c) 1991-98 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -74,16 +74,16 @@ shell-mode-hook (in that order).
 Variables shell-cd-regexp, shell-pushd-regexp and shell-popd-regexp are used
 to match their respective commands."
   (lambda (buffer)
-    (define-variable-local-value! buffer
-       (ref-variable-object comint-prompt-regexp)
-      (ref-variable shell-prompt-pattern buffer))
-    (define-variable-local-value! buffer
-       (ref-variable-object comint-input-sentinel)
-      shell-directory-tracker)
-    (define-variable-local-value! buffer (ref-variable-object shell-dirstack)
-      '())
-    (define-variable-local-value! buffer (ref-variable-object shell-dirtrack?)
-      true)
+    (local-set-variable! comint-prompt-regexp
+                        (ref-variable shell-prompt-pattern buffer)
+                        buffer)
+    (local-set-variable! comint-dynamic-complete-functions
+                        (list shell-dynamic-complete-command
+                              comint-dynamic-complete-filename)
+                        buffer)
+    (local-set-variable! comint-input-sentinel shell-directory-tracker buffer)
+    (local-set-variable! shell-dirstack '() buffer)
+    (local-set-variable! shell-dirtrack? #t buffer)
     (event-distributor/invoke! (ref-variable shell-mode-hook buffer) buffer)))
 
 (define-variable shell-mode-hook
@@ -130,6 +130,8 @@ Otherwise, one argument `-i' is passed to the shell."
                    (variable-value variable)
                    (os/default-shell-args))))))))
 \f
+;;;; Directory Tracking
+
 (define-variable shell-popd-regexp
   "Regexp to match subshell commands equivalent to popd."
   "popd")
@@ -331,4 +333,120 @@ command again."
                      (cons (substring string start index)
                            (skip-spaces (+ index 1))))
                     (else
-                     (skip-nonspaces (+ index 1))))))))))
\ No newline at end of file
+                     (skip-nonspaces (+ index 1))))))))))
+\f
+;;;; Command Completion
+
+(define-variable shell-command-regexp
+  "Regexp to match a single command within a pipeline.
+This is used for command completion and does not do a perfect job."
+  (os/shell-command-regexp)
+  string?)
+
+(define-variable shell-completion-execonly
+  "If true, use executable files only for completion candidates.
+This mirrors the optional behavior of tcsh.
+
+Detecting executability of files may slow command completion considerably."
+  #t
+  boolean?)
+
+(define (shell-backward-command mark n)
+  (and (> n 0)
+       (let ((limit
+             (let ((limit (comint-line-start mark)))
+               (if (mark> limit mark)
+                   (line-start mark 0)
+                   limit)))
+            (regexp
+             (string-append "["
+                            (os/shell-command-separators)
+                            "]+[\t ]*\\("
+                            (ref-variable shell-command-regexp mark)
+                            "\\)")))
+        (let loop
+            ((mark
+              (let ((m (re-search-backward "\\S " mark limit #f)))
+                (if m
+                    (mark1+ m)
+                    limit)))
+             (n n))
+          (let ((mark* (re-search-backward regexp mark limit #f))
+                (n (- n 1)))
+            (if mark*
+                (if (> n 0)
+                    (loop mark* (- n 1))
+                    (skip-chars-forward (os/shell-command-separators)
+                                        (re-match-start 1)))
+                limit))))))
+\f
+(define (shell-dynamic-complete-command)
+  "Dynamically complete the command at point.
+This function is similar to `comint-dynamic-complete-filename', except that it
+searches the PATH environment variable for completion candidates.
+Note that this may not be the same as the shell's idea of the path.
+
+Completion is dependent on the value of `shell-completion-execonly', plus
+those that effect file completion."
+  (let ((r (comint-current-filename-region)))
+    (and (not (mark= (region-start r) (region-end r)))
+        (string=? "" (directory-namestring (region->string r)))
+        (let ((m (shell-backward-command (current-point) 1)))
+          (and m
+               (mark= (region-start r) m)))
+        (begin
+          (message "Completing command name...")
+          (let ((completed? #f))
+            (standard-completion (region->string r)
+              (lambda (filename if-unique if-not-unique if-not-found)
+                (shell-complete-command
+                 (parse-namestring filename)
+                 (ref-variable shell-completion-execonly (region-start r))
+                 if-unique if-not-unique if-not-found))
+              (lambda (filename)
+                (region-delete! r)
+                (insert-string filename (region-start r))
+                (set! completed? #t)
+                unspecific))
+            completed?)))))
+
+(define (shell-complete-command command exec-only?
+                               if-unique if-not-unique if-not-found)
+  (let* ((results '())
+        (maybe-add-filename!
+         (let ((add-filename!
+                (lambda (filename)
+                  (let ((s (file-namestring filename)))
+                    (if (not (member s results))
+                        (set! results (cons s results))))
+                  unspecific)))
+           (if exec-only?
+               (lambda (filename)
+                 (if (file-executable? filename)
+                     (add-filename! filename)))
+               add-filename!))))
+    (for-each
+     (lambda (directory)
+       (filename-complete-string (merge-pathnames command directory)
+        maybe-add-filename!
+        (lambda (directory get-completions)
+          (for-each
+           (lambda (filename)
+             (maybe-add-filename! (merge-pathnames directory filename)))
+           (get-completions)))
+        (lambda () unspecific)))
+     (os/parse-path-string (get-environment-variable "PATH")))
+    (cond ((null? results) (if-not-found))
+         ((null? (cdr results)) (if-unique (car results)))
+         (else
+          (if-not-unique (compute-max-prefix results) (lambda () results))))))
+
+(define (compute-max-prefix strings)
+  (let loop ((prefix (car strings)) (strings (cdr strings)))
+    (if (null? strings)
+       prefix
+       (loop (let ((n (string-match-forward prefix (car strings))))
+               (if (fix:< n (string-length prefix))
+                   (string-head prefix n)
+                   prefix))
+             (cdr strings)))))
\ No newline at end of file

diff --git a/v7/src/edwin/unix.scm b/v7/src/edwin/unix.scm
index d7c74c5a40836763d342c31bafde59455887e215..fd3d15ea1b26859371c7eff9175c798975ca2880 100644 (file)
--- a/v7/src/edwin/unix.scm
+++ b/v7/src/edwin/unix.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Id: unix.scm,v 1.83 1998/06/29 04:14:31 cph Exp $
+;;;    $Id: unix.scm,v 1.84 1998/08/30 02:07:05 cph Exp $
 ;;;
 ;;;    Copyright (c) 1989-98 Massachusetts Institute of Technology
 ;;;
@@ -677,9 +677,6 @@ CANNOT contain the 'F' option."
 (define (os/shell-name pathname)
   (file-namestring pathname))
 
-(define (os/default-shell-prompt-pattern)
-  "^[^#$>]*[#$>] *")
-
 (define (os/default-shell-args)
   '("-i"))
 
@@ -691,11 +688,20 @@ Value is a list of strings."
       ;; than us about what terminal modes to use.
       '("-i" "-T")
       '("-i")))
+\f
+(define (os/default-shell-prompt-pattern)
+  "^[^#$>]*[#$>] *")
 
 (define (os/comint-filename-region start point end)
   (let ((chars "~/A-Za-z0-9---_.$#,"))
     (let ((start (skip-chars-backward chars point start)))
       (make-region start (skip-chars-forward chars start end)))))
+
+(define (os/shell-command-separators)
+  ";&|")
+
+(define (os/shell-command-regexp)
+  (string-append "[^" (os/shell-command-separators) "\n]+"))
 \f
 ;;;; POP Mail