From af3f3a08090f43aa91bcb9ce0eb016baf496e722 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 21 May 1991 02:06:04 +0000
Subject: [PATCH] Change completion code to use new generic support.

---
 v7/src/edwin/comint.scm | 50 ++++++++------------------------------
 v7/src/edwin/schmod.scm | 54 ++++++++++++++++++-----------------------
 2 files changed, 33 insertions(+), 71 deletions(-)

diff --git a/v7/src/edwin/comint.scm b/v7/src/edwin/comint.scm
index e2f7b4519..535267017 100644
--- 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))))))))
-
+
 (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 9068762d6..fe9835214 100644
--- 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)))
-- 
2.25.1