[climacs-cvs] CVS climacs
thenriksen
thenriksen at common-lisp.net
Thu Jul 27 19:55:27 UTC 2006
Update of /project/climacs/cvsroot/climacs
In directory clnet:/tmp/cvs-serv23284
Modified Files:
misc-commands.lisp lisp-syntax.lisp lisp-syntax-commands.lisp
Log Message:
* Changed `form-around' to also select forms with a start or end
offset at mark.
* Cleaned the symbol-completion code a bit.
* Added Indent Line And Complete Symbol command to Lisp syntax (bound to Tab).
* Changed default binding of Newline to Newline And Indent in Lisp syntax.
--- /project/climacs/cvsroot/climacs/misc-commands.lisp 2006/07/27 10:39:32 1.20
+++ /project/climacs/cvsroot/climacs/misc-commands.lisp 2006/07/27 19:55:26 1.21
@@ -251,9 +251,12 @@
'((#\i :control)))
(define-command (com-newline-and-indent :name t :command-table indent-table) ()
+ "Inserts a newline and indents the new line."
(let* ((pane (current-window))
(point (point pane)))
(insert-object point #\Newline)
+ (update-syntax (current-buffer)
+ (syntax (current-buffer)))
(indent-current-line pane point)))
(set-key 'com-newline-and-indent
--- /project/climacs/cvsroot/climacs/lisp-syntax.lisp 2006/07/25 11:38:05 1.100
+++ /project/climacs/cvsroot/climacs/lisp-syntax.lisp 2006/07/27 19:55:27 1.101
@@ -1672,9 +1672,10 @@
(with-slots (top bot) pane
(loop for child in (children parse-symbol)
when (and (start-offset child)
- (mark< (start-offset child) bot)
(mark> (end-offset child) top))
- do (display-parse-tree child syntax pane))))
+ do (if (mark< (start-offset child) bot)
+ (display-parse-tree child syntax pane)
+ (return)))))
(defmethod display-parse-tree ((parse-symbol error-symbol) (syntax lisp-syntax) pane)
(let ((children (children parse-symbol)))
@@ -1953,7 +1954,9 @@
(defun form-around-in-children (children offset)
(loop for child in children
if (typep child 'form)
- do (cond ((<= (start-offset child) offset (end-offset child))
+ do (cond ((or (<= (start-offset child) offset (end-offset child))
+ (= offset (end-offset child))
+ (= offset (start-offset child)))
(return (if (null (first-form (children child)))
(when (typep child 'form)
child)
@@ -1967,8 +1970,8 @@
(defun form-around (syntax offset)
(with-slots (stack-top) syntax
(if (or (null (start-offset stack-top))
- (>= offset (end-offset stack-top))
- (<= offset (start-offset stack-top)))
+ (> offset (end-offset stack-top))
+ (< offset (start-offset stack-top)))
nil
(form-around-in-children (children stack-top) offset))))
@@ -3832,8 +3835,6 @@
;;; Symbol completion
-(defvar *completion-pane* nil)
-
(defun relevant-keywords (arglist arg-indices)
"Return a list of the keyword arguments that it would make
sense to use at the position `arg-indices' relative to the
@@ -3936,20 +3937,22 @@
(transpose-lists (mapcar #'cdr lists))))))
(defun clear-completions ()
- (when *completion-pane*
- (delete-window *completion-pane*)
- (setf *completion-pane* nil)))
+ (let ((completions-pane
+ (find "Completions" (esa:windows *application-frame*)
+ :key #'pane-name
+ :test #'string=)))
+ (unless (null completions-pane)
+ (delete-window completions-pane)
+ (setf completions-pane nil))))
-(defun show-completions-by-fn (fn symbol package)
+(defun find-completion-by-fn (fn symbol package)
(esa:display-message (format nil "~a completions" symbol))
(let* ((result (funcall fn symbol (package-name package)))
(set (first result))
(longest (second result)))
(cond ((<=(length set) 1)
(clear-completions))
- (t (let ((stream (or *completion-pane*
- (typeout-window "Simple Completions"))))
- (setf *completion-pane* stream)
+ (t (let ((stream (typeout-window "Completions")))
(window-clear stream)
(format stream "~{~A~%~}" set))))
(if (not (null longest))
@@ -3957,9 +3960,9 @@
(esa:display-message "No completions found"))
longest))
-(defun show-completions (syntax token package)
+(defun find-completion (syntax token package)
(let ((symbol-name (token-string syntax token)))
- (show-completions-by-fn
+ (find-completion-by-fn
#'(lambda (&rest args)
(find-if #'identity
(list
@@ -3974,19 +3977,47 @@
:key #'first))
symbol-name package)))
-(defun show-fuzzy-completions (syntax symbol-name package)
- (esa:display-message (format nil "~a completions" symbol-name))
- (let* ((set (fuzzy-completions (get-usable-image syntax) symbol-name package 10))
- (best (caar set)))
- (cond ((<= (length set) 1)
- (clear-completions))
- (t (let ((stream (or *completion-pane*
- (typeout-window "Simple Completions"))))
- (setf *completion-pane* stream)
- (window-clear stream)
- (loop for completed-string in set
- do (format stream "~{~A ~}~%" completed-string)))))
- (esa:display-message (if (not (null best))
- (format nil "Best is ~a|" best)
- "No fuzzy completions found"))
- best))
+(defun find-fuzzy-completion (syntax token package)
+ (let ((symbol-name (token-string syntax token)))
+ (esa:display-message (format nil "~a completions" symbol-name))
+ (let* ((set (fuzzy-completions (get-usable-image syntax) symbol-name package 10))
+ (best (caar set)))
+ (cond ((<= (length set) 1)
+ (clear-completions))
+ (t (let ((stream (typeout-window "Completions")))
+ (window-clear stream)
+ (loop for completed-string in set
+ do (format stream "~{~A ~}~%" completed-string)))))
+ (esa:display-message (if (not (null best))
+ (format nil "Best is ~a|" best)
+ "No fuzzy completions found"))
+ best)))
+
+(defun complete-symbol-at-mark-with-fn (syntax mark &optional (fn #'find-completion))
+ "Attempt to find and complete the symbol at `mark' using the
+ function `fn' 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."
+ (let ((token (form-around syntax (offset mark))))
+ (when (and (not (null token))
+ (typep token 'complete-token-lexeme)
+ (not (= (start-offset token)
+ (offset mark))))
+ (with-syntax-package syntax mark (package)
+ (let ((completion (funcall fn syntax token package)))
+ (unless (= (length completion) 0)
+ (replace-symbol-at-mark mark syntax completion))))
+ t)))
+
+(defun complete-symbol-at-mark (syntax mark)
+ "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))
+
+(defun fuzzily-complete-symbol-at-mark (syntax mark)
+ "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-completion))
--- /project/climacs/cvsroot/climacs/lisp-syntax-commands.lisp 2006/07/24 13:24:40 1.12
+++ /project/climacs/cvsroot/climacs/lisp-syntax-commands.lisp 2006/07/27 19:55:27 1.13
@@ -253,14 +253,8 @@
(let* ((pane (current-window))
(buffer (buffer pane))
(syntax (syntax buffer))
- (mark (point pane))
- (token (symbol-at-mark mark
- syntax)))
- (when token
- (with-syntax-package syntax mark (package)
- (let ((completion (show-completions syntax token package)))
- (unless (= (length completion) 0)
- (replace-symbol-at-mark mark syntax completion)))))))
+ (mark (point pane)))
+ (complete-symbol-at-mark syntax mark)))
(define-command (com-fuzzily-complete-symbol :name t :command-table lisp-table) ()
"Attempt to fuzzily complete the abbreviation at mark.
@@ -271,14 +265,24 @@
(let* ((pane (current-window))
(buffer (buffer pane))
(syntax (syntax buffer))
- (mark (mark pane))
- (name (symbol-name-at-mark mark
- syntax)))
- (when name
- (with-syntax-package syntax mark (package)
- (let ((completion (show-fuzzy-completions syntax name package)))
- (unless (= (length completion) 0)
- (replace-symbol-at-mark mark syntax completion)))))))
+ (mark (point pane)))
+ (fuzzily-complete-symbol-at-mark syntax mark)))
+
+(define-command (com-indent-line-and-complete-symbol :name t :command-table lisp-table) ()
+ "Indents the current line and performs symbol completion.
+First indents the line. If the line was already indented,
+completes the symbol. If there's no symbol at the point, shows
+the arglist for the most recently enclosed operator."
+ (let* ((pane (current-window))
+ (point (point pane))
+ (old-offset (offset point)))
+ (indent-current-line pane point)
+ (when (= old-offset
+ (offset point))
+ (let* ((buffer (buffer pane))
+ (syntax (syntax buffer)))
+ (or (complete-symbol-at-mark syntax point)
+ (show-arglist-for-form-at-mark point syntax))))))
(define-presentation-to-command-translator lookup-symbol-arglist
(symbol com-lookup-arglist lisp-table
@@ -366,11 +370,11 @@
'lisp-table
'((#\c :control) (#\k :control)))
-(esa:set-key 'com-compile-file
- 'lisp-table
- '((#\c :control) (#\k :meta)))
+(esa:set-key 'com-compile-file
+ 'lisp-table
+ '((#\c :control) (#\k :meta)))
-(esa:set-key `(com-edit-this-definition)
+(esa:set-key 'com-edit-this-definition
'lisp-table
'((#\. :meta)))
@@ -382,7 +386,7 @@
'lisp-table
'((#\c :control) (#\d :control) (#\h)))
-(esa:set-key `(com-lookup-arglist-for-this-symbol)
+(esa:set-key 'com-lookup-arglist-for-this-symbol
'lisp-table
'((#\c :control) (#\d :control) (#\a)))
@@ -398,3 +402,10 @@
'lisp-table
'((#\c :control) (#\i :meta)))
+(esa:set-key 'com-indent-line-and-complete-symbol
+ 'lisp-table
+ '((#\Tab)))
+
+(esa:set-key 'climacs-commands::com-newline-and-indent
+ 'lisp-table
+ '(#\Newline))
\ No newline at end of file
More information about the Climacs-cvs
mailing list