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

Modified Files: lisp-syntax.lisp packages.lisp Log Message: Modified Lisp syntax to always convert complete-token-lexemes to complete-token-forms.

Used this to implement nifty new highlighting rules for Lisp syntax.

Also implemented alternative syntax highlighting rules, (setf drei-lisp-syntax:*syntax-highlighting-rules* 'drei-lisp-syntax:retro-highlighting) to enable it.

--- /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax.lisp 2008/01/03 21:11:40 1.46 +++ /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax.lisp 2008/01/04 21:11:36 1.47 @@ -309,10 +309,10 @@ (defclass pathname-start-lexeme (lisp-lexeme) ()) (defclass undefined-reader-macro-lexeme (lisp-lexeme) ()) (defclass bit-vector-form (form-lexeme complete-form-mixin) ()) -(defclass number-lexeme (complete-token-lexeme) ()) (defclass token-mixin () ()) +(defclass number-lexeme (token-mixin form-lexeme complete-form-mixin) ()) (defclass literal-object-form (form-lexeme complete-form-mixin literal-object-mixin) ()) -(defclass complete-token-lexeme (token-mixin form-lexeme complete-form-mixin) ()) +(defclass complete-token-lexeme (token-mixin lisp-lexeme) ()) (defclass multiple-escape-start-lexeme (lisp-lexeme) ()) (defclass multiple-escape-end-lexeme (lisp-lexeme) ()) (defclass incomplete-lexeme (lisp-lexeme incomplete-form-mixin) ()) @@ -845,16 +845,25 @@

;;; parse trees (defclass token-form (form token-mixin) ()) -(defclass complete-token-form (token-form complete-form-mixin) ()) +(defclass complete-token-form (token-form complete-form-mixin) + ((%keyword-symbol-p :accessor keyword-symbol-p) + (%macroboundp :accessor macroboundp) + (%global-boundp :accessor global-boundp))) (defclass incomplete-token-form (token-form incomplete-form-mixin) ())

+(define-parser-state | complete-lexeme | (lexer-list-state parser-state) ()) (define-parser-state | m-e-start text* | (lexer-escaped-token-state parser-state) ()) (define-parser-state | m-e-start text* m-e-end | (lexer-toplevel-state parser-state) ())

+(define-new-lisp-state (form-may-follow complete-token-lexeme) | complete-lexeme |) (define-new-lisp-state (form-may-follow multiple-escape-start-lexeme) | m-e-start text* |) (define-new-lisp-state (| m-e-start text* | text-lexeme) | m-e-start text* |) (define-new-lisp-state (| m-e-start text* | multiple-escape-end-lexeme) | m-e-start text* m-e-end |)

+;;; reduce according to the rule form -> complete-lexeme +(define-lisp-action (| complete-lexeme | t) + (reduce-until-type complete-token-form complete-token-lexeme)) + ;;; reduce according to the rule form -> m-e-start text* m-e-end (define-lisp-action (| m-e-start text* m-e-end | t) (reduce-until-type complete-token-form multiple-escape-start-lexeme)) @@ -1778,16 +1787,71 @@ ;;; ;;; display

-;; Note that we do not colour keyword symbols or special forms yet, -;; that is because the only efficient way to do so is to mark them as -;; interesting in the parser itself, it is too slow to check for it in -;; highlighting rules. -(make-syntax-highlighting-rules emacs-style-highlighting - (error-symbol (:face :ink +red+)) - (string-form (:face :ink +rosy-brown+ - :style (make-text-style nil :italic nil))) - (comment (:face :ink +maroon+ :style (make-text-style :serif :bold :large))) - (literal-object-form (:options :function (object-drawer)))) +(defun cache-symbol-info (syntax symbol-form) + "Cache information about the symbol `symbol-form' represents, +so that it can be quickly looked up later." + ;; We don't use `form-to-object' as we want to retrieve information + ;; even about symbol that are not interned. + (multiple-value-bind (symbol package) + (parse-symbol (form-string syntax symbol-form) :package *package*) + (setf (keyword-symbol-p symbol-form) (eq package +keyword-package+) + (macroboundp symbol-form) (or (special-operator-p symbol) + (macro-function symbol)) + (global-boundp symbol-form) (and (boundp symbol) + (not (constantp symbol)))))) + +(defun symbol-form-is-keyword-p (syntax symbol-form) + "Return true if `symbol-form' represents a keyword symbol." + (if (slot-boundp symbol-form '%keyword-symbol-p) + (keyword-symbol-p symbol-form) + (progn (cache-symbol-info syntax symbol-form) + (keyword-symbol-p symbol-form)))) + +(defun symbol-form-is-macrobound-p (syntax symbol-form) + "Return true if `symbol-form' represents a symbol bound to a +macro or special form." + (if (slot-boundp symbol-form '%macroboundp) + (macroboundp symbol-form) + (progn (cache-symbol-info syntax symbol-form) + (macroboundp symbol-form)))) + +(defun symbol-form-is-boundp (syntax symbol-form) + "Return true if `symbol-form' represents a symbol that is +`boundp' and is not a constant." + (if (slot-boundp symbol-form '%global-boundp) + (global-boundp symbol-form) + (progn (cache-symbol-info syntax symbol-form) + (global-boundp symbol-form)))) + +(let ((keyword-drawing-options (make-drawing-options :face (make-face :ink +orchid+))) + (macro-drawing-options (make-drawing-options :face (make-face :ink +purple+))) + (bound-drawing-options (make-drawing-options :face (make-face :ink +darkgoldenrod+)))) + (make-syntax-highlighting-rules emacs-style-highlighting + (error-symbol (:face :ink +red+)) + (string-form (:face :ink +rosy-brown+ + :style (make-text-style nil :italic nil))) + (comment (:face :ink +maroon+ :style (make-text-style :serif :bold :large))) + (literal-object-form (:options :function (object-drawer))) + (complete-token-form (:function #'(lambda (syntax form) + (cond ((symbol-form-is-keyword-p syntax form) + keyword-drawing-options) + ((symbol-form-is-macrobound-p syntax form) + macro-drawing-options) + ((symbol-form-is-boundp syntax form) + bound-drawing-options) + (t +default-drawing-options+))))))) + +(let ((macro-drawing-options (make-drawing-options :face (make-face :style (make-text-style nil :bold nil))))) + (make-syntax-highlighting-rules retro-highlighting + (error-symbol (:face :ink +red+)) + (string-form (:face :style (make-text-style nil :italic nil))) + (comment (:face :style (make-text-style nil nil nil) + :ink +dimgray+)) + (literal-object-form (:options :function (object-drawer))) + (complete-token-form (:function #'(lambda (syntax form) + (cond ((symbol-form-is-macrobound-p syntax form) + macro-drawing-options) + (t +default-drawing-options+)))))))

(defparameter *syntax-highlighting-rules* 'emacs-style-highlighting "The syntax highlighting rules used for highlighting Lisp @@ -2798,16 +2862,6 @@

;;; The atom(-ish) forms.

-(defmethod form-to-object ((syntax lisp-syntax) (form complete-token-lexeme) - &key read (case (readtable-case *readtable*)) - &allow-other-keys) - (multiple-value-bind (symbol package status) - (parse-symbol (form-string syntax form) - :package *package* :case case) - (values (cond ((and read (null status)) - (intern (symbol-name symbol) package)) - (t symbol))))) - (defmethod form-to-object ((syntax lisp-syntax) (form complete-token-form) &key read (case (readtable-case *readtable*)) &allow-other-keys) --- /project/mcclim/cvsroot/mcclim/Drei/packages.lisp 2008/01/03 12:32:08 1.30 +++ /project/mcclim/cvsroot/mcclim/Drei/packages.lisp 2008/01/04 21:11:39 1.31 @@ -608,7 +608,12 @@

;; Conditions. #:form-conversion-error - #:invalid-lambda-list) + #:invalid-lambda-list + + ;; Configuration + #:*syntax-highlighting-rules* + #:emacs-style-highlighting + #:retro-highlighting) (:shadow clim:form) (:documentation "Implementation of the syntax module used for editing Common Lisp code."))