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

Modified Files: lisp-syntax.lisp lr-syntax.lisp Log Message: Improved support for non-character buffer objects.

Now treated properly by Lisp syntax, and hopefully properly displayed by LR syntax code.

--- /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax.lisp 2008/01/03 12:32:08 1.45 +++ /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax.lisp 2008/01/03 21:11:40 1.46 @@ -275,6 +275,7 @@ (face)))

(defclass error-lexeme (lisp-lexeme) ()) +(defclass literal-object-lexeme (lisp-lexeme literal-object-mixin) ()) (defclass left-parenthesis-lexeme (lisp-lexeme) ()) (defclass simple-vector-start-lexeme (lisp-lexeme) ()) (defclass right-parenthesis-lexeme (lisp-lexeme) ()) @@ -295,6 +296,7 @@ (defclass string-end-lexeme (lisp-lexeme) ()) (defclass word-lexeme (lisp-lexeme) ()) (defclass delimiter-lexeme (lisp-lexeme) ()) +(defclass literal-object-delimiter-lexeme (delimiter-lexeme literal-object-lexeme) ()) (defclass text-lexeme (lisp-lexeme) ()) (defclass sharpsign-equals-lexeme (lisp-lexeme) ()) (defclass sharpsign-sharpsign-form (form-lexeme complete-form-mixin) ()) @@ -309,7 +311,7 @@ (defclass bit-vector-form (form-lexeme complete-form-mixin) ()) (defclass number-lexeme (complete-token-lexeme) ()) (defclass token-mixin () ()) -(defclass literal-object-form (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 multiple-escape-start-lexeme (lisp-lexeme) ()) (defclass multiple-escape-end-lexeme (lisp-lexeme) ()) @@ -473,7 +475,10 @@ (not (constituentp (object-after scan)))) do (fo)) (make-instance 'word-lexeme)) - (t (fo) (make-instance 'delimiter-lexeme)))))) + (t (fo) (make-instance + (if (characterp object) + 'delimiter-lexeme + 'literal-object-delimiter-lexeme)))))))

(defmethod lex ((syntax lisp-syntax) (state lexer-long-comment-state) scan) (flet ((fo () (forward-object scan))) @@ -495,7 +500,10 @@ (not (constituentp (object-after scan)))) do (fo)) (make-instance 'word-lexeme)) - (t (fo) (make-instance 'delimiter-lexeme)))))) + (t (fo) (make-instance + (if (characterp object) + 'delimiter-lexeme + 'literal-object-delimiter-lexeme)))))))

(defmethod skip-inter ((syntax lisp-syntax) (state lexer-line-comment-state) scan) (macrolet ((fo () `(forward-object scan))) @@ -513,7 +521,10 @@ (not (constituentp (object-after scan)))) do (fo)) (make-instance 'word-lexeme)) - (t (fo) (make-instance 'delimiter-lexeme))))) + (t (fo) (make-instance + (if (characterp (object-before scan)) + 'delimiter-lexeme + 'literal-object-delimiter-lexeme))))))

(defun lex-token (syntax scan) ;; May need more work. Can recognize symbols and numbers. This can @@ -1775,7 +1786,8 @@ (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)))) + (comment (:face :ink +maroon+ :style (make-text-style :serif :bold :large))) + (literal-object-form (:options :function (object-drawer))))

(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/03 12:32:08 1.7 +++ /project/mcclim/cvsroot/mcclim/Drei/lr-syntax.lisp 2008/01/03 21:11:40 1.8 @@ -91,6 +91,10 @@ (preceding-parse-tree :initform nil :reader preceding-parse-tree) (parser-state :initform nil :initarg :parser-state :reader parser-state)))

+(defclass literal-object-mixin () () + (:documentation "Mixin for parser symbols representing +literal (non-character) objects in the buffer.")) + (defmethod start-offset ((state parser-symbol)) (let ((mark (start-mark state))) (when mark @@ -517,29 +521,39 @@ drawing-options)) (return-from find-next-stroke-end offset))) - (if (null start-symbol) - ;; This means that all remaining lines are blank. - (finish (line-end-offset line) nil) - (or (do-parse-symbols-forward (symbol offset start-symbol) - (let ((symbol-drawing-options - (get-drawing-options highlighting-rules syntax symbol))) - (cond ((> (start-offset symbol) (line-end-offset line)) - (finish (line-end-offset line) start-symbol)) - ((and (> (start-offset symbol) offset) - (not (drawing-options-equal (or symbol-drawing-options - +default-drawing-options+) - (cdr (first drawing-options))))) - (finish (start-offset symbol) symbol symbol-drawing-options)) - ((and (= (start-offset symbol) offset) - (offset-beginning-of-line-p (buffer syntax) offset) - (and symbol-drawing-options - (not (drawing-options-equal symbol-drawing-options - (cdr (first drawing-options)))))) - (finish (start-offset symbol) symbol symbol-drawing-options))))) - ;; If there are no more parse symbols, we just go - ;; line-by-line from here. This should mean that all - ;; remaining lines are blank. - (finish (line-end-offset line) nil))))))) + (cond ((null start-symbol) + ;; This means that all remaining lines are blank. + (finish (line-end-offset line) nil)) + ((and (typep start-symbol 'literal-object-mixin) + (= offset (start-offset start-symbol))) + (finish (end-offset start-symbol) start-symbol nil)) + (t + (or (do-parse-symbols-forward (symbol offset start-symbol) + (let ((symbol-drawing-options + (get-drawing-options highlighting-rules syntax symbol))) + (cond ((> (start-offset symbol) (line-end-offset line)) + (finish (line-end-offset line) start-symbol)) + ((and (typep symbol 'literal-object-mixin)) + (finish (start-offset symbol) symbol + (or (get-drawing-options highlighting-rules syntax symbol) + (make-drawing-options :function (object-drawer))))) + ((and (> (start-offset symbol) offset) + (not (drawing-options-equal (or symbol-drawing-options + +default-drawing-options+) + (cdr (first drawing-options)))) + (if (null symbol-drawing-options) + (>= (start-offset symbol) (car (first drawing-options))) + t)) + (finish (start-offset symbol) symbol symbol-drawing-options)) + ((and (= (start-offset symbol) offset) + symbol-drawing-options + (not (drawing-options-equal symbol-drawing-options + (cdr (first drawing-options))))) + (finish (start-offset symbol) symbol symbol-drawing-options))))) + ;; If there are no more parse symbols, we just go + ;; line-by-line from here. This should mean that all + ;; remaining lines are blank. + (finish (line-end-offset line) nil))))))))

(defmethod stroke-pump-with-syntax ((view textual-drei-syntax-view) (syntax lr-syntax-mixin) stroke