Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv11688

Modified Files: lisp-syntax.lisp Log Message: Added greying-out of readmacro conditionalized forms.

Also added *climacs-features*, which is initialized from *features*, and which lives (for the moment) in the climacs-gui package, so Eval Expression can easily manipulate it.

Date: Mon Aug 8 10:53:30 2005 Author: dmurray

Index: climacs/lisp-syntax.lisp diff -u climacs/lisp-syntax.lisp:1.21 climacs/lisp-syntax.lisp:1.22 --- climacs/lisp-syntax.lisp:1.21 Fri Aug 5 10:21:04 2005 +++ climacs/lisp-syntax.lisp Mon Aug 8 10:53:30 2005 @@ -1183,7 +1183,56 @@ (defmethod display-parse-tree ((parse-symbol long-comment-form) (syntax lisp-syntax) pane) (with-drawing-options (pane :ink +maroon+) (call-next-method))) - + +(defmethod display-parse-tree ((parse-symbol reader-conditional-positive-form) + (syntax lisp-syntax) pane) + (let ((conditional (second (children parse-symbol)))) + (if (eval-feature-conditional conditional syntax) + (call-next-method) + (with-drawing-options (pane :ink +gray50+) + (call-next-method))))) + +(defmethod display-parse-tree ((parse-symbol reader-conditional-negative-form) + (syntax lisp-syntax) pane) + (let ((conditional (second (children parse-symbol)))) + (if (eval-feature-conditional conditional syntax) + (with-drawing-options (pane :ink +gray50+) + (call-next-method)) + (call-next-method)))) + +(defparameter climacs-gui::*climacs-features* (copy-list *features*)) + +(defgeneric eval-feature-conditional (conditional-form syntax)) + +;; Adapted from slime.el + +(defmethod eval-feature-conditional ((conditional token-mixin) (syntax lisp-syntax)) + (let* ((string (coerce (buffer-sequence (buffer syntax) + (start-offset conditional) + (end-offset conditional)) + 'string)) + (symbol (parse-symbol string keyword-package))) + (member symbol climacs-gui::*climacs-features*))) + +(defmethod eval-feature-conditional ((conditional list-form) (syntax lisp-syntax)) + (let ((children (children conditional))) + (when (third children) + (flet ((eval-fc (conditional) + (funcall #'eval-feature-conditional conditional syntax))) + (let* ((type (second children)) + (conditionals (butlast (nthcdr 2 children))) + (type-string (coerce (buffer-sequence (buffer syntax) + (start-offset type) + (end-offset type)) + 'string)) + (type-symbol (parse-symbol type-string keyword-package))) + (case type-symbol + (:and (funcall #'every #'eval-fc conditionals)) + (:or (funcall #'some #'eval-fc conditionals)) + (:not (when conditionals + (funcall #'(lambda (f l) (not (apply f l))) + #'eval-fc conditionals))))))))) + (defmethod display-parse-tree ((parse-symbol complete-list-form) (syntax lisp-syntax) pane) (let ((children (children parse-symbol))) (if (= (end-offset parse-symbol) (offset (point pane)))