Update of /project/mcclim/cvsroot/mcclim/Drei
In directory clnet:/tmp/cvs-serv17253
Modified Files:
lisp-syntax.lisp lisp-syntax-swine.lisp
lisp-syntax-commands.lisp
Log Message:
Fixed some bugs in Lisp syntax and swapped the order of some arguments
for better consistency.
--- /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax.lisp 2007/01/31 14:31:59 1.20
+++ /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax.lisp 2007/02/06 09:25:08 1.21
@@ -1612,7 +1612,7 @@
;;;
;;; Useful functions for selecting forms based on the mark.
-(defun expression-at-mark (mark-or-offset syntax)
+(defun expression-at-mark (syntax mark-or-offset)
"Return the form at `mark-or-offset'. If `mark-or-offset' is just after,
or inside, a top-level-form, or if there are no forms after
`mark-or-offset', the form preceding `mark-or-offset' is
@@ -1623,7 +1623,7 @@
(form-after syntax offset)
(form-before syntax offset))))
-(defun definition-at-mark (mark-or-offset syntax)
+(defun definition-at-mark (syntax mark-or-offset)
"Return the top-level form at `mark-or-offset'. If `mark-or-offset' is just after,
or inside, a top-level-form, or if there are no forms after
`mark-or-offset', the top-level-form preceding `mark-or-offset'
@@ -1631,16 +1631,20 @@
`mark-or-offset' is returned."
(form-toplevel (expression-at-mark mark-or-offset syntax) syntax))
-(defun symbol-at-mark (mark-or-offset syntax)
+(defun symbol-at-mark (syntax mark-or-offset
+ &optional (form-fetcher 'expression-at-mark))
"Return a symbol token at `mark-or-offset'. This function will
- \"unwrap\" quote-forms in order to return the symbol token. If
- no symbol token can be found, NIL will be returned."
- (labels ((unwrap-form (form)
- (cond ((form-quoted-p form)
- (unwrap-form (first-form (children form))))
- ((form-token-p form)
- form))))
- (unwrap-form (expression-at-mark mark-or-offset syntax))))
+\"unwrap\" quote-forms in order to return the symbol token. If no
+symbol token can be found, NIL will be returned. `Form-fetcher'
+must be a function with the same signature as `expression-at-mark', and
+will be used to retrieve the initial form at `mark'."
+ (as-offsets (mark-or-offset)
+ (labels ((unwrap-form (form)
+ (cond ((form-quoted-p form)
+ (unwrap-form (first-form (children form))))
+ ((form-token-p form)
+ form))))
+ (unwrap-form (funcall form-fetcher syntax mark-or-offset)))))
(defun fully-quoted-form (token)
"Return the top token object for `token', return `token' or the
@@ -1660,34 +1664,34 @@
(t form))))
(descend token)))
-(defun this-form (mark-or-offset syntax)
+(defun this-form (syntax mark-or-offset)
"Return a form at `mark-or-offset'. This function defines which
forms the COM-FOO-this commands affect."
(as-offsets ((offset mark-or-offset))
(or (form-around syntax offset)
(form-before syntax offset))))
-(defun preceding-form (mark-or-offset syntax)
+(defun preceding-form (syntax mark-or-offset)
"Return a form at `mark-or-offset'."
(as-offsets ((offset mark-or-offset))
(or (form-before syntax offset)
(form-around syntax offset))))
-(defun text-of-definition-at-mark (mark syntax)
+(defun text-of-definition-at-mark (syntax mark)
"Return the text of the definition at mark."
(let ((definition (definition-at-mark mark syntax)))
(buffer-substring (buffer mark)
(start-offset definition)
(end-offset definition))))
-(defun text-of-expression-at-mark (mark-or-offset syntax)
+(defun text-of-expression-at-mark (syntax mark-or-offset)
"Return the text of the expression at `mark-or-offset'."
(let ((expression (expression-at-mark mark-or-offset syntax)))
(form-string syntax expression)))
-(defun symbol-name-at-mark (mark-or-offset syntax)
+(defun symbol-name-at-mark (syntax mark-or-offset)
"Return the text of the symbol at `mark-or-offset'."
- (let ((token (symbol-at-mark mark-or-offset syntax)))
+ (let ((token (symbol-at-mark syntax mark-or-offset)))
(when token (form-string syntax token))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -1731,14 +1735,23 @@
;;;
;;; Useful functions for modifying forms based on the mark.
-(defun replace-symbol-at-mark (mark syntax string)
- "Replace the symbol at `mark' with `string' and move `mark' to
-after `string'."
- (let ((token (symbol-at-mark mark syntax)))
- (setf (offset mark) (start-offset token))
- (forward-delete-expression mark syntax)
+(defgeneric replace-symbol-at-mark (syntax mark string)
+ (:documentation "Replace the symbol around `mark' with `string'
+and move `mark' to after `string'. If there is no symbol at
+`mark', insert `string' and move `mark' anyway."))
+
+(defmethod replace-symbol-at-mark ((syntax lisp-syntax) (mark mark)
+ (string string))
+ (let ((token (symbol-at-mark syntax mark #'form-around)))
+ (when (and token (form-token-p token))
+ (setf (offset mark) (start-offset token))
+ (forward-delete-expression mark syntax))
(insert-sequence mark string)))
+(defmethod replace-symbol-at-mark :after ((syntax lisp-syntax)
+ (mark left-sticky-mark) (string string))
+ (forward-object mark (length string)))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; display
--- /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax-swine.lisp 2006/12/10 19:28:49 1.4
+++ /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax-swine.lisp 2007/02/06 09:25:08 1.5
@@ -539,12 +539,16 @@
(>= (+ index
difference)
key-position)
- (evenp (- index (- key-position
- (1- difference)))))
+ (let ((offset (- index (- key-position (1- difference)))))
+ (or (evenp offset) (zerop key-position))))
(mapcar #'unlisted (subseq cleaned-arglist
- (+ (- key-position
- difference)
- (if rest-position 2 1))))))))
+ (+ (max (- key-position
+ difference)
+ (- (if rest-position 2 1)))
+ (if rest-position 2 1))
+ (if rest-position
+ (1- (length cleaned-arglist))
+ (length cleaned-arglist))))))))
(defgeneric possible-completions (syntax operator string package operands indices)
(:documentation "Get the applicable completions for completing
@@ -554,7 +558,8 @@
object), and which has the operands `operands'. `Indices' should
be the argument indices from the operator to `token' (see
`find-argument-indices-for-operands').")
- (:method (syntax operator string package operands indices)
+ (:method ((syntax lisp-syntax) operator (string string)
+ (package package) (operands list) (indices list))
(let ((completions (first (simple-completions (get-usable-image syntax)
string package))))
;; Welcome to the ugly mess! Part of the uglyness is that we
@@ -778,7 +783,7 @@
`(let* ((,form-sym
;; Find a form with a valid (fboundp) operator.
(let ((immediate-form
- (preceding-form ,mark-or-offset ,syntax)))
+ (preceding-form ,syntax ,mark-or-offset)))
(unless (null immediate-form)
(or (find-applicable-form ,syntax immediate-form)
;; If nothing else can be found, and `arg-form'
@@ -1000,13 +1005,13 @@
(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 `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. 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."
+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. 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)
@@ -1015,36 +1020,34 @@
(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)))
+ (cond (useful-token
+ (start-offset (fully-quoted-form token)))
+ ((and (form-quoted-p token)
+ (form-incomplete-p token))
+ (start-offset token))
+ (t (offset mark)))
(if useful-token
(form-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"))))))
+ (cond ((null completions)
+ (esa:display-message "No completions found")
+ nil)
+ ((endp (rest completions))
+ (replace-symbol-at-mark syntax mark longest)
+ t)
+ (t (replace-symbol-at-mark
+ syntax mark
+ (or (menu-choose (mapcar
+ #'(lambda (completion)
+ (if (listp completion)
+ (cons completion
+ (first completion))
+ completion))
+ completions)
+ :label "Possible completions"
+ :scroll-bars :vertical)
+ longest))
+ t))))))
(defun complete-symbol-at-mark (syntax mark &optional (complete-blank t))
"Attempt to find and complete the symbol at `mark'. If the
--- /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax-commands.lisp 2007/01/10 20:54:13 1.5
+++ /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax-commands.lisp 2007/02/06 09:25:08 1.6
@@ -96,7 +96,7 @@
(buffer (buffer pane))
(syntax (syntax buffer))
(mark (point pane))
- (token (this-form mark syntax)))
+ (token (this-form syntax mark)))
(if (and token (form-token-p token))
(com-lookup-arglist (form-to-object syntax token))
(display-message "Could not find symbol at point."))))
@@ -134,7 +134,7 @@
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*))
+ (complete-symbol-at-mark *current-syntax* *current-point*))
(define-command (com-fuzzily-complete-symbol :name t :command-table lisp-table)
()
@@ -144,7 +144,7 @@
the abbreviation is ambiguous, 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."
- (fuzzily-complete-symbol-at-mark *current-syntax* *current-mark*))
+ (fuzzily-complete-symbol-at-mark *current-syntax* *current-point*))
(define-command (com-indent-line-and-complete-symbol :name t :command-table lisp-table) ()
"Indents the current line and performs symbol completion.
