From: Chris Hanson <org/chris-hanson/cph>
Date: Sun, 30 Aug 1998 01:52:39 +0000 (+0000)
Subject: Redefine COMINT-DYNAMIC-COMPLETE so that it tries a list of completion
X-Git-Tag: 20090517-FFI~4751
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=71ee815b8db4656dceca5c7aad959217abc05d2e;p=mit-scheme.git
Redefine COMINT-DYNAMIC-COMPLETE so that it tries a list of completion
procedures, as in Emacs 19. Fix bug in COMINT-LINE-START: used
current value of COMINT-PROMPT-REGEXP rather than the one for the
buffer being examined.
---
diff --git a/v7/src/edwin/comint.scm b/v7/src/edwin/comint.scm
index 13d628f82..0525526ad 100644
--- a/v7/src/edwin/comint.scm
+++ b/v7/src/edwin/comint.scm
@@ -1,6 +1,6 @@
#| -*-Scheme-*-
-$Id: comint.scm,v 1.26 1998/06/07 08:18:13 cph Exp $
+$Id: comint.scm,v 1.27 1998/08/30 01:52:39 cph Exp $
Copyright (c) 1991-98 Massachusetts Institute of Technology
@@ -59,9 +59,7 @@ license should have been included along with this file. |#
;; Get rid of any old processes.
(for-each delete-process (buffer-processes buffer))
(set-buffer-point! buffer (buffer-end buffer))
- (define-variable-local-value! buffer
- (ref-variable-object comint-program-name)
- program)
+ (local-set-variable! comint-program-name program buffer)
(apply start-process
name
buffer
@@ -139,18 +137,15 @@ to continue it.
Entry to this mode runs the hooks on comint-mode-hook."
(lambda (buffer)
- (define-variable-local-value! buffer
- (ref-variable-object mode-line-process)
- '(": %s"))
- (define-variable-local-value! buffer
- (ref-variable-object comint-input-ring)
- (make-ring (ref-variable comint-input-ring-size buffer)))
- (define-variable-local-value! buffer
- (ref-variable-object comint-last-input-end)
- (mark-right-inserting-copy (buffer-end buffer)))
- (define-variable-local-value! buffer
- (ref-variable-object comint-last-input-match)
- false)
+ (local-set-variable! mode-line-process '(": %s") buffer)
+ (local-set-variable! comint-input-ring
+ (make-ring
+ (ref-variable comint-input-ring-size buffer))
+ buffer)
+ (local-set-variable! comint-last-input-end
+ (mark-right-inserting-copy (buffer-end buffer))
+ buffer)
+ (local-set-variable! comint-last-input-match #f buffer)
(event-distributor/invoke! (ref-variable comint-mode-hook buffer) buffer)))
(define-variable comint-mode-hook
@@ -356,7 +351,7 @@ comint-prompt-regexp."
(define (comint-line-start mark)
(let ((start (line-start mark 0)))
(let ((mark
- (re-match-forward (ref-variable comint-prompt-regexp)
+ (re-match-forward (ref-variable comint-prompt-regexp mark)
start
(line-end mark 0))))
(if (and mark (mark<= mark (line-end start 0)))
@@ -432,27 +427,26 @@ See also \\[comint-dynamic-complete]."
(region-delete! region)
(insert-string filename* (region-start region))))))))
-(define-command comint-dynamic-complete
+(define (comint-dynamic-complete-filename)
"Complete the filename at point.
This function is similar to \\[comint-replace-by-expanded-filename], except
that it won't change parts of the filename already entered in the buffer;
it just adds completion characters to the end of the filename."
- ()
- (lambda ()
- (let ((region (comint-current-filename-region)))
- (let ((pathname
- (merge-pathnames (region->string region)
- (buffer-default-directory (current-buffer)))))
- (let ((filename (->namestring pathname)))
- (set-current-point! (region-end region))
- (comint-filename-complete
- pathname
- filename
- (lambda (filename*)
- (insert-substring filename*
- (string-length filename)
- (string-length filename*)
- (region-end region)))))))))
+ (let ((region (comint-current-filename-region)))
+ (let ((pathname
+ (merge-pathnames (region->string region)
+ (buffer-default-directory (current-buffer)))))
+ (let ((filename (->namestring pathname)))
+ (set-current-point! (region-end region))
+ (comint-filename-complete
+ pathname
+ filename
+ (lambda (filename*)
+ (insert-substring filename*
+ (string-length filename)
+ (string-length filename*)
+ (region-end region)))))))
+ #t)
(define-command comint-dynamic-list-completions
"List all possible completions of the filename at point."
@@ -478,4 +472,30 @@ it just adds completion characters to the end of the 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
+ insert-completion))
+
+(define-variable comint-dynamic-complete-functions
+ "List of functions called to perform completion.
+Functions should return true if completion was performed.
+See also `comint-dynamic-complete'.
+
+This is a good thing to set in mode hooks."
+ (list comint-dynamic-complete-filename)
+ (lambda (object)
+ (and (list? object)
+ (for-all? object
+ (lambda (object)
+ (and (procedure? object)
+ (procedure-arity-valid? object 0)))))))
+
+(define-command comint-dynamic-complete
+ "Dynamically perform completion at point.
+Calls the functions in `comint-dynamic-complete-functions' to perform
+completion until a function returns true, at which point completion is
+assumed to have occurred."
+ ()
+ (lambda ()
+ (let loop ((thunks (ref-variable comint-dynamic-complete-functions)))
+ (if (not (null? thunks))
+ (if (not ((car thunks)))
+ (loop (cdr thunks)))))))
\ No newline at end of file