[climacs-cvs] CVS update: climacs/lisp-syntax.lisp
Dave Murray
dmurray at common-lisp.net
Tue Aug 9 15:21:08 UTC 2005
Update of /project/climacs/cvsroot/climacs
In directory common-lisp.net:/tmp/cvs-serv6379
Modified Files:
lisp-syntax.lisp
Log Message:
Added support for ,@ and ,. forms, and some rudimentary 'face' code.
Now colours most reader-conditionals appropriately. Work still needed.
Date: Tue Aug 9 17:21:07 2005
Author: dmurray
Index: climacs/lisp-syntax.lisp
diff -u climacs/lisp-syntax.lisp:1.22 climacs/lisp-syntax.lisp:1.23
--- climacs/lisp-syntax.lisp:1.22 Mon Aug 8 10:53:30 2005
+++ climacs/lisp-syntax.lisp Tue Aug 9 17:21:07 2005
@@ -169,6 +169,8 @@
(defclass quote-lexeme (lisp-lexeme) ())
(defclass backquote-lexeme (lisp-lexeme) ())
(defclass comma-lexeme (lisp-lexeme) ())
+(defclass comma-at-lexeme (lisp-lexeme) ())
+(defclass comma-dot-lexeme (lisp-lexeme) ())
(defclass form-lexeme (form lisp-lexeme) ())
(defclass character-lexeme (form-lexeme) ())
(defclass function-lexeme (lisp-lexeme) ())
@@ -230,7 +232,14 @@
(make-instance 'line-comment-start-lexeme))
(#\" (fo) (make-instance 'string-start-lexeme))
(#\` (fo) (make-instance 'backquote-lexeme))
- (#\, (fo) (make-instance 'comma-lexeme))
+ (#\, (fo)
+ (cond ((end-of-buffer-p scan)
+ (make-instance 'error-lexeme))
+ (t
+ (case (object-after scan)
+ (#\@ (fo) (make-instance 'comma-at-lexeme))
+ (#\. (fo) (make-instance 'comma-dot-lexeme))
+ (t (make-instance 'comma-lexeme))))))
(#\# (fo)
(cond ((end-of-buffer-p scan)
(make-instance 'error-lexeme))
@@ -718,6 +727,8 @@
(define-parser-state |, form | (lexer-toplevel-state parser-state) ())
(define-new-lisp-state (form-may-follow comma-lexeme) |, |)
+(define-new-lisp-state (form-may-follow comma-at-lexeme) |, |)
+(define-new-lisp-state (form-may-follow comma-dot-lexeme) |, |)
(define-new-lisp-state (|, | form) |, form |)
;;; reduce according to the rule form -> , form
@@ -1040,6 +1051,35 @@
(defvar *cursor-positions* nil)
(defvar *current-line* 0)
+(defparameter *standard-faces*
+ `((:error ,+red+ nil)
+ (:string ,+foreground-ink+ ,(make-text-style nil :italic nil))
+ (:keyword ,+dark-violet+ nil)
+ (:lambda-list-keyword ,+dark-green+ nil)
+ (:comment ,+maroon+ nil)
+ (:reader-conditional ,+gray50+ nil)))
+
+(defparameter *reader-conditional-faces*
+ `((:error ,+red+ nil)
+ (:string ,+foreground-ink+ ,(make-text-style nil :italic nil))
+ (:keyword ,+gray50+ nil)
+ (:lambda-list-keyword ,+gray50+ nil)
+ (:comment ,+maroon+ nil)
+ (:reader-conditional ,+gray50+ nil)))
+
+(defvar *current-faces* nil)
+
+(defun face-colour (type)
+ (first (cdr (assoc type *current-faces*))))
+
+(defun face-style (type)
+ (second (cdr (assoc type *current-faces*))))
+
+(defmacro with-face ((face) &body body)
+ `(with-drawing-options (pane :ink (face-colour ,face)
+ :text-style (face-style ,face))
+ , at body))
+
(defun handle-whitespace (pane buffer start end)
(let ((space-width (space-width pane))
(tab-width (tab-width pane)))
@@ -1081,12 +1121,12 @@
(if (and (null (cdr children))
(not (typep (parser-state parse-symbol) 'error-state)))
(display-parse-tree (car children) syntax pane)
- (with-drawing-options (pane :ink +red+)
+ (with-face (:error)
(loop for child in children
do (display-parse-tree child syntax pane))))))
(defmethod display-parse-tree ((parse-symbol error-lexeme) (syntax lisp-syntax) pane)
- (with-drawing-options (pane :ink +red+)
+ (with-face (:error)
(call-next-method)))
(define-presentation-type unknown-symbol () :inherit-from 'symbol
@@ -1107,10 +1147,10 @@
(pane (if status symbol string) (if status 'symbol 'unknown-symbol)
:single-box :highlighting)
(cond ((eql (buffer-object (buffer syntax) (start-offset parse-symbol)) #\:)
- (with-drawing-options (pane :ink +dark-violet+)
+ (with-face (:keyword)
(call-next-method)))
((eql (buffer-object (buffer syntax) (start-offset parse-symbol)) #\&)
- (with-drawing-options (pane :ink +dark-green+)
+ (with-face (:lambda-list-keyword)
(call-next-method)))
(t (call-next-method)))
)))
@@ -1154,8 +1194,8 @@
(with-output-as-presentation (pane string 'lisp-string
:single-box :highlighting)
(display-parse-tree (pop children) syntax pane)
- (with-text-face (pane :italic)
- (loop until (null (cdr children))
+ (with-face (:string)
+ (loop until (null (cdr children))
do (display-parse-tree (pop children) syntax pane)))
(display-parse-tree (pop children) syntax pane)))
(progn (display-parse-tree (pop children) syntax pane)
@@ -1171,17 +1211,17 @@
(with-output-as-presentation (pane string 'lisp-string
:single-box :highlighting)
(display-parse-tree (pop children) syntax pane)
- (with-text-face (pane :italic)
+ (with-face (:string)
(loop until (null children)
do (display-parse-tree (pop children) syntax pane)))))
(display-parse-tree (pop children) syntax pane))))
(defmethod display-parse-tree ((parse-symbol line-comment-form) (syntax lisp-syntax) pane)
- (with-drawing-options (pane :ink +maroon+)
+ (with-face (:comment)
(call-next-method)))
(defmethod display-parse-tree ((parse-symbol long-comment-form) (syntax lisp-syntax) pane)
- (with-drawing-options (pane :ink +maroon+)
+ (with-face (:comment)
(call-next-method)))
(defmethod display-parse-tree ((parse-symbol reader-conditional-positive-form)
@@ -1189,21 +1229,26 @@
(let ((conditional (second (children parse-symbol))))
(if (eval-feature-conditional conditional syntax)
(call-next-method)
- (with-drawing-options (pane :ink +gray50+)
- (call-next-method)))))
+ (let ((*current-faces* *reader-conditional-faces*))
+ (with-face (:reader-conditional)
+ (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))
+ (let ((*current-faces* *reader-conditional-faces*))
+ (with-face (:reader-conditional)
+ (call-next-method)))
(call-next-method))))
(defparameter climacs-gui::*climacs-features* (copy-list *features*))
(defgeneric eval-feature-conditional (conditional-form syntax))
+(defmethod eval-feature-conditional (conditional-form (syntax lisp-syntax))
+ nil)
+
;; Adapted from slime.el
(defmethod eval-feature-conditional ((conditional token-mixin) (syntax lisp-syntax))
@@ -1249,8 +1294,9 @@
*current-line* 0
(aref *cursor-positions* 0) (stream-cursor-position pane))
(setf *white-space-start* (offset top)))
- (with-slots (stack-top) syntax
- (display-parse-tree stack-top syntax pane))
+ (let ((*current-faces* *standard-faces*))
+ (with-slots (stack-top) syntax
+ (display-parse-tree stack-top syntax pane)))
(with-slots (top) pane
(let* ((cursor-line (number-of-lines-in-region top (point pane)))
(style (medium-text-style pane))
More information about the Climacs-cvs
mailing list