Commit b105b076 authored by Troels Henriksen's avatar Troels Henriksen

* 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.
parent 834d97dc
......@@ -253,14 +253,8 @@ possible completions will be displayed."
(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 @@ will be displayed."
(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 @@ will be displayed."
'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 @@ will be displayed."
'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 @@ will be displayed."
'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
......@@ -1672,9 +1672,10 @@ after `string'."
(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 @@ after `string'."
(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 @@ after `string'."
(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 @@ retrieved for the operator, nothing will be displayed."
;;; 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 @@ For example:
(transpose-lists (mapcar #'cdr lists))))))
(defun clear-completions ()
(when *completion-pane*
(delete-window *completion-pane*)
(setf *completion-pane* nil)))
(defun show-completions-by-fn (fn symbol package)
(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 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 @@ For example:
(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 @@ For example:
: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))
......@@ -251,9 +251,12 @@ Uses TAB-SPACE-COUNT of the STREAM-DEFAULT-VIEW of the pane."
'((#\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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment