[Openmcl-cvs-notifications] r12494 - /trunk/source/cocoa-ide/cocoa-editor.lisp

[gb at clozure.com]

Author: gb
Date: Fri Jul 31 08:24:00 2009
New Revision: 12494

Log:
Separate #+/#-cocotron versions of #/initWithString:, for now.

I have no idea what happened to the welcome banner in the listener.

Modified:
    trunk/source/cocoa-ide/cocoa-editor.lisp

Modified: trunk/source/cocoa-ide/cocoa-editor.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/cocoa-ide/cocoa-editor.lisp (original)
+++ trunk/source/cocoa-ide/cocoa-editor.lisp Fri Jul 31 08:24:00 2009
@@ -701,6 +701,23 @@
                (hi::buffer-document buffer)))))))
    +null-ptr+))
 =

+
+#-cocotron
+(objc:defmethod #/initWithString: ((self hemlock-text-storage) s)
+  (setq s (%inc-ptr s 0))
+  (let* ((newself (#/init self))
+         (styles (make-editor-style-map))
+         (mirror (make-instance ns:ns-mutable-attributed-string
+                                   :with-string s
+                                   :attributes (#/objectAtIndex: styles 0)=
)))
+    (declare (type hemlock-text-storage newself))
+    (setf (slot-value newself 'styles) styles)
+    (setf (slot-value newself 'hemlock-string) s)
+    (setf (slot-value newself 'mirror) mirror)
+    (setf (slot-value newself 'string) (#/retain (#/string mirror)))
+    newself))
+
+#+cocotron
 (objc:defmethod #/initWithString: ((self hemlock-text-storage) s)
   (setq s (%inc-ptr s 0))
   (let* ((styles (make-editor-style-map))