Changeset 6759

Timestamp:

Jun 18, 2007, 1:40:08 AM (17 years ago)

Author:

Gary Byers

Message:

view pop-up menu, color changing stuff. Are bugs Leopard-specific ?

File:

• branches/ide-1.0/ccl/examples/cocoa-editor.lisp (modified) (7 diffs)

branches/ide-1.0/ccl/examples/cocoa-editor.lisp

@@ -637 +637 @@
 (objc:defmethod (#/changeColor: :void) ((self hemlock-textstorage-text-view)
                                         sender)
-  (#_NSLog #@"Change color to = %@" :id (#/color sender)))
+  (declare (ignorable sender))
+  #+debug (#_NSLog #@"Change color to = %@" :id (#/color sender)))
 
 (def-cocoa-default *layout-text-in-background* :int 1 "When non-zero, do text layout when idle.")
@@ -653 +654 @@
 (objc:defmethod (#/setBackgroundColor: :void)
     ((self hemlock-textstorage-text-view) color)
+  (#_NSLog #@"Set background color: %@" :id color)
   (setf (text-view-blink-color self) color)
   (call-next-method color))
@@ -754 +756 @@
 
 
+(defloadvar *text-view-context-menu* ())
+
+(defun text-view-context-menu ()
+  (or *text-view-context-menu*
+      (setq *text-view-context-menu*
+            (#/retain
+             (let* ((menu (make-instance 'ns:ns-menu :with-title #@"Menu")))
+               (#/addItemWithTitle:action:keyEquivalent:
+                menu #@"Cut" (@selector #/cut:) #@"")
+               (#/addItemWithTitle:action:keyEquivalent:
+                menu #@"Copy" (@selector #/copy:) #@"")
+               (#/addItemWithTitle:action:keyEquivalent:
+                menu #@"Paste" (@selector #/paste:) #@"")
+               ;; Separator
+               (#/addItem: menu (#/separatorItem ns:ns-menu-item))
+               (#/addItemWithTitle:action:keyEquivalent:
+                menu #@"Background Color ..." (@selector #/changeBackgroundColor:) #@"")
+               (#/addItemWithTitle:action:keyEquivalent:
+                menu #@"Text Color ..." (@selector #/changeTextColor:) #@"")
+
+               menu)))))
+
+(objc:defmethod (#/changeFont: :void)
+    ((self hemlock-text-view) sender)
+  (declare (ignorable sender))
+  (#_NSLog #@"changefont!"))
+
+
+(objc:defmethod (#/changeBackgroundColor: :void)
+    ((self hemlock-text-view) sender)
+  (let* ((colorpanel (#/sharedColorPanel ns:ns-color-panel))
+         (color (#/backgroundColor self)))
+    (#/close colorpanel)
+    (#/setAction: colorpanel (@selector #/updateBackgroundColor:))
+    (#/setColor: colorpanel color)
+    (#/setTarget: colorpanel self)
+    (#/setContinuous: colorpanel t)
+    (#/orderFrontColorPanel: *NSApp* sender)))
+
+
+
+(objc:defmethod (#/updateBackgroundColor: :void)
+    ((self hemlock-text-view) sender)
+  (let* ((color (#/color sender)))
+    (unless (typep self 'echo-area-view)
+      (let* ((echo-view (slot-value (#/window self) 'echo-area-view)))
+        (#/setBackgroundColor: echo-view color)))
+    (#/setBackgroundColor: self color)
+    (#_NSLog #@"view = %@, color = %@, background = %@" :id self :id color :id (#/backgroundColor self))
+    ))
+
+(objc:defmethod (#/changeTextColor: :void)
+    ((self hemlock-text-view) sender)
+  (let* ((colorpanel (#/sharedColorPanel ns:ns-color-panel))
+         (textstorage (#/textStorage self))
+         (color (#/objectForKey:
+                 (#/objectAtIndex: (slot-value textstorage 'styles) 0)
+                 #&NSForegroundColorAttributeName)))
+    (#/close colorpanel)
+    (#/setAction: colorpanel (@selector #/updateTextColor:))
+    (#/setColor: colorpanel color)
+    (#/setTarget: colorpanel self)
+    (#/setContinuous: colorpanel t)
+    (#/orderFrontColorPanel: *NSApp* sender)))
+
+
+
+
+
+
+   
+(objc:defmethod (#/updateTextColor: :void)
+    ((self hemlock-textstorage-text-view) sender)
+    (%call-next-objc-method
+     self
+     hemlock-textstorage-text-view
+     (@selector #/changeColor:)
+     '(:void :id)
+     sender)
+  (#/setNeedsDisplay: self t))
+   
+(objc:defmethod (#/updateTextColor: :void)
+    ((self hemlock-text-view) sender)
+  (let* ((textstorage (#/textStorage self))
+         (styles (slot-value textstorage 'styles))
+         (newcolor (#/color sender)))
+    (dotimes (i 4)
+      (let* ((dict (#/objectAtIndex: styles i)))
+        (#/setValue:forKey: dict newcolor #&NSForegroundColorAttributeName)))
+    (call-next-method sender)))
 
 
@@ -1125 +1217 @@
     pane))
 
+(objc:defmethod #/defaultMenu ((class +hemlock-text-view))
+  (text-view-context-menu))
 
 (defun make-scrolling-text-view-for-textstorage (textstorage x y width height tracks-width color style)
@@ -1169 +1263 @@
                 (#/setAllowsUndo: tv nil) ; don't want NSTextView undo
                 (#/setUsesFindPanel: tv t)
-                (#/setUsesFontPanel: tv nil)
+                (#/setUsesFontPanel: tv t)
                 (#/setWidthTracksTextView: container tracks-width)
                 (#/setHeightTracksTextView: container nil)
@@ -1278 +1372 @@
           (#/setMaxSize: echo (ns:make-ns-size large-number-for-text large-number-for-text))
           (#/setRichText: echo nil)
+          (#/setUsesFontPanel: echo nil)
           (#/setHorizontallyResizable: echo t)
           (#/setVerticallyResizable: echo nil)
@@ -1284 +1379 @@
           (#/setWidthTracksTextView: container nil)
           (#/setHeightTracksTextView: container nil)
+          (#/setMenu: echo +null-ptr+)
           (setf (hemlock-frame-echo-area-buffer the-hemlock-frame) buffer
                 (slot-value doc 'textstorage) textstorage