[Lisppaste-cvs] CVS update: lisppaste2/coloring-types.lisp lisppaste2/colorize.lisp

[Brian Mastenbrook]

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))