[mcclim-cvs] CVS mcclim/Drei
thenriksen
thenriksen at common-lisp.net
Mon Jan 7 15:32:15 UTC 2008
Update of /project/mcclim/cvsroot/mcclim/Drei
In directory clnet:/tmp/cvs-serv17553/Drei
Modified Files:
lisp-syntax.lisp lr-syntax.lisp
Log Message:
Made parenmatching more elegant by sprinling the magic dust of refactoring.
--- /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax.lisp 2008/01/07 12:00:43 1.53
+++ /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax.lisp 2008/01/07 15:32:15 1.54
@@ -1841,19 +1841,18 @@
: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)
+ (complete-token-form (:function #'(lambda (view form)
+ (cond ((symbol-form-is-keyword-p (syntax view) form)
keyword-drawing-options)
- ((symbol-form-is-macrobound-p syntax form)
+ ((symbol-form-is-macrobound-p (syntax view) form)
macro-drawing-options)
- ((symbol-form-is-boundp syntax form)
+ ((symbol-form-is-boundp (syntax view) form)
bound-drawing-options)
(t +default-drawing-options+)))))
- (parenthesis-lexeme (:function #'(lambda (syntax form)
- (declare (ignore syntax))
- ;; XXX: Using (point) here may be hacky.
- (if (and (or (mark= (point) (start-offset (parent form)))
- (mark= (point) (end-offset (parent form))))
+ (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)))
highlighted-parenthesis-options
+default-drawing-options+))))))
--- /project/mcclim/cvsroot/mcclim/Drei/lr-syntax.lisp 2008/01/04 14:12:48 1.9
+++ /project/mcclim/cvsroot/mcclim/Drei/lr-syntax.lisp 2008/01/07 15:32:15 1.10
@@ -431,29 +431,30 @@
draw the parser symbol.
`:function', in which case `args' must be a single element, a
- function that takes two arguments. These arguments are 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."
+ 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."
(check-type name symbol)
`(progn
(fmakunbound ',name)
- (defgeneric ,name (syntax parser-symbol)
- (:method (syntax (parser-symbol parser-symbol))
+ (defgeneric ,name (view parser-symbol)
+ (:method (view (parser-symbol parser-symbol))
nil))
,@(flet ((make-rule-exp (type args)
(ecase type
- (:face `#'(lambda (syntax parser-symbol)
- (declare (ignore syntax parser-symbol))
- (make-drawing-options :face (make-face , at args))))
- (:options `#'(lambda (syntax parser-symbol)
- (declare (ignore syntax parser-symbol))
+ (:face `(let ((options (make-drawing-options :face (make-face , at args))))
+ #'(lambda (view parser-symbol)
+ (declare (ignore view parser-symbol))
+ options)))
+ (:options `#'(lambda (view parser-symbol)
+ (declare (ignore view parser-symbol))
(make-drawing-options , at args)))
(:function (first args)))))
(loop for (parser-symbol (type . args)) in rules
collect `(let ((rule ,(make-rule-exp type args)))
- (defmethod ,name (syntax (parser-symbol ,parser-symbol))
- (funcall rule syntax parser-symbol)))))))
+ (defmethod ,name (view (parser-symbol ,parser-symbol))
+ (funcall rule view parser-symbol)))))))
(make-syntax-highlighting-rules default-syntax-highlighting)
@@ -465,11 +466,13 @@
(:method ((syntax lr-syntax-mixin))
'default-syntax-highlighting))
-(defun get-drawing-options (highlighting-rules syntax parse-symbol)
+(defun get-drawing-options (highlighting-rules view parse-symbol)
"Get the drawing options with which `parse-symbol' should be
-drawn. If `parse-symbol' or the stack-top of syntax, return NIL."
- (when (and parse-symbol (not (eq (stack-top syntax) parse-symbol)))
- (funcall highlighting-rules syntax parse-symbol)))
+drawn. If `parse-symbol' or the stack-top of syntax, return
+NIL. `View' must be a `drei-syntax-view' containing a syntax that
+`highlighting-rules' supports."
+ (when (and parse-symbol (not (eq (stack-top (syntax view)) parse-symbol)))
+ (funcall highlighting-rules view parse-symbol)))
(defstruct (pump-state
(:constructor make-pump-state
@@ -493,7 +496,7 @@
(if (null parser-symbol)
(cons (size (buffer view)) +default-drawing-options+)
(let ((drawing-options
- (get-drawing-options highlighting-rules syntax parser-symbol)))
+ (get-drawing-options highlighting-rules view parser-symbol)))
(if (null drawing-options)
(initial-drawing-options (parent parser-symbol))
(cons (end-offset parser-symbol) drawing-options))))))
@@ -502,7 +505,7 @@
(cons (1+ (size (buffer view))) +default-drawing-options+))
highlighting-rules))))
-(defun find-next-stroke-end (syntax pump-state)
+(defun find-next-stroke-end (view pump-state)
"Assuming that `pump-state' contains the previous pump state,
find out where the next stroke should end, and possibly push some
drawing options onto `pump-state'."
@@ -511,7 +514,7 @@
(drawing-options pump-state-drawing-options)
(highlighting-rules pump-state-highlighting-rules))
pump-state
- (let ((line (line-containing-offset syntax offset)))
+ (let ((line (line-containing-offset (syntax view) offset)))
(flet ((finish (offset symbol &optional stroke-drawing-options)
(setf start-symbol symbol)
(loop until (> (car (first drawing-options)) offset)
@@ -530,7 +533,7 @@
(t
(or (do-parse-symbols-forward (symbol offset start-symbol)
(let ((symbol-drawing-options
- (get-drawing-options highlighting-rules syntax symbol)))
+ (get-drawing-options highlighting-rules view symbol)))
(cond ((> (start-offset symbol) (line-end-offset line))
(finish (line-end-offset line) start-symbol))
((and (typep symbol 'literal-object-mixin))
@@ -564,7 +567,7 @@
(current-drawing-options pump-state-drawing-options))
pump-state
(let ((old-drawing-options (cdr (first current-drawing-options)))
- (end-offset (find-next-stroke-end syntax pump-state)))
+ (end-offset (find-next-stroke-end view pump-state)))
(setf (stroke-start-offset stroke) offset
(stroke-end-offset stroke) end-offset
(stroke-drawing-options stroke) old-drawing-options
More information about the Mcclim-cvs
mailing list