Change completion code to use new generic support.

diff --git a/v7/src/edwin/comint.scm b/v7/src/edwin/comint.scm
index e2f7b451941dbf9effdde642b2845e8f3b0a67f9..5352670179e2a9c12d10e85807b49b2e9f966a52 100644 (file)
--- a/v7/src/edwin/comint.scm
+++ b/v7/src/edwin/comint.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/comint.scm,v 1.5 1991/05/20 22:05:08 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/comint.scm,v 1.6 1991/05/21 02:05:45 cph Exp $
 
 Copyright (c) 1991 Massachusetts Institute of Technology
 
@@ -473,54 +473,24 @@ it just adds completion characters to the end of the filename."
   "List all possible completions of the filename at point."
   ()
   (lambda ()
-    (comint-list-filename-completions
+    (pop-up-generated-completions
      (lambda ()
        (filename-completions-list
        (merge-pathnames
         (->pathname (region->string (comint-current-filename-region)))
         (buffer-default-directory (current-buffer))))))))
-\f
+
 (define (comint-current-filename-region)
   (let ((point (current-point))
        (chars "~/A-Za-z0-9---_.$#,"))
-    (let ((start
-          (skip-chars-backward chars
-                               point
-                               (comint-line-start point)
-                               'LIMIT)))
-      (let ((end
-            (skip-chars-forward chars start (line-end start 0) 'LIMIT)))
+    (let ((start (skip-chars-backward chars point (comint-line-start point))))
+      (let ((end (skip-chars-forward chars start (line-end start 0))))
        (and (mark< start end)
             (make-region start end))))))
 
 (define (comint-filename-complete pathname filename insert-completion)
-  (filename-complete-string pathname
-    (lambda (filename*)
-      (if (string=? filename filename*)
-         (message "Sole completion")
-         (insert-completion filename*)))
-    (lambda (filename* list-completions)
-      (if (string=? filename filename*)
-         (if (ref-variable completion-auto-help)
-             (comint-list-filename-completions list-completions)
-             (message "Next char not unique"))
-         (insert-completion filename*)))
-    (lambda ()
-      (editor-failure "No completions"))))
-
-(define (comint-list-filename-completions list-completions)
-  (message "Making completion list...")
-  (let ((completions (list-completions)))
-    (clear-message)
-    (if (null? completions)
-       (editor-failure "No completions")
-       (begin
-         (write-completions-list completions)
-         (message "Hit space to flush.")
-         (reset-command-prompt!)
-         (let ((char (keyboard-peek-char)))
-           (if (char=? #\space char)
-               (begin
-                 (keyboard-read-char)
-                 (kill-pop-up-buffer false))))
-         (clear-message)))))
\ No newline at end of file
+  (standard-completion filename
+    (lambda (filename if-unique if-not-unique if-not-found)
+      filename
+      (filename-complete-string pathname if-unique if-not-unique if-not-found))
+    insert-completion))
\ No newline at end of file

diff --git a/v7/src/edwin/schmod.scm b/v7/src/edwin/schmod.scm
index 9068762d6a51c25e0f268816ae477f9907e78c46..fe983521443617f8860a2ae273d4811e667aac72 100644 (file)
--- a/v7/src/edwin/schmod.scm
+++ b/v7/src/edwin/schmod.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/schmod.scm,v 1.19 1991/05/20 22:16:59 cph Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/schmod.scm,v 1.20 1991/05/21 02:06:04 cph Exp $
 ;;;
 ;;;    Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
 ;;;
@@ -215,36 +215,28 @@ environment are considered."
                       (editor-error "No symbol preceding point"))
                   point)))))
       (let ((start (forward-prefix-chars (backward-sexp end 1 'LIMIT) end)))
-       (let ((prefix (extract-string start end)))
-         (let ((completions
-                (let ((completions (obarray-completions prefix)))
-                  (if (not bound-only?)
-                      completions
-                      (let ((environment (evaluation-environment false)))
-                        (list-transform-positive completions
-                          (lambda (name)
-                            (environment-bound? environment name))))))))
-           (cond ((null? completions)
-                  (editor-beep)
-                  (message "Can't find completion for \"" prefix "\""))
-                 ((null? (cdr completions))
-                  (let ((completion (system-pair-car (car completions))))
-                    (if (not (string=? completion prefix))
-                        (begin
-                          (delete-string start end)
-                          (insert-string completion start))
-                        (message "Sole completion: \"" prefix "\""))))
-                 (else
-                  (let ((completions (map system-pair-car completions)))
-                    (let ((completion
-                           (string-greatest-common-prefix completions)))
-                      (if (not (string=? completion prefix))
-                          (begin
-                            (delete-string start end)
-                            (insert-string completion start))
-                          (comint-list-filename-completions
-                           (lambda ()
-                             (sort completions string<=?))))))))))))))
+       (standard-completion (extract-string start end)
+         (lambda (prefix if-unique if-not-unique if-not-found)
+           (let ((completions
+                  (let ((completions (obarray-completions prefix)))
+                    (if (not bound-only?)
+                        completions
+                        (let ((environment (evaluation-environment false)))
+                          (list-transform-positive completions
+                            (lambda (name)
+                              (environment-bound? environment name))))))))
+             (cond ((null? completions)
+                    (if-not-found))
+                   ((null? (cdr completions))
+                    (if-unique (system-pair-car (car completions))))
+                   (else
+                    (let ((completions (map system-pair-car completions)))
+                      (if-not-unique
+                       (string-greatest-common-prefix completions)
+                       (lambda () (sort completions string<=?))))))))
+         (lambda (completion)
+           (delete-string start end)
+           (insert-string completion start)))))))
 
 (define (obarray-completions prefix)
   (let ((obarray (fixed-objects-item 'OBARRAY)))