[mcclim-cvs] CVS mcclim/Drei
thenriksen
thenriksen at common-lisp.net
Mon Dec 4 20:07:53 UTC 2006
Update of /project/mcclim/cvsroot/mcclim/Drei
In directory clnet:/tmp/cvs-serv22078
Modified Files:
lisp-syntax-swine.lisp lisp-syntax-commands.lisp
Log Message:
Using #\Tab for completing Lisp symbols will no longer potentially
cause you to be presented with a list of every symbol in the package.
--- /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax-swine.lisp 2006/11/14 12:27:53 1.2
+++ /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax-swine.lisp 2006/12/04 20:07:53 1.3
@@ -997,61 +997,69 @@
(best (caar set)))
(values best set)))
-(defun complete-symbol-at-mark-with-fn (syntax mark &optional (fn #'find-completions))
+(defun complete-symbol-at-mark-with-fn (syntax mark &key (completion-finder #'find-completions)
+ (complete-blank t))
"Attempt to find and complete the symbol at `mark' using the
- function `fn' to get the list of completions. If the completion
+ function `completion-finder' to get the list of completions. If the completion
is ambiguous, a list of possible completions will be
- displayed. If no symbol can be found at `mark', return nil."
+ displayed. If no symbol can be found at `mark', return NIL. If
+ there is no symbol at `mark' and `complete-blank' is true (the
+ default), all symbols available in the current package will be
+ shown. If `complete-blank' is true, nothing will be shown and
+ the function will return NIL."
(let* ((token (form-around syntax (offset mark)))
(useful-token (and (not (null token))
(form-token-p token)
(not (= (start-offset token)
(offset mark))))))
- (multiple-value-bind (longest completions)
- (funcall fn syntax
- (if useful-token
- (start-offset (fully-quoted-form token))
- (if (and (form-quoted-p token)
- (form-incomplete-p token))
- (start-offset token)
- (offset mark)))
- (if useful-token
- (token-string syntax token)
- ""))
- (if completions
- (if (= (length completions) 1)
- (replace-symbol-at-mark mark syntax longest)
- (progn
- (esa:display-message (format nil "Longest is ~a|" longest))
- (let ((selection (menu-choose (mapcar
- ;; FIXME: this can
- ;; get ugly.
- #'(lambda (completion)
- (if (listp completion)
- (cons completion
- (first completion))
- completion))
- completions)
- :label "Possible completions"
- :scroll-bars :vertical)))
- (if useful-token
- (replace-symbol-at-mark mark syntax (or selection longest))
- (insert-sequence mark (or selection longest))))))
- (esa:display-message "No completions found")))
- t))
+ (when (or useful-token complete-blank)
+ (multiple-value-bind (longest completions)
+ (funcall completion-finder syntax
+ (if useful-token
+ (start-offset (fully-quoted-form token))
+ (if (and (form-quoted-p token)
+ (form-incomplete-p token))
+ (start-offset token)
+ (offset mark)))
+ (if useful-token
+ (token-string syntax token)
+ ""))
+ (if completions
+ (if (= (length completions) 1)
+ (replace-symbol-at-mark mark syntax longest)
+ (progn
+ (esa:display-message (format nil "Longest is ~a|" longest))
+ (let ((selection (menu-choose (mapcar
+ ;; FIXME: this can
+ ;; get ugly.
+ #'(lambda (completion)
+ (if (listp completion)
+ (cons completion
+ (first completion))
+ completion))
+ completions)
+ :label "Possible completions"
+ :scroll-bars :vertical)))
+ (if useful-token
+ (replace-symbol-at-mark mark syntax (or selection longest))
+ (insert-sequence mark (or selection longest)))
+ t)))
+ (esa:display-message "No completions found"))))))
-(defun complete-symbol-at-mark (syntax mark)
+(defun complete-symbol-at-mark (syntax mark &optional (complete-blank t))
"Attempt to find and complete the symbol at `mark'. If the
completion is ambiguous, a list of possible completions will be
displayed. If no symbol can be found at `mark', return nil."
- (complete-symbol-at-mark-with-fn syntax mark))
+ (complete-symbol-at-mark-with-fn syntax mark :complete-blank complete-blank))
-(defun fuzzily-complete-symbol-at-mark (syntax mark)
+(defun fuzzily-complete-symbol-at-mark (syntax mark &optional (complete-blank t))
"Attempt to find and complete the symbol at `mark' using fuzzy
completion. If the completion is ambiguous, a list of possible
completions will be displayed. If no symbol can be found at
`mark', return nil."
- (complete-symbol-at-mark-with-fn syntax mark #'find-fuzzy-completions))
+ (complete-symbol-at-mark-with-fn syntax mark
+ :completion-finder #'find-fuzzy-completions
+ :complete-blank complete-blank))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
--- /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax-commands.lisp 2006/11/14 12:27:53 1.2
+++ /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax-commands.lisp 2006/12/04 20:07:53 1.3
@@ -125,29 +125,26 @@
(forward-object mark)
(clear-completions)))
-(define-command (com-complete-symbol :name t :command-table lisp-table) ()
+(define-command (com-complete-symbol :name t :command-table lisp-table)
+ ()
"Attempt to complete the symbol at mark. If successful, move point
to end of symbol.
-If more than one completion is available, a list of
-possible completions will be displayed."
- (let* ((pane *current-window*)
- (buffer (buffer pane))
- (syntax (syntax buffer))
- (mark (point pane)))
- (complete-symbol-at-mark syntax mark)))
+If more than one completion is available, a list of possible
+completions will be displayed. If there is no symbol at mark, all
+relevant symbols accessible in the current package will be
+displayed."
+ (complete-symbol-at-mark *current-syntax* *current-mark*))
-(define-command (com-fuzzily-complete-symbol :name t :command-table lisp-table) ()
+(define-command (com-fuzzily-complete-symbol :name t :command-table lisp-table)
+ ()
"Attempt to fuzzily complete the abbreviation at mark.
Fuzzy completion tries to guess which symbol is abbreviated. If
the abbreviation is ambiguous, a list of possible completions
-will be displayed."
- (let* ((pane *current-window*)
- (buffer (buffer pane))
- (syntax (syntax buffer))
- (mark (point pane)))
- (fuzzily-complete-symbol-at-mark syntax mark)))
+will be displayed. If there is no symbol at mark, all relevant
+symbols accessible in the current package will be displayed."
+ (fuzzily-complete-symbol-at-mark *current-syntax* *current-mark*))
(define-command (com-indent-line-and-complete-symbol :name t :command-table lisp-table) ()
"Indents the current line and performs symbol completion.
@@ -162,7 +159,7 @@
(offset point))
(let* ((buffer (buffer pane))
(syntax (syntax buffer)))
- (or (complete-symbol-at-mark syntax point)
+ (or (complete-symbol-at-mark syntax point nil)
(show-arglist-for-form-at-mark point syntax))))))
(define-presentation-to-command-translator lookup-symbol-arglist
More information about the Mcclim-cvs
mailing list