Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv26101
Modified Files: packages.lisp core.lisp Log Message: Fixed `delete-indentation', added `join-line' and exported some more symbols from DREI-LISP-SYNTAX.
--- /project/mcclim/cvsroot/mcclim/Drei/packages.lisp 2007/01/15 11:35:54 1.12 +++ /project/mcclim/cvsroot/mcclim/Drei/packages.lisp 2007/02/13 12:14:12 1.13 @@ -410,6 +410,7 @@ #:indent-region #:fill-line #:fill-region #:indent-line #:delete-indentation + #:join-line #:set-syntax
#:*killed-rectangle* @@ -445,7 +446,8 @@ #:edit-definition #:form #:form-to-object - #:form-conversion-error) + #:form-conversion-error + #:forward-one-list #:backward-one-list #:forward-list #:backward-list) (:shadow clim:form) (:documentation "Implementation of the syntax module used for editing Common Lisp code.")) --- /project/mcclim/cvsroot/mcclim/Drei/core.lisp 2007/02/12 19:32:58 1.4 +++ /project/mcclim/cvsroot/mcclim/Drei/core.lisp 2007/02/13 12:14:12 1.5 @@ -294,11 +294,33 @@ (let ((working-mark (clone-mark mark))) (beginning-of-line working-mark) (let ((end-offset (loop for offset from (offset working-mark) below (size *current-buffer*) - unless (whitespacep syntax (buffer-object *current-buffer* offset)) + for buffer-object = (buffer-object *current-buffer* offset) + until (char= buffer-object #\Newline) + unless (whitespacep syntax buffer-object) return offset))) (when end-offset (delete-region working-mark end-offset)))))
+(defgeneric join-line (syntax mark) + (:documentation "Join the line that `mark' is in to the +previous line, and remove whitespace objects at the join +point. `Syntax' is used for judging what a whitespace character +is.")) + +(defmethod join-line ((syntax syntax) (mark mark)) + (beginning-of-line mark) + (unless (beginning-of-buffer-p mark) + (delete-range mark -1) + (loop until (end-of-buffer-p mark) + while (whitespacep syntax (object-after mark)) + do (delete-range mark 1)) + (loop until (beginning-of-buffer-p mark) + while (whitespacep syntax (object-before mark)) + do (delete-range mark -1)) + (when (and (not (beginning-of-buffer-p mark)) + (constituentp (object-before mark))) + (insert-object mark #\Space)))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Syntax handling