[mcclim-cvs] CVS mcclim/Drei
thenriksen
thenriksen at common-lisp.net
Thu Jan 3 21:11:41 UTC 2008
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
More information about the Mcclim-cvs
mailing list