Changeset 6785 for branches

Timestamp:

Jul 6, 2007, 11:58:39 AM (17 years ago)

Author:

Gary Byers

Message:

Do paren-blinking by setting temporary attributes in layout manager;
may still happen at the wrong time.

File:

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

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

@@ -655 +655 @@
     ((self hemlock-textstorage-text-view) color)
   #+debug (#_NSLog #@"Set background color: %@" :id color)
-  (setf (text-view-blink-color self) color)
+  (let* ((old (text-view-blink-color self)))
+    (unless (%null-ptr-p old)
+      (#/release old)))
+  (setf (text-view-blink-color self)
+        (#/retain (#/dictionaryWithObject:forKey:
+                                      ns:ns-dictionary
+                                      color
+                                      #&NSForegroundColorAttributeName)))
   (call-next-method color))
 
@@ -669 +676 @@
     (unless (eql #$NO (text-view-blink-enabled self))
       (let* ((layout (#/layoutManager self))
-             (container (#/textContainer self))
              (blink-color (text-view-blink-color self)))
+        #+debug (#_NSLog #@"layout = %@, blink-color = %@" :id layout :id blink-color)
         ;; We toggle the blinked character "off" by setting its
         ;; foreground color to the textview's background color.
@@ -676 +683 @@
         ;; point is drawn as "off"
         (ns:with-ns-range  (char-range (text-view-blink-location self) 1)
-          (let* ((glyph-range (#/glyphRangeForCharacterRange:actualCharacterRange:
-                               layout
-                               char-range
-                               +null-ptr+)))
-            #+debug (#_NSLog #@"Flag = %d, location = %d" :<BOOL> (if flag #$YES #$NO) :int (text-view-blink-location self))
-            (let* ((rect (#/boundingRectForGlyphRange:inTextContainer:
-                          layout
-                          glyph-range
-                          container)))
-              (#/set blink-color)
-              (#_NSRectFill rect))
           (if flag
-            (#/drawGlyphsForGlyphRange:atPoint: layout glyph-range (#/textContainerOrigin self)))))))
+            (#/setTemporaryAttributes:forCharacterRange: layout blink-color char-range)
+            (#/removeTemporaryAttribute:forCharacterRange: layout #&NSForegroundColorAttributeName char-range)))))
     (call-next-method r color flag)))
                 
 (defmethod disable-blink ((self hemlock-textstorage-text-view))
+  #+debug
+  (when (#/editingInProgress (#/textStorage self))
+    (#_NSLog #@"disable-blink: editing in progress"))
   (when (eql (text-view-blink-enabled self) #$YES)
     (setf (text-view-blink-enabled self) #$NO)
     ;; Force the blinked character to be redrawn.  Let the text
     ;; system do the drawing.
-    (#/invalidateDisplayForCharacterRange: (#/layoutManager self) (ns:make-ns-range (text-view-blink-location self) 1))))
+    (#/removeTemporaryAttribute:forCharacterRange: (#/layoutManager self) #&NSForegroundColorAttributeName (ns:make-ns-range (text-view-blink-location self) 1))))
 
 (defmethod update-blink ((self hemlock-textstorage-text-view))
@@ -706 +706 @@
              (point (hi::buffer-point buffer)))
         #+debug (#_NSLog #@"Syntax check for blinking")
+        (update-buffer-package (hi::buffer-document buffer) buffer)
+          
         (cond ((eql (hi::next-character point) #\()
                (hemlock::pre-command-parse-check point)
@@ -792 +794 @@
     (#/setColor: colorpanel color)
     (#/setTarget: colorpanel self)
-    (#/setContinuous: colorpanel t)
+    (#/setContinuous: colorpanel nil)
     (#/orderFrontColorPanel: *NSApp* sender)))
 
@@ -799 +801 @@
 (objc:defmethod (#/updateBackgroundColor: :void)
     ((self hemlock-text-view) sender)
-  (let* ((color (#/color sender)))
-    (unless (typep self 'echo-area-view)
-      (let* ((window (#/window self))
-             (echo-view (unless (%null-ptr-p window)
-                          (slot-value window 'echo-area-view))))
-        (when echo-view (#/setBackgroundColor: echo-view color))))
-    (#/setBackgroundColor: self color)))
+  (when (#/isVisible sender)
+    (let* ((color (#/color sender)))
+      (unless (typep self 'echo-area-view)
+        (let* ((window (#/window self))
+               (echo-view (unless (%null-ptr-p window)
+                            (slot-value window 'echo-area-view))))
+          (when echo-view (#/setBackgroundColor: echo-view color))))
+      (#_NSLog #@"Updating backgroundColor to %@, sender = %@" :id color :id sender)
+      (#/setBackgroundColor: self color))))
 
 (objc:defmethod (#/changeTextColor: :void)
@@ -818 +822 @@
     (#/setColor: colorpanel color)
     (#/setTarget: colorpanel self)
-    (#/setContinuous: colorpanel t)
+    (#/setContinuous: colorpanel nil)
     (#/orderFrontColorPanel: *NSApp* sender)))
 
@@ -1220 +1224 @@
   (text-view-context-menu))
 
+;;; If we don't override this, NSTextView will start adding Google/
+;;; Spotlight search options and dictionary lookup when a selection
+;;; is active.
+(objc:defmethod #/menuForEvent: ((self hemlock-text-view) event)
+  (declare (ignore event))
+  (#/menu self))
+
 (defun make-scrolling-text-view-for-textstorage (textstorage x y width height tracks-width color style)
   (let* ((scrollview (#/autorelease
@@ -1264 +1275 @@
                 (#/setUsesFindPanel: tv t)
                 (#/setUsesFontPanel: tv t)
+                (#/setMenu: tv (text-view-context-menu))
                 (#/setWidthTracksTextView: container tracks-width)
                 (#/setHeightTracksTextView: container nil)
@@ -1316 +1328 @@
     ((textstorage :foreign-type :id))
   (:metaclass ns:+ns-object))
+
+(defmethod update-buffer-package ((doc echo-area-document) buffer)
+  (declare (ignore buffer)))
 
 (objc:defmethod (#/close :void) ((self echo-area-document))
@@ -1465 +1480 @@
              #|(*debug-io* *typeout-stream*)|#)
         (stream-clear-output *debug-io*)
-        (print-call-history :detailed-p t)
+        (ignore-errors (print-call-history :detailed-p t))
         (#/performSelectorOnMainThread:withObject:waitUntilDone:
          frame (@selector #/runErrorSheet:) params t)
@@ -1888 +1903 @@
   (:metaclass ns:+ns-object))
 
+(defmethod update-buffer-package ((doc hemlock-editor-document) buffer)
+  (let* ((name (hemlock::package-at-mark (hi::buffer-point buffer))))
+    (when name
+      (let* ((pkg (find-package name)))
+        (if pkg
+          (setq name (shortest-package-name pkg))))
+      (let* ((curname (hi::variable-value 'hemlock::current-package :buffer buffer)))
+        (if (or (null curname)
+                (not (string= curname name)))
+          (setf (hi::variable-value 'hemlock::current-package :buffer buffer) name))))))
 
 (objc:defmethod (#/validateMenuItem: :<BOOL>)
@@ -2039 +2064 @@
   (call-next-method path type save-operation))
 
-;;; This should be a preference.
+(def-cocoa-default *editor-keep-backup-files* :bool t "maintain backup files")
+
 (objc:defmethod (#/keepBackupFile :<BOOL>) ((self hemlock-editor-document))
-  t)
+  *editor-keep-backup-files*)