Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv2665
Modified Files: coloring-types.lisp colorize.lisp Log Message: Smarter ObjC colorization
Date: Tue Nov 16 23:27:31 2004 Author: bmastenbrook
Index: lisppaste2/coloring-types.lisp diff -u lisppaste2/coloring-types.lisp:1.11 lisppaste2/coloring-types.lisp:1.12 --- lisppaste2/coloring-types.lisp:1.11 Tue Nov 16 22:55:51 2004 +++ lisppaste2/coloring-types.lisp Tue Nov 16 23:27:31 2004 @@ -268,7 +268,8 @@ "switch" "typedef" "union" "unsigned" "void" "volatile" "while" "__restrict" "_Bool"))
-(defvar *c-terminators* '(#\space #\return #\tab #\newline #. #/ #- #* #+ #{ #} #( #) #' #" #[ #] #< #> ##)) +(defparameter *c-begin-word* "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_0123456789") +(defparameter *c-terminators* '(#\space #\return #\tab #\newline #. #/ #- #* #+ #{ #} #( #) #' #" #[ #] #< #> ##))
(define-coloring-type :basic-c "Basic C" :modes (:normal :comment :word-ish :paren-ish :string :char :single-escape :preprocessor) @@ -276,7 +277,7 @@ :invisible t :transitions ((:normal - ((scan-any "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_0123456789") + ((scan-any *c-begin-word*) (set-mode :word-ish :until (scan-any *c-terminators*) :advancing nil)) @@ -426,19 +427,64 @@ s) s)))))
-(define-coloring-type :objective-c "Objective C" - :autodetect (lambda (text) (search "mac" text :test #'char=)) +(let ((terminate-next nil)) + (define-coloring-type :objective-c "Objective C" + :autodetect (lambda (text) (search "mac" text :test #'char=)) + :modes (:begin-message-send :end-message-send) + :transitions + ((:normal + ((scan #[) + (set-mode :begin-message-send + :until (advance 1) + :advancing nil)) + ((scan #]) + (set-mode :end-message-send + :until (advance 1) + :advancing nil)) + ((scan-any *c-begin-word*) + (set-mode :word-ish + :until (or + (and (peek-any '(#:)) + (setf terminate-next t)) + (and terminate-next (progn + (setf terminate-next nil) + (advance 1))) + (scan-any *c-terminators*)) + :advancing nil))) + (:word-ish + #+nil + ((scan #:) + (format t "hi~%") + (set-mode :word-ish :until (advance 1) :advancing nil) + (setf terminate-next t)))) :parent :c++ + :formatter-variables ((is-keyword nil) (in-message-send nil)) :formatters - ((:word-ish + ((:begin-message-send + (lambda (type s) + (setf is-keyword nil) + (setf in-message-send t) + (call-formatter (cons :paren-ish type) s))) + (:end-message-send + (lambda (type s) + (setf is-keyword nil) + (setf in-message-send nil) + (call-formatter (cons :paren-ish type) s))) + (:word-ish (lambda (type s) (declare (ignore type)) - (let ((result (if (find-package :cocoa-lookup) - (funcall (symbol-function (intern "SYMBOL-LOOKUP" :cocoa-lookup)) - s)))) - (if result - (format nil "<a href="~A" class="symbol">~A</a>" - result (call-parent-formatter)) - (if (member s *c-reserved-words* :test #'string=) - (format nil "<span class="symbol">~A</span>" s) - s))))))) + (prog1 + (let ((result (if (find-package :cocoa-lookup) + (funcall (symbol-function (intern "SYMBOL-LOOKUP" :cocoa-lookup)) + s)))) + (if result + (format nil "<a href="~A" class="symbol">~A</a>" + result s) + (if (member s *c-reserved-words* :test #'string=) + (format nil "<span class="symbol">~A</span>" s) + (if in-message-send + (if is-keyword + (format nil "<span class="keyword">~A</span>" s) + s) + s)))) + (setf is-keyword (not is-keyword)))))))) \ No newline at end of file
Index: lisppaste2/colorize.lisp diff -u lisppaste2/colorize.lisp:1.5 lisppaste2/colorize.lisp:1.6 --- lisppaste2/colorize.lisp:1.5 Thu Jul 15 14:36:49 2004 +++ lisppaste2/colorize.lisp Tue Nov 16 23:27:31 2004 @@ -64,7 +64,7 @@ `(labels ((advance (,num) (setf ,position-place (+ ,position-place ,num)) t) - (scan-any (,items &key ,not-preceded-by) + (peek-any (,items &key ,not-preceded-by) (incf *scan-calls*) (let* ((,items (if (stringp ,items) (coerce ,items 'list) ,items)) @@ -98,13 +98,16 @@ t) t) nil) - (progn - (advance (length ,item)) - t) + ,item (progn (and *reset-position* (setf ,position-place *reset-position*)) nil))))) + (scan-any (,items &key ,not-preceded-by) + (let ((,item (peek-any ,items :not-preceded-by ,not-preceded-by))) + (and ,item (advance (length ,item))))) + (peek (,item &key ,not-preceded-by) + (peek-any (list ,item) :not-preceded-by ,not-preceded-by)) (scan (,item &key ,not-preceded-by) (scan-any (list ,item) :not-preceded-by ,not-preceded-by))) (macrolet ((set-mode (,new-mode &key ,until (,advancing t))