Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv19805
Modified Files: c-syntax.lisp c-syntax-commands.lisp Log Message: Improved, if not completely correct, list navigation.
--- /project/climacs/cvsroot/climacs/c-syntax.lisp 2007/04/27 21:39:23 1.1 +++ /project/climacs/cvsroot/climacs/c-syntax.lisp 2007/05/01 20:54:53 1.2 @@ -1045,46 +1045,65 @@ (defun form-string-p (form) (typep form 'string-form))
+(defun commentp (form) + (typep form 'comment)) + (defun top-level-vector (syntax) (coerce (children (slot-value syntax 'stack-top)) 'simple-vector))
-(defun top-level-form-before-in-vector (tlv offset) +(defun top-level-form-before-in-vector (tlv + offset + &optional ignore-comments-p) "Return top-level form in top-level-vector `tlv' around or before `offset' -together with index of form in `tlv', or nil." +together with index of form in `tlv', or nil. If `ignore-comments-p', don't +treat comments as forms." (loop for count from (1- (length tlv)) downto 0 for tlf = (aref tlv count) - when (< (start-offset tlf) offset (end-offset tlf)) + when (and (or (not ignore-comments-p) (not (commentp tlf))) + (< (start-offset tlf) offset (end-offset tlf))) return (values tlf count) - when (<= (end-offset tlf) offset) + when (and (or (not ignore-comments-p) (not (commentp tlf))) + (<= (end-offset tlf) offset)) return (values tlf count) finally (return nil)))
-(defun top-level-form-after-in-vector (tlv offset) +(defun top-level-form-after-in-vector (tlv + offset + &optional ignore-comments-p) "Return top-level form in top-level-vector `tlv' around or after `offset' -together with index of form in `tlv', or nil." +together with index of form in `tlv', or nil. If `ignore-comments-p', don't +treat comments as forms." (loop for tlf across tlv for count from 0 - when (< (start-offset tlf) offset (end-offset tlf)) + when (and (or (not ignore-comments-p) (not (commentp tlf))) + (< (start-offset tlf) offset (end-offset tlf))) return (values tlf count) - when (>= (start-offset tlf) offset) + when (and (or (not ignore-comments-p) (not (commentp tlf))) + (>= (start-offset tlf) offset)) return (values tlf count) finally (return nil)))
-(defun top-level-form-around-in-vector (tlv offset) +(defun top-level-form-around-in-vector (tlv + offset + &optional ignore-comments-p) "Return top-level form in top-level-vector `tlv' around `offset' -together with index of form in `tlv', or nil." +together with index of form in `tlv', or nil. If `ignore-comments-p', don't +treat comments as forms." (loop for tlf across tlv for count from 0 - when (< (start-offset tlf) offset (end-offset tlf)) + when (and (or (not ignore-comments-p) (not (commentp tlf))) + (< (start-offset tlf) offset (end-offset tlf))) return (values tlf count) - when (>= (start-offset tlf) offset) + when (and (or (not ignore-comments-p) (not (commentp tlf))) + (>= (start-offset tlf) offset)) return nil finally (return nil)))
-(defun form-around (syntax offset) +(defun form-around (syntax offset &optional ignore-comments-p) (top-level-form-around-in-vector (top-level-vector syntax) - offset)) + offset + ignore-comments-p))
(defgeneric opening-delimiter-p (token) (:documentation "Is `token' an opening delimiter.")) @@ -1129,7 +1148,7 @@ (defmethod backward-one-expression (mark (syntax c-syntax)) (let ((tlv (top-level-vector syntax))) (multiple-value-bind (form count) - (top-level-form-before-in-vector tlv (offset mark)) + (top-level-form-before-in-vector tlv (offset mark) t) (when form (if (closing-delimiter-p form) (loop for index from count downto 0 @@ -1150,7 +1169,7 @@ (defmethod forward-one-expression (mark (syntax c-syntax)) (let ((tlv (top-level-vector syntax))) (multiple-value-bind (form count) - (top-level-form-after-in-vector tlv (offset mark)) + (top-level-form-after-in-vector tlv (offset mark) t) (when form (if (opening-delimiter-p form) (loop for index from count below (length tlv) @@ -1184,13 +1203,13 @@ do (push match delims) when (closing-delimiter-p match) do (cond ((null delims) - (setf (offset mark) (end-offset match)) - (return t)) - (t (cond ((and (matching-delimiter-p match - (pop delims)) - (null delims)) - (setf (offset mark) (end-offset match)) - (return t)) + (return nil)) + (t (cond ((matching-delimiter-p match + (car delims)) + (pop delims) + (when (null delims) + (setf (offset mark) (end-offset match)) + (return t))) (t (return nil))))) finally (return nil))))))
@@ -1205,9 +1224,20 @@ (when form (loop for index from count downto 0 for match = (aref tlv index) + with delims = () when (closing-delimiter-p match) - do (setf (offset mark) (end-offset match)) - (return t) + do (push match delims) + when (opening-delimiter-p match) + do (cond + ((null delims) + (return nil)) + (t (cond ((matching-delimiter-p match + (car delims)) + (pop delims) + (when (null delims) + (setf (offset mark) (start-offset match)) + (return t))) + (t (return nil))))) finally (return nil))))))
(drei-motion:define-motion-fns list) @@ -1238,12 +1268,10 @@ do (cond ((null delims) (setf (offset mark) (start-offset match)) (return t)) - (t (cond ((and (matching-delimiter-p match - (pop delims)) - (null delims)) - (setf (offset mark) (start-offset match)) - (return t)) - (t (return nil))))) + ((matching-delimiter-p match + (car delims)) + (pop delims)) + (t (return nil))) finally (return nil))))))
(defmethod forward-one-down ((mark mark) (syntax c-syntax)) @@ -1272,12 +1300,10 @@ do (cond ((null delims) (setf (offset mark) (end-offset match)) (return t)) - (t (cond ((and (matching-delimiter-p match - (pop delims)) - (null delims)) - (setf (offset mark) (end-offset match)) - (return t)) - (t (return nil))))) + ((matching-delimiter-p match + (car delims)) + (pop delims)) + (t (return nil))) finally (return nil))))))
;; (defmethod backward-one-definition ((mark mark) (syntax c-syntax)) @@ -1303,20 +1329,29 @@ do (incf (offset mark2)) finally (return column))))
-(defmethod syntax-line-indentation (mark tab-width (syntax c-syntax)) - (if (typep (form-around syntax (offset mark)) 'long-comment-form) - 0 tab-width)) +(defun line-indentation (mark tab-width syntax) + "Return the column of the first non-whitespace object, or nil." + (setf mark (clone-mark mark)) + (beginning-of-line mark) + (loop until (end-of-line-p mark) + while (whitespacep syntax (object-after mark)) + with column = 0 + if (eql (object-after mark) #\Tab) + do (incf column (- tab-width (mod column tab-width))) + else + do (incf column) + do (forward-object mark) + finally (return (if (end-of-line-p mark) nil column))))
-;; (defmethod syntax-line-indentation (mark tab-width (syntax lisp-syntax)) -;; (setf mark (clone-mark mark)) -;; (beginning-of-line mark) -;; (with-slots (stack-top) syntax -;; (let ((path (compute-path syntax (offset mark)))) -;; (multiple-value-bind (tree offset) -;; (indent-form syntax stack-top path) -;; (setf (offset mark) (start-offset tree)) -;; (+ (real-column-number mark tab-width) -;; offset))))) +(defmethod syntax-line-indentation (mark tab-width (syntax c-syntax)) + (setf mark (clone-mark mark)) + (let ((this-indentation (line-indentation mark tab-width syntax))) + (beginning-of-line mark) + (loop until (beginning-of-buffer-p mark) + do (previous-line mark 0) + when (line-indentation mark tab-width syntax) + return it + finally (return this-indentation))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; --- /project/climacs/cvsroot/climacs/c-syntax-commands.lisp 2007/04/27 21:39:23 1.1 +++ /project/climacs/cvsroot/climacs/c-syntax-commands.lisp 2007/05/01 20:54:53 1.2 @@ -41,13 +41,13 @@
;; Movement commands. (drei-commands:define-motion-commands expression c-table) -(drei-commands:define-motion-commands definition c-table) -;; (drei-commands:define-motion-commands up c-table -;; :noun "nesting level up" -;; :plural "levels") -;; (drei-commands:define-motion-commands down c-table -;; :noun "nesting level down" -;; :plural "levels") +;; (drei-commands:define-motion-commands definition c-table) +(drei-commands:define-motion-commands up c-table + :noun "nesting level up" + :plural "levels") +(drei-commands:define-motion-commands down c-table + :noun "nesting level down" + :plural "levels") (drei-commands:define-motion-commands list c-table)
(drei-commands:define-editing-commands expression c-table) @@ -103,13 +103,13 @@ 'c-table '((#\q :meta :control)))
-;; (set-key `(com-backward-up ,*numeric-argument-marker*) -;; 'c-table -;; '((#\u :control :meta))) +(set-key `(com-backward-up ,*numeric-argument-marker*) + 'c-table + '((#\u :control :meta)))
-;; (set-key `(com-forward-down ,*numeric-argument-marker*) -;; 'c-table -;; '((#\d :control :meta))) +(set-key `(com-forward-down ,*numeric-argument-marker*) + 'c-table + '((#\d :control :meta)))
(set-key `(com-backward-expression ,*numeric-argument-marker*) 'c-table