Index: /branches/ide-1.0/ccl/examples/cocoa-editor.lisp =================================================================== --- /branches/ide-1.0/ccl/examples/cocoa-editor.lisp (revision 6784) +++ /branches/ide-1.0/ccl/examples/cocoa-editor.lisp (revision 6785) @@ -655,5 +655,12 @@ ((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,6 +676,6 @@ (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,25 +683,18 @@ ;; 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" : (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,4 +706,6 @@ (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,5 +794,5 @@ (#/setColor: colorpanel color) (#/setTarget: colorpanel self) - (#/setContinuous: colorpanel t) + (#/setContinuous: colorpanel nil) (#/orderFrontColorPanel: *NSApp* sender))) @@ -799,11 +801,13 @@ (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,5 +822,5 @@ (#/setColor: colorpanel color) (#/setTarget: colorpanel self) - (#/setContinuous: colorpanel t) + (#/setContinuous: colorpanel nil) (#/orderFrontColorPanel: *NSApp* sender))) @@ -1220,4 +1224,11 @@ (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,4 +1275,5 @@ (#/setUsesFindPanel: tv t) (#/setUsesFontPanel: tv t) + (#/setMenu: tv (text-view-context-menu)) (#/setWidthTracksTextView: container tracks-width) (#/setHeightTracksTextView: container nil) @@ -1316,4 +1328,7 @@ ((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,5 +1480,5 @@ #|(*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,4 +1903,14 @@ (: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: :) @@ -2039,7 +2064,8 @@ (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 :) ((self hemlock-editor-document)) - t) + *editor-keep-backup-files*)