[climacs-cvs] CVS climacs
thenriksen
thenriksen at common-lisp.net
Wed Apr 12 18:52:00 UTC 2006
Update of /project/climacs/cvsroot/climacs
In directory clnet:/tmp/cvs-serv29577
Modified Files:
lisp-syntax.lisp
Log Message:
Changed `first-form', `rest-forms' etc. to `first-noncomment',
`rest-noncomments' (since that's what the functions do).
--- /project/climacs/cvsroot/climacs/lisp-syntax.lisp 2006/04/03 20:51:51 1.47
+++ /project/climacs/cvsroot/climacs/lisp-syntax.lisp 2006/04/12 18:52:00 1.48
@@ -1080,7 +1080,7 @@
(let ((buffer (buffer syntax)))
(flet ((test (x)
(when (typep x 'complete-list-form)
- (let ((candidate (second-form (children x))))
+ (let ((candidate (second-noncomment (children x))))
(and (typep candidate 'token-mixin)
(eq (parse-symbol (coerce (buffer-sequence (buffer syntax)
(start-offset candidate)
@@ -1090,7 +1090,7 @@
(with-slots (stack-top) syntax
(let ((form (find-if #'test (children stack-top))))
(when form
- (let ((package-form (third-form (children form))))
+ (let ((package-form (third-noncomment (children form))))
(when package-form
(let ((package-name
(typecase package-form
@@ -1109,14 +1109,14 @@
(quote-form
(coerce (buffer-sequence
buffer
- (start-offset (second-form (children package-form)))
- (end-offset (second-form (children package-form))))
+ (start-offset (second-noncomment (children package-form)))
+ (end-offset (second-noncomment (children package-form))))
'string))
(uninterned-symbol-form
(coerce (buffer-sequence
buffer
- (start-offset (second-form (children package-form)))
- (end-offset (second-form (children package-form))))
+ (start-offset (second-noncomment (children package-form)))
+ (end-offset (second-noncomment (children package-form))))
'string))
(t 'nil))))
(when package-name
@@ -1150,11 +1150,11 @@
;;;
;;; accessing parser forms
-(defun first-form (list)
+(defun first-noncomment (list)
"Returns the first non-comment in list."
(find-if-not #'(lambda (item) (typep item 'comment)) list))
-(defun rest-forms (list)
+(defun rest-noncomments (list)
"Returns the remainder of the list after the first non-comment,
stripping leading comments."
(loop for rest on list
@@ -1163,7 +1163,7 @@
until (= forms 2)
finally (return rest)))
-(defun nth-form (n list)
+(defun nth-noncomment (n list)
"Returns the nth non-comment in list."
(loop for item in list
count (not (typep item 'comment))
@@ -1171,17 +1171,17 @@
until (> forms n)
finally (return item)))
-(defun elt-form (list n)
+(defun elt-noncomment (list n)
"Returns the nth non-comment in list."
- (nth-form n list))
+ (nth-noncomment n list))
-(defun second-form (list)
+(defun second-noncomment (list)
"Returns the second non-comment in list."
- (nth-form 1 list))
+ (nth-noncomment 1 list))
-(defun third-form (list)
+(defun third-noncomment (list)
"Returns the third non-comment in list."
- (nth-form 2 list))
+ (nth-noncomment 2 list))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
@@ -1372,7 +1372,7 @@
(defmethod display-parse-tree ((parse-symbol reader-conditional-positive-form)
(syntax lisp-syntax) pane)
- (let ((conditional (second-form (children parse-symbol))))
+ (let ((conditional (second-noncomment (children parse-symbol))))
(if (eval-feature-conditional conditional syntax)
(call-next-method)
(let ((*current-faces* *reader-conditional-faces*))
@@ -1381,7 +1381,7 @@
(defmethod display-parse-tree ((parse-symbol reader-conditional-negative-form)
(syntax lisp-syntax) pane)
- (let ((conditional (second-form (children parse-symbol))))
+ (let ((conditional (second-noncomment (children parse-symbol))))
(if (eval-feature-conditional conditional syntax)
(let ((*current-faces* *reader-conditional-faces*))
(with-face (:reader-conditional)
@@ -1408,10 +1408,10 @@
(defmethod eval-feature-conditional ((conditional list-form) (syntax lisp-syntax))
(let ((children (children conditional)))
- (when (third-form children)
+ (when (third-noncomment children)
(flet ((eval-fc (conditional)
(funcall #'eval-feature-conditional conditional syntax)))
- (let* ((type (second-form children))
+ (let* ((type (second-noncomment children))
(conditionals (butlast
(nthcdr
2
@@ -1473,10 +1473,10 @@
(form-before-in-children (children first) offset))))
((and (>= offset (end-offset first))
(or (null rest)
- ;; `first-form' may return NIL if there are nothing but
+ ;; `first-noncomment' may return NIL if there are nothing but
;; comments left; in that case, just take a comment
;; with `first'.
- (<= offset (start-offset (or (first-form rest)
+ (<= offset (start-offset (or (first-noncomment rest)
(first rest))))))
(return (let ((potential-form
(when (typep first 'list-form)
@@ -1680,7 +1680,7 @@
(:method (form syntax) nil))
(defmethod form-operator ((form list-form) syntax)
- (let* ((operator-token (first-form (rest (children form))))
+ (let* ((operator-token (first-noncomment (rest (children form))))
(operator-symbol (when operator-token
(token-to-symbol syntax operator-token))))
operator-symbol))
@@ -1840,8 +1840,8 @@
(and (null (cdr path)) (zerop (car path))))
(values tree 0))
((null (cdr path))
- (values (elt-form (children tree) (1- (car path))) 0))
- (t (indent-form syntax (elt-form (children tree) (car path)) (cdr path)))))
+ (values (elt-noncomment (children tree) (1- (car path))) 0))
+ (t (indent-form syntax (elt-noncomment (children tree) (car path)) (cdr path)))))
;; FIXME: The next two methods are basically identical to the above definition,
;; something should be done about this duplication.
@@ -1851,22 +1851,22 @@
(and (null (cdr path)) (zerop (car path))))
(values tree 0))
((null (cdr path))
- (values (elt-form (children tree) (1- (car path))) 0))
- (t (indent-form syntax (elt-form (children tree) (car path)) (cdr path)))))
+ (values (elt-noncomment (children tree) (1- (car path))) 0))
+ (t (indent-form syntax (elt-noncomment (children tree) (car path)) (cdr path)))))
(defmethod indent-form ((syntax lisp-syntax) (tree reader-conditional-negative-form) path)
(cond ((or (null path)
(and (null (cdr path)) (zerop (car path))))
(values tree 0))
((null (cdr path))
- (values (elt-form (children tree) (1- (car path))) 0))
- (t (indent-form syntax (elt-form (children tree) (car path)) (cdr path)))))
+ (values (elt-noncomment (children tree) (1- (car path))) 0))
+ (t (indent-form syntax (elt-noncomment (children tree) (car path)) (cdr path)))))
(defmethod indent-form ((syntax lisp-syntax) (tree list-form) path)
(if (= (car path) 1)
;; before first element
(values tree 1)
- (let ((first-child (elt-form (children tree) 1)))
+ (let ((first-child (elt-noncomment (children tree) 1)))
(cond ((and (typep first-child 'token-mixin)
(token-to-symbol syntax first-child))
(compute-list-indentation syntax (token-to-symbol syntax first-child) tree path))
@@ -1874,12 +1874,12 @@
;; top level
(if (= (car path) 2)
;; indent like first element
- (values (elt-form (children tree) 1) 0)
+ (values (elt-noncomment (children tree) 1) 0)
;; indent like second element
- (values (elt-form (children tree) 2) 0)))
+ (values (elt-noncomment (children tree) 2) 0)))
(t
;; inside a subexpression
- (indent-form syntax (elt-form (children tree) (car path)) (cdr path)))))))
+ (indent-form syntax (elt-noncomment (children tree) (car path)) (cdr path)))))))
(defmethod indent-form ((syntax lisp-syntax) (tree string-form) path)
(values tree 1))
@@ -1894,10 +1894,10 @@
(values tree 0))
(defmethod indent-form ((syntax lisp-syntax) (tree quote-form) path)
- (indent-form syntax (elt-form (children tree) (car path)) (cdr path)))
+ (indent-form syntax (elt-noncomment (children tree) (car path)) (cdr path)))
(defmethod indent-form ((syntax lisp-syntax) (tree backquote-form) path)
- (indent-form syntax (elt-form (children tree) (car path)) (cdr path)))
+ (indent-form syntax (elt-noncomment (children tree) (car path)) (cdr path)))
(defmethod indent-binding ((syntax lisp-syntax) tree path)
(if (null (cdr path))
@@ -1907,11 +1907,11 @@
(values tree 1))
((= (car path) 2)
;; between variable and value
- (values (elt-form (children tree) 1) 0))
+ (values (elt-noncomment (children tree) 1) 0))
(t
;; after value
- (values (elt-form (children tree) 2) 0)))
- (indent-form syntax (elt-form (children tree) (car path)) (cdr path))))
+ (values (elt-noncomment (children tree) 2) 0)))
+ (indent-form syntax (elt-noncomment (children tree) (car path)) (cdr path))))
(defmethod indent-bindings ((syntax lisp-syntax) tree path)
(if (null (cdr path))
@@ -1920,20 +1920,20 @@
;; before first binding, indent 1
(values tree 1)
;; after some bindings, align with first binding
- (values (elt-form (children tree) 1) 0))
+ (values (elt-noncomment (children tree) 1) 0))
;; inside a bind form
- (indent-binding syntax (elt-form (children tree) (car path)) (cdr path))))
+ (indent-binding syntax (elt-noncomment (children tree) (car path)) (cdr path))))
(defmethod compute-list-indentation ((syntax lisp-syntax) symbol tree path)
(if (null (cdr path))
;; top level
(if (= (car path) 2)
;; indent like first child
- (values (elt-form (children tree) 1) 0)
+ (values (elt-noncomment (children tree) 1) 0)
;; indent like second child
- (values (elt-form (children tree) 2) 0))
+ (values (elt-noncomment (children tree) 2) 0))
;; inside a subexpression
- (indent-form syntax (elt-form (children tree) (car path)) (cdr path))))
+ (indent-form syntax (elt-noncomment (children tree) (car path)) (cdr path))))
(defmacro define-list-indentor (name element-indentor)
`(defun ,name (syntax tree path)
@@ -1943,9 +1943,9 @@
;; indent one more than the list
(values tree 1)
;; indent like the first element
- (values (elt-form (children tree) 1) 0))
+ (values (elt-noncomment (children tree) 1) 0))
;; inside an element
- (,element-indentor syntax (elt-form (children tree) (car path)) (cdr path)))))
+ (,element-indentor syntax (elt-noncomment (children tree) (car path)) (cdr path)))))
;;; line up the elements vertically
(define-list-indentor indent-list indent-list)
@@ -1967,8 +1967,8 @@
,@(loop for fun in (cdr template)
for i from 2
collect `((= (car path) ,i)
- (,fun syntax (elt-form (children tree) ,i) (cdr path))))
- (t (indent-form syntax (elt-form (children tree) (car path)) (cdr path))))))
+ (,fun syntax (elt-noncomment (children tree) ,i) (cdr path))))
+ (t (indent-form syntax (elt-noncomment (children tree) (car path)) (cdr path))))))
(define-simple-indentor (progn))
(define-simple-indentor (prog1 indent-form))
@@ -2003,13 +2003,13 @@
(case (car path)
((2 3)
;; in the class name or superclasses respectively
- (indent-list syntax (elt-form (children tree) (car path)) (cdr path)))
+ (indent-list syntax (elt-noncomment (children tree) (car path)) (cdr path)))
(4
;; in the slot specs
- (indent-slot-specs syntax (elt-form (children tree) 4) (cdr path)))
+ (indent-slot-specs syntax (elt-noncomment (children tree) 4) (cdr path)))
(t
;; this is an approximation, might want to do better
- (indent-list syntax (elt-form (children tree) (car path)) (cdr path))))))
+ (indent-list syntax (elt-noncomment (children tree) (car path)) (cdr path))))))
(defmethod compute-list-indentation
((syntax lisp-syntax) (symbol (eql 'defgeneric)) tree path)
@@ -2019,13 +2019,13 @@
(case (car path)
(2
;; in the function name
- (indent-list syntax (elt-form (children tree) 2) (cdr path)))
+ (indent-list syntax (elt-noncomment (children tree) 2) (cdr path)))
(3
;; in the lambda-list
- (indent-ordinary-lambda-list syntax (elt-form (children tree) 3) (cdr path)))
+ (indent-ordinary-lambda-list syntax (elt-noncomment (children tree) 3) (cdr path)))
(t
;; in the options or method specifications
- (indent-list syntax (elt-form (children tree) (car path)) (cdr path))))))
+ (indent-list syntax (elt-noncomment (children tree) (car path)) (cdr path))))))
(defmethod compute-list-indentation
((syntax lisp-syntax) (symbol (eql 'defmethod)) tree path)
@@ -2040,11 +2040,11 @@
2)))
((or (null lambda-list-pos)
(< (car path) lambda-list-pos))
- (indent-list syntax (elt-form (children tree) (car path)) (cdr path)))
+ (indent-list syntax (elt-noncomment (children tree) (car path)) (cdr path)))
((= (car path) lambda-list-pos)
- (indent-ordinary-lambda-list syntax (elt-form (children tree) (car path)) (cdr path)))
+ (indent-ordinary-lambda-list syntax (elt-noncomment (children tree) (car path)) (cdr path)))
(t
- (indent-form syntax (elt-form (children tree) (car path)) (cdr path))))))
+ (indent-form syntax (elt-noncomment (children tree) (car path)) (cdr path))))))
(defun indent-clause (syntax tree path)
(if (null (cdr path))
@@ -2052,8 +2052,8 @@
(case (car path)
(1 (values tree 1))
(2 (values tree 1))
- (t (values (elt-form (children tree) 2) 0)))
- (indent-form syntax (elt-form (children tree) (car path)) (cdr path))))
+ (t (values (elt-noncomment (children tree) 2) 0)))
+ (indent-form syntax (elt-noncomment (children tree) (car path)) (cdr path))))
(defmethod compute-list-indentation
((syntax lisp-syntax) (symbol (eql 'cond)) tree path)
@@ -2063,9 +2063,9 @@
;; after `cond'
(values tree 2)
;; indent like the first clause
- (values (elt-form (children tree) 2) 0))
+ (values (elt-noncomment (children tree) 2) 0))
;; inside a clause
- (indent-clause syntax (elt-form (children tree) (car path)) (cdr path))))
+ (indent-clause syntax (elt-noncomment (children tree) (car path)) (cdr path))))
(macrolet ((def (symbol)
`(defmethod compute-list-indentation
@@ -2074,8 +2074,8 @@
(case (car path)
(2 (values tree 4))
(3 (values tree 2))
- (t (values (elt-form (children tree) 3) 0)))
- (indent-clause syntax (elt-form (children tree) (car path)) (cdr path))))))
+ (t (values (elt-noncomment (children tree) 3) 0)))
+ (indent-clause syntax (elt-noncomment (children tree) (car path)) (cdr path))))))
(def case)
(def ccase)
(def ecase)
@@ -2091,10 +2091,10 @@
;; the symbol existing in the current image. (Arguably, too,
;; this is a broken indentation form because it doesn't carry
;; over to the implicit tagbodies in macros such as DO.
- (if (typep (elt-form (children tree) (car path)) 'token-mixin)
+ (if (typep (elt-noncomment (children tree) (car path)) 'token-mixin)
(values tree 2)
(values tree 4))
- (indent-form syntax (elt-form (children tree) (car path)) (cdr path))))
+ (indent-form syntax (elt-noncomment (children tree) (car path)) (cdr path))))
(defmethod indent-local-function-definition ((syntax lisp-syntax) tree path)
(cond ((null (cdr path))
@@ -2104,14 +2104,14 @@
(values tree 1))
((= (car path) 2)
;; between name and lambda list, indent 4
- (values (elt-form (children tree) 1) 4))
+ (values (elt-noncomment (children tree) 1) 4))
(t
;; after lambda list, indent 2
- (values (elt-form (children tree) 1) 2))))
+ (values (elt-noncomment (children tree) 1) 2))))
((= (car path) 1)
;; inside lambda list
- (indent-ordinary-lambda-list syntax (elt-form (children tree) 1) (cdr path)))
- (t (indent-form syntax (elt-form (children tree) (car path)) (cdr path)))))
+ (indent-ordinary-lambda-list syntax (elt-noncomment (children tree) 1) (cdr path)))
+ (t (indent-form syntax (elt-noncomment (children tree) (car path)) (cdr path)))))
(define-list-indentor indent-local-function-definitions indent-local-function-definition)
@@ -2132,12 +2132,12 @@
(defun compute-path-in-trees (trees n offset)
(cond ((or (null trees)
- (>= (start-offset (first-form trees)) offset))
+ (>= (start-offset (first-noncomment trees)) offset))
(list n))
- ((or (< (start-offset (first-form trees)) offset (end-offset (first-form trees)))
- (typep (first-form trees) 'incomplete-form-mixin))
- (cons n (compute-path-in-tree (first-form trees) offset)))
- (t (compute-path-in-trees (rest-forms trees) (1+ n) offset))))
+ ((or (< (start-offset (first-noncomment trees)) offset (end-offset (first-noncomment trees)))
+ (typep (first-noncomment trees) 'incomplete-form-mixin))
+ (cons n (compute-path-in-tree (first-noncomment trees) offset)))
[12 lines skipped]
More information about the Climacs-cvs
mailing list