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