Index: gui.lisp
===================================================================
RCS file: /project/climacs/cvsroot/climacs/gui.lisp,v
retrieving revision 1.164
diff -u -r1.164 gui.lisp
--- gui.lisp	24 Jul 2005 05:10:47 -0000	1.164
+++ gui.lisp	27 Jul 2005 13:20:55 -0000
@@ -52,6 +52,8 @@
 (define-application-frame climacs (standard-application-frame
 				   esa-frame-mixin)
   ((buffers :initform '() :accessor buffers))
+  (:command-table (global-climacs-table :inherit-from (global-esa-table)))
+  (:menu-bar nil)
   (:panes
    (win (let* ((extended-pane 
 		(make-pane 'extended-pane
@@ -159,8 +161,6 @@
 	do (when (modified-p buffer)
 	     (setf (needs-saving buffer) t))))	
 
-(make-command-table 'global-climacs-table :errorp nil :inherit-from '(global-esa-table))
-
 (defmacro define-named-command (command-name args &body body)
   `(define-command ,(if (listp command-name)
 			`(,@command-name :name t :command-table global-climacs-table)
@@ -1243,11 +1243,25 @@
 	 (package (climacs-lisp-syntax::package-of syntax)))
     (display-message (format nil "~s" package))))
 
+(define-gesture-name :select-other :pointer-button-press (:left :meta) :unique nil)
+
+(define-presentation-translator lisp-string-to-string
+    (climacs-lisp-syntax::lisp-string string global-climacs-table
+                  :gesture :select-other
+                  :tester-definitive t
+                  :menu nil
+                  :priority 10)
+    (object)
+  object)
+
 (define-named-command com-accept-string ()
   (display-message (format nil "~s" (accept 'string))))
 	 
 (define-named-command com-accept-symbol ()
   (display-message (format nil "~s" (accept 'symbol))))	 
+
+(define-named-command com-accept-lisp-string ()
+  (display-message (format nil "~s" (accept 'lisp-string))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; 
Index: lisp-syntax.lisp
===================================================================
RCS file: /project/climacs/cvsroot/climacs/lisp-syntax.lisp,v
retrieving revision 1.16
diff -u -r1.16 lisp-syntax.lisp
--- lisp-syntax.lisp	25 Jul 2005 11:04:30 -0000	1.16
+++ lisp-syntax.lisp	27 Jul 2005 13:20:57 -0000
@@ -1088,15 +1088,31 @@
   (with-drawing-options (pane :ink +red+)
     (call-next-method)))
 
+(define-presentation-type unknown-symbol () :inherit-from 'symbol
+                          :description "unknown symbol")
+
+(define-presentation-method presentation-typep (object (type unknown-symbol))
+  (or (symbolp object) (stringp object)))
+
 (defmethod display-parse-tree ((parse-symbol token-mixin) (syntax lisp-syntax) pane)
   (if (> (end-offset parse-symbol) (start-offset parse-symbol))
-      (cond ((eql (buffer-object (buffer syntax) (start-offset parse-symbol)) #\:)
-	     (with-drawing-options (pane :ink +dark-violet+)
-	       (call-next-method)))
-	    ((eql (buffer-object (buffer syntax) (start-offset parse-symbol)) #\&)
-	     (with-drawing-options (pane :ink +dark-green+)
-	       (call-next-method)))
-	    (t (call-next-method)))
+      (let ((string (coerce (buffer-sequence (buffer syntax)
+                                             (start-offset parse-symbol)
+                                             (end-offset parse-symbol))
+                            'string)))
+        (multiple-value-bind (symbol status)
+            (token-to-symbol syntax parse-symbol)
+          (with-output-as-presentation
+              (pane (if status symbol string) (if status 'symbol 'unknown-symbol)
+               :single-box :highlighting)
+            (cond ((eql (buffer-object (buffer syntax) (start-offset parse-symbol)) #\:)
+                   (with-drawing-options (pane :ink +dark-violet+)
+                     (call-next-method)))
+                  ((eql (buffer-object (buffer syntax) (start-offset parse-symbol)) #\&)
+                   (with-drawing-options (pane :ink +dark-green+)
+                     (call-next-method)))
+                  (t (call-next-method)))
+            )))
       (call-next-method)))
 
 (defmethod display-parse-tree ((parser-symbol lisp-lexeme) (syntax lisp-syntax) pane)
@@ -1118,31 +1134,46 @@
 					       (start-offset parser-symbol)
 					       (end-offset parser-symbol))
 			      'string)))
-	  (multiple-value-bind (symbol status)
-	      (token-to-symbol syntax parser-symbol)
-	    (declare (ignore symbol))
-	    (if (and status (typep parser-symbol 'form))
-		(present string 'symbol :stream pane)
-		(present string 'string :stream pane))))))))
-
+          (present string 'string :stream pane))))))
+          
 (defmethod display-parse-tree :before ((parse-symbol lisp-lexeme) (syntax lisp-syntax) pane)
   (handle-whitespace pane (buffer pane) *white-space-start* (start-offset parse-symbol))
   (setf *white-space-start* (end-offset parse-symbol)))
 
+(define-presentation-type lisp-string () 
+                          :description "lisp string")
+
 (defmethod display-parse-tree ((parse-symbol complete-string-form) (syntax lisp-syntax) pane)
   (let ((children (children parse-symbol)))
-    (display-parse-tree  (pop children) syntax pane)
-    (with-text-face (pane :italic)
-      (loop until (null (cdr children))
-	    do (display-parse-tree (pop children) syntax pane)))
-    (display-parse-tree (pop children) syntax pane)))
+    (if (third children)
+        (let ((string (coerce (buffer-sequence (buffer syntax)
+                                               (start-offset (second children))
+                                               (end-offset (car (last children 2))))
+                              'string)))
+          (with-output-as-presentation (pane string 'lisp-string
+                                             :single-box :highlighting)
+            (display-parse-tree  (pop children) syntax pane)
+            (with-text-face (pane :italic)
+              (loop until (null (cdr children))
+                 do (display-parse-tree (pop children) syntax pane)))
+            (display-parse-tree (pop children) syntax pane)))
+        (progn (display-parse-tree (pop children) syntax pane)
+               (display-parse-tree (pop children) syntax pane)))))
 
 (defmethod display-parse-tree ((parse-symbol incomplete-string-form) (syntax lisp-syntax) pane)
   (let ((children (children parse-symbol)))
-    (display-parse-tree  (pop children) syntax pane)
-    (with-text-face (pane :italic)
-      (loop until (null children)
-	    do (display-parse-tree (pop children) syntax pane)))))
+    (if (second children)
+        (let ((string (coerce (buffer-sequence (buffer syntax)
+                                               (start-offset (second children))
+                                               (end-offset (car (last children))))
+                              'string)))
+          (with-output-as-presentation (pane string 'lisp-string
+                                             :single-box :highlighting)
+            (display-parse-tree  (pop children) syntax pane)
+            (with-text-face (pane :italic)
+              (loop until (null children)
+                 do (display-parse-tree (pop children) syntax pane)))))
+        (display-parse-tree  (pop children) syntax pane))))
 
 (defmethod display-parse-tree ((parse-symbol line-comment-form) (syntax lisp-syntax) pane)
   (with-drawing-options (pane :ink +maroon+)
Index: packages.lisp
===================================================================
RCS file: /project/climacs/cvsroot/climacs/packages.lisp,v
retrieving revision 1.68
diff -u -r1.68 packages.lisp
--- packages.lisp	24 Jul 2005 05:10:48 -0000	1.68
+++ packages.lisp	27 Jul 2005 13:20:58 -0000
@@ -164,7 +164,7 @@
 (defpackage :climacs-lisp-syntax
   (:use :clim-lisp :clim :climacs-buffer :climacs-base 
 	:climacs-syntax :flexichain :climacs-pane)
-  (:export))
+  (:export :lisp-string))
 
 (defpackage :esa
   (:use :clim-lisp :clim)
@@ -180,5 +180,6 @@
 
 (defpackage :climacs-gui
   (:use :clim-lisp :clim :climacs-buffer :climacs-base :climacs-abbrev :climacs-syntax
-	:climacs-kill-ring :climacs-pane :clim-extensions :undo :esa))
+	:climacs-kill-ring :climacs-pane :clim-extensions :undo :esa)
+  (:import-from :climacs-lisp-syntax :lisp-string))
 
