[climacs-cvs] CVS climacs

[thenriksen]

Update of /project/climacs/cvsroot/climacs
In directory clnet:/tmp/cvs-serv4377

Modified Files:
	lisp-syntax.lisp 
Log Message:
Added clear highlighting of macros and special forms.


--- /project/climacs/cvsroot/climacs/lisp-syntax.lisp	2006/04/23 21:36:23	1.57
+++ /project/climacs/cvsroot/climacs/lisp-syntax.lisp	2006/05/02 14:25:24	1.58
@@ -1294,6 +1294,17 @@
       form
       (form-toplevel (parent form) syntax)))
 
+(defgeneric operator-p (token syntax)
+  (:documentation "Return true if `token' is the operator of its form. Otherwise,
+  return nil.")
+  (:method (token syntax)
+    (with-accessors ((pre-token preceding-parse-tree)) token
+      (cond ((typep pre-token 'left-parenthesis-lexeme)
+             t)
+            ((typep pre-token 'comment)
+             (operator-p pre-token syntax))
+            (t nil)))))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
 ;;; display
@@ -1305,8 +1316,10 @@
 
 (defparameter *standard-faces*
 	      `((:error ,+red+ nil)
-		(:string ,+foreground-ink+ ,(make-text-style nil :italic nil))
+		(:string ,+coral+ ,(make-text-style nil :italic nil))
 		(:keyword ,+dark-violet+ nil)
+                (:macro ,+cyan+)
+                (:special-form ,+cyan+)
 		(:lambda-list-keyword ,+dark-green+ nil)
 		(:comment ,+maroon+ nil)
 		(:reader-conditional ,+gray50+ nil)))
@@ -1315,6 +1328,8 @@
 	      `((:error ,+red+ nil)
 		(:string ,+gray50+ ,(make-text-style nil :italic nil))
 		(:keyword ,+gray50+ nil)
+                (:macro ,+gray50+ nil)
+                (:special-form ,+gray50+ nil)
 		(:lambda-list-keyword ,+gray50+ nil)
 		(:comment ,+gray50+ nil)
 		(:reader-conditional ,+gray50+ nil)))
@@ -1399,7 +1414,7 @@
                                              (end-offset parse-symbol))
                             'string)))
         (multiple-value-bind (symbol status)
-            (token-to-symbol syntax parse-symbol)
+            (token-to-object syntax parse-symbol)
           (with-output-as-presentation
               (pane (if status symbol string) (if status 'symbol 'unknown-symbol)
                :single-box :highlighting)
@@ -1409,8 +1424,15 @@
                   ((eql (buffer-object (buffer syntax) (start-offset parse-symbol)) #\&)
                    (with-face (:lambda-list-keyword)
                      (call-next-method)))
-                  (t (call-next-method)))
-            )))
+                  ((and (macro-function symbol)
+                        (operator-p parse-symbol syntax))
+                   (with-face (:macro)
+                     (call-next-method)))
+                  ((and (special-operator-p symbol)
+                        (operator-p parse-symbol syntax))
+                   (with-face (:special-form)
+                     (call-next-method)))
+                  (t (call-next-method))))))
       (call-next-method)))
 
 (defmethod display-parse-tree ((parser-symbol lisp-lexeme) (syntax lisp-syntax) pane)