[mcclim-cvs] CVS mcclim/Drei

[thenriksen]

Update of /project/mcclim/cvsroot/mcclim/Drei
In directory clnet:/tmp/cvs-serv22310/Drei

Modified Files:
	drawing-options.lisp lisp-syntax.lisp lr-syntax.lisp 
	packages.lisp 
Log Message:
My last commit was a broken monster, here's the rest.


--- /project/mcclim/cvsroot/mcclim/Drei/drawing-options.lisp	2008/01/07 22:37:17	1.1
+++ /project/mcclim/cvsroot/mcclim/Drei/drawing-options.lisp	2008/01/07 22:55:11	1.2
@@ -57,7 +57,9 @@
 
 ;;; Some drawing options for specific syntactical elements,
 ;;; approximately like GNU Emacs. These are not constants, as users
-;;; may want to change them to fit their colour scheme.
+;;; may want to change them to fit their colour scheme. Of course,
+;;; syntax highlighting rules are free to ignore these, but I think
+;;; the default rules should at least use these.
 
 (defvar *keyword-drawing-options* (make-drawing-options :face (make-face :ink +orchid+))
   "The drawing options used for drawing the syntactical
@@ -75,3 +77,17 @@
 somehow special. In Lisp, this is used for globally bound
 non-constant variables with dynamic scope. In other language, it
 should probably be used for global variables or similar.")
+
+(defvar *string-drawing-options* (make-drawing-options
+                                  :face (make-face :ink +rosy-brown+
+                                                   :style +italic-face-style+))
+  "The drawing options used for syntax-highlighting strings.")
+
+(defvar *comment-drawing-options* (make-drawing-options
+                                   :face (make-face :ink +maroon+
+                                                    :style (make-text-style nil :bold nil)))
+  "The drawing options used for drawing comments in source
+code.")
+
+(defvar *error-drawing-options* (make-drawing-options :face (make-face :ink +red+))
+  "The drawing options used for drawing syntax errors.")
--- /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax.lisp	2008/01/07 22:37:17	1.56
+++ /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax.lisp	2008/01/07 22:55:11	1.57
@@ -1832,10 +1832,9 @@
              (global-boundp symbol-form))))
 
 (define-syntax-highlighting-rules emacs-style-highlighting
-  (error-lexeme (:face :ink +red+))
-  (string-form (:face :ink +rosy-brown+
-                      :style +italic-face-style+))
-  (comment (:face :ink +maroon+ :style (make-text-style :serif :bold :large)))
+  (error-lexeme (*error-drawing-options*))
+  (string-form (*string-drawing-options*))
+  (comment (*comment-drawing-options*))
   (literal-object-form (:options :function (object-drawer)))
   (complete-token-form (:function #'(lambda (view form)
                                       (cond ((symbol-form-is-keyword-p (syntax view) form)
@@ -1854,14 +1853,22 @@
                                          +default-drawing-options+)))))
 
 (define-syntax-highlighting-rules retro-highlighting
-  (error-symbol (:face :ink +red+))
+  (error-symbol (*error-drawing-options*))
   (string-form (:face :style +italic-face-style+))
   (comment (:face :ink +dimgray+))
   (literal-object-form (:options :function (object-drawer)))
   (complete-token-form (:function #'(lambda (syntax form)
                                       (cond ((symbol-form-is-macrobound-p syntax form)
                                              +bold-face-drawing-options+)
-                                            (t +default-drawing-options+))))))
+                                            (t +default-drawing-options+)))))
+  ;; XXX: Ugh, copied from above.
+  (parenthesis-lexeme (:function #'(lambda (view form)
+                                     (if (and (typep view 'point-mark-view)
+                                              (or (mark= (point view) (start-offset (parent form)))
+                                                  (mark= (point view) (end-offset (parent form))))
+                                              (form-complete-p (parent form)))
+                                         +bold-face-drawing-options+
+                                         +default-drawing-options+)))))
 
 (defparameter *syntax-highlighting-rules* 'emacs-style-highlighting
   "The syntax highlighting rules used for highlighting Lisp
--- /project/mcclim/cvsroot/mcclim/Drei/lr-syntax.lisp	2008/01/07 22:05:22	1.12
+++ /project/mcclim/cvsroot/mcclim/Drei/lr-syntax.lisp	2008/01/07 22:55:11	1.13
@@ -420,7 +420,7 @@
 `parser-symbol' is a type that might be encountered in a parse
 tree for the syntax. The rule specifies how to highlight that
 kind of object (and all its children). `Type' can be one of three
-symbols.
+special symbols.
 
   `:face', in which case `args' will be used as arguments to a
   call to `make-face'. The resulting face will be used to draw
@@ -434,7 +434,11 @@
   function that takes two arguments. These arguments are the view
   of the syntax and the parser symbol, and the return value of
   this function is the `drawing-options' object that will be used
-  to draw the parser-symbol."
+  to draw the parser-symbol.
+
+Alternatively, `type' can be any object (usually a dynamically
+bound symbol), in which case it will be evaluated to get the
+drawing options."
   (check-type name symbol)
   `(progn
      (fmakunbound ',name)
@@ -442,7 +446,7 @@
        (:method (view (parser-symbol parser-symbol))
          nil))
      ,@(flet ((make-rule-exp (type args)
-                             (ecase type
+                             (case type
                                (:face `(let ((options (make-drawing-options :face (make-face , at args))))
                                          #'(lambda (view parser-symbol)
                                              (declare (ignore view parser-symbol))
@@ -450,7 +454,10 @@
                                (:options `#'(lambda (view parser-symbol)
                                               (declare (ignore view parser-symbol))
                                               (make-drawing-options , at args)))
-                               (:function (first args)))))
+                               (:function (first args))
+                               (t `#'(lambda (view parser-symbol)
+                                       (declare (ignore view parser-symbol))
+                                       ,type)))))
              (loop for (parser-symbol (type . args)) in rules
                 collect `(let ((rule ,(make-rule-exp type args)))
                            (defmethod ,name (view (parser-symbol ,parser-symbol))
--- /project/mcclim/cvsroot/mcclim/Drei/packages.lisp	2008/01/07 22:37:17	1.36
+++ /project/mcclim/cvsroot/mcclim/Drei/packages.lisp	2008/01/07 22:55:11	1.37
@@ -270,6 +270,9 @@
            #:*keyword-drawing-options*
            #:*special-operator-drawing-options*
            #:*special-variable-drawing-options*
+           #:*string-drawing-options*
+           #:*comment-drawing-options*
+           #:*error-drawing-options*
 
            ;; DREI program interface stuff.
            #:with-drei-options