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.