Changeset 11293


Ignore:
Timestamp:
Nov 3, 2008, 12:41:18 PM (11 years ago)
Author:
gb
Message:

Do matching-paren highlighting by setting the background color of
both matching parens. It's not clear that the recent changes to
try to make blinking work worked that much better or (since they
depended on undocumented behavior of the insertion-point blinking
code) if they'd continue to work on future OS releases.

The background color (which should ultimately be a preference)
is a sort of blue-green; if it was a little lighter than it is,
contrast with black text might be better. I'm not sure how
easy it'd be to draw the background rectangle inset by a pixel
or two; that might also look a little better. (I don't think that
the current scheme looks grossly bad, just thinking about what
might be easier on the eyes.)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/cocoa-ide/cocoa-editor.lisp

    r11037 r11293  
    855855;;; An abstract superclass of the main and echo-area text views.
    856856(defclass hemlock-textstorage-text-view (ns::ns-text-view)
    857     ((blink-location :foreign-type :unsigned :accessor text-view-blink-location)
    858      (blink-color-attribute :foreign-type :id :accessor text-view-blink-color)
    859      (blink-enabled :foreign-type :<BOOL> :accessor text-view-blink-enabled)
    860      (blink-phase :foreign-type :<BOOL> :accessor text-view-blink-phase)
     857    ((paren-highlight-left-pos :foreign-type #>NSUInteger :accessor text-view-paren-highlight-left-pos)
     858     (paren-highlight-right-pos :foreign-type #>NSUInteger :accessor text-view-paren-highlight-right-pos)
     859     (paren-highlight-color-attribute :foreign-type :id :accessor text-view-paren-highlight-color)
     860     (paren-highlight-enabled :foreign-type #>BOOL :accessor text-view-paren-highlight-enabled)
    861861     (peer :foreign-type :id))
    862862  (:metaclass ns:+ns-object))
     
    881881  #+debug (log-debug "deactivating ~s" self)
    882882  (assume-not-editing self)
    883   (setf (text-view-blink-phase self) #$NO)
    884   (disable-blink self)
    885   (#/setSelectable: self nil))
     883  (#/setSelectable: self nil)
     884  (disable-paren-highlight self))
    886885
    887886(defmethod eventqueue-abort-pending-p ((self hemlock-textstorage-text-view))
     
    987986    (#/setDelegate: layout +null-ptr+)
    988987    (#/setBackgroundLayoutEnabled: layout nil)))
    989    
     988
     989(defloadvar *paren-highlight-background-color* ())
     990
     991(defun paren-highlight-background-color ()
     992  (or *paren-highlight-background-color*
     993      (setq *paren-highlight-background-color*
     994            (#/retain (#/colorWithCalibratedRed:green:blue:alpha:
     995                       ns:ns-color
     996                       .3
     997                       .875
     998                       .8125
     999                       1.0)))))
     1000                                                       
    9901001;;; Note changes to the textview's background color; record them
    991 ;;; as the value of the "temporary" foreground color (for blinking).
     1002;;; as the value of the "temporary" foreground color (for paren-highlighting).
    9921003(objc:defmethod (#/setBackgroundColor: :void)
    9931004    ((self hemlock-textstorage-text-view) color)
    9941005  #+debug (#_NSLog #@"Set background color: %@" :id color)
    995   (let* ((old (text-view-blink-color self)))
     1006  (let* ((old (text-view-paren-highlight-color self)))
    9961007    (unless (%null-ptr-p old)
    9971008      (#/release old)))
    998   (setf (text-view-blink-color self) (#/retain color))
     1009  (setf (text-view-paren-highlight-color self) (paren-highlight-background-color))
    9991010  (call-next-method color))
    10001011
    1001 ;;; Maybe cause 1 character in the textview to blink (by drawing an empty
    1002 ;;; character rectangle) in synch with the insertion point.
    1003 
    1004 (objc:defmethod (#/drawInsertionPointInRect:color:turnedOn: :void)
    1005     ((self hemlock-textstorage-text-view)
    1006      (r :<NSR>ect)
    1007      color
    1008      (flag :<BOOL>))
    1009   (unless (or (not (eq ccl::*current-process* ccl::*initial-process*))
    1010               (#/editingInProgress (#/textStorage self)))
    1011     (unless (eql #$NO (text-view-blink-enabled self))
    1012       #+debug (#_NSLog #@"Flag = %@" :id (if flag #@"T" #@"NIL"))
    1013       (setf (text-view-blink-phase self) (if flag 1 0))
    1014       (let* ((layout (#/layoutManager self))
    1015              (container (#/textContainer self)))
    1016         ;; We toggle the blinked character "off" by setting its
    1017         ;; foreground color to the textview's background color.
    1018         ;; The blinked character should be "off" whenever the insertion
    1019         ;; point is drawn as "on".  (This means that when this method
    1020         ;; is invoked to tunr off the insertion point - as when a
    1021         ;; view loses keyboard focus - the matching paren character
    1022         ;; is drawn.
    1023         (ns:with-ns-range  (char-range (text-view-blink-location self) 1)
    1024           (let* ((glyph-range (#/glyphRangeForCharacterRange:actualCharacterRange:
    1025                                layout
    1026                                char-range
    1027                                +null-ptr+)))
    1028             #+debug (#_NSLog #@"Flag = %d, location = %d" :<BOOL> (if flag #$YES #$NO) :int (text-view-blink-location self))
    1029             (let* ((rect (#/boundingRectForGlyphRange:inTextContainer:
    1030                           layout
    1031                           glyph-range
    1032                           container)))
    1033               (#/setNeedsDisplayInRect: self rect)))))))
    1034   (call-next-method r color flag))
    1035 
    1036 
    1037 (defmethod disable-blink ((self hemlock-textstorage-text-view))
    1038   (when (eql (text-view-blink-enabled self) #$YES)
    1039     (setf (text-view-blink-enabled self) #$NO)
    1040     (ns:with-ns-range  (char-range (text-view-blink-location self) 1)
    1041       (let* ((layout (#/layoutManager self))
    1042              (glyph-range (#/glyphRangeForCharacterRange:actualCharacterRange:
    1043                                layout
    1044                                char-range
    1045                                +null-ptr+)))
     1012
     1013
     1014(defmethod remove-paren-highlight ((self hemlock-textstorage-text-view))
     1015  (let* ((left (text-view-paren-highlight-left-pos self))
     1016         (right (text-view-paren-highlight-right-pos self)))
     1017    (ns:with-ns-range  (char-range left (1+ (- right left)))
     1018      (let* ((layout (#/layoutManager self)))
    10461019        (#/lockFocus self)
    1047         (#/drawGlyphsForGlyphRange:atPoint: layout glyph-range (#/textContainerOrigin self))
     1020        (#/removeTemporaryAttribute:forCharacterRange: layout #&NSBackgroundColorAttributeName char-range)
    10481021        (#/unlockFocus self)))))
    10491022
    1050 
    1051 (defmethod update-blink ((self hemlock-textstorage-text-view))
    1052   (disable-blink self)
     1023(defmethod disable-paren-highlight ((self hemlock-textstorage-text-view))
     1024  (when (eql (text-view-paren-highlight-enabled self) #$YES)
     1025    (setf (text-view-paren-highlight-enabled self) #$NO)
     1026    (remove-paren-highlight self)))
     1027
     1028
     1029
     1030
     1031(defmethod force-paren-redisplay ((self hemlock-textstorage-text-view))
     1032  (when (eql (text-view-paren-highlight-enabled self) #$YES)
     1033    (ns:with-ns-range (left-char-range (text-view-paren-highlight-left-pos self) 1)
     1034      (ns:with-ns-range (right-char-range (text-view-paren-highlight-right-pos self) 1)
     1035        (let* ((layout (#/layoutManager self))
     1036               (container (#/textContainer self))
     1037               (left-glyph-range (#/glyphRangeForCharacterRange:actualCharacterRange:
     1038                                  layout
     1039                                  left-char-range
     1040                                  +null-ptr+))
     1041               (right-glyph-range (#/glyphRangeForCharacterRange:actualCharacterRange:
     1042                                   layout
     1043                                   right-char-range
     1044                                   +null-ptr+))
     1045               (left-rect (#/boundingRectForGlyphRange:inTextContainer:
     1046                           layout
     1047                           left-glyph-range
     1048                           container))
     1049               (right-rect (#/boundingRectForGlyphRange:inTextContainer:
     1050                            layout
     1051                            right-glyph-range
     1052                            container)))
     1053          (#/setNeedsDisplayInRect: self left-rect)
     1054          (#/setNeedsDisplayInRect: self right-rect))))))
     1055
     1056(defmethod update-paren-highlight ((self hemlock-textstorage-text-view))
     1057  (disable-paren-highlight self)
    10531058  (let* ((buffer (hemlock-buffer self)))
    10541059    (when (and buffer (string= (hi::buffer-major-mode buffer) "Lisp"))
    10551060      (let* ((hi::*current-buffer* buffer)
    10561061             (point (hi::buffer-point buffer)))
    1057         #+debug (#_NSLog #@"Syntax check for blinking")
     1062        #+debug (#_NSLog #@"Syntax check for paren-highlighting")
    10581063        (update-buffer-package (hi::buffer-document buffer) buffer)
    10591064        (cond ((eql (hi::next-character point) #\()
     
    10621067                 (hi::with-mark ((temp point))
    10631068                   (when (hemlock::list-offset temp 1)
    1064                      #+debug (#_NSLog #@"enable blink, forward")
    1065                      (setf (text-view-blink-location self)
     1069                     #+debug (#_NSLog #@"enable paren-highlight, forward")
     1070                     (setf (text-view-paren-highlight-right-pos self)
    10661071                           (1- (hi:mark-absolute-position temp))
    1067                            (text-view-blink-enabled self) #$YES)))))
     1072                           (text-view-paren-highlight-left-pos self)
     1073                           (hi::mark-absolute-position point)
     1074                           (text-view-paren-highlight-enabled self) #$YES)))))
    10681075              ((eql (hi::previous-character point) #\))
    10691076               (hemlock::pre-command-parse-check point)
     
    10711078                 (hi::with-mark ((temp point))
    10721079                   (when (hemlock::list-offset temp -1)
    1073                      #+debug (#_NSLog #@"enable blink, backward")
    1074                      (setf (text-view-blink-location self)
     1080                     #+debug (#_NSLog #@"enable paren-highlight, backward")
     1081                     (setf (text-view-paren-highlight-left-pos self)
    10751082                           (hi:mark-absolute-position temp)
    1076                            (text-view-blink-enabled self) #$YES))))))
    1077         (when (eql (text-view-blink-enabled self) #$YES)
    1078           (ns:with-ns-range (char-range (text-view-blink-location self) 1)
    1079             (let* ((layout (#/layoutManager self))
    1080                    (container (#/textContainer self))
    1081                    (glyph-range (#/glyphRangeForCharacterRange:actualCharacterRange:
    1082                                  layout
    1083                                  char-range
    1084                                  +null-ptr+))
    1085                    (rect (#/boundingRectForGlyphRange:inTextContainer:
    1086                           layout
    1087                           glyph-range
    1088                           container)))
    1089               (setf (text-view-blink-phase self) #$YES)
    1090               (#/setNeedsDisplayInRect: self rect))))))))
    1091 
    1092 (objc:defmethod (#/updateInsertionPointStateAndRestartTimer: :void)
    1093     ((self hemlock-textstorage-text-view)
    1094      (restart #>BOOL))
    1095   (setf (text-view-blink-phase self) #$YES)
    1096   (call-next-method restart))
     1083                           (text-view-paren-highlight-right-pos self)
     1084                           (1- (hi:mark-absolute-position point))
     1085                           (text-view-paren-highlight-enabled self) #$YES))))))
     1086        (force-paren-redisplay self)))))
     1087
     1088
    10971089
    10981090;;; Set and display the selection at pos, whose length is len and whose
     
    11081100  (assume-cocoa-thread)
    11091101  (when (eql length 0)
    1110     (update-blink self))
     1102    (update-paren-highlight self))
    11111103  (rlet ((range :ns-range :location pos :length length))
    11121104    (ccl::%call-next-objc-method self
     
    11551147;;; HI::*CURRENT-BUFFER* is bound to the buffer containing START-LINE
    11561148;;; and END-LINE
    1157 (defun set-temporary-character-attributes (layout pos start-line end-line blink-location  blink-color)
     1149(defun set-temporary-character-attributes (layout pos start-line end-line)
    11581150  (ns:with-ns-range (range)
    11591151    (let* ((color-attribute #&NSForegroundColorAttributeName)
     
    11821174                        (ns:ns-range-length range) (1+ (- iend istart)))
    11831175                  (#/addTemporaryAttribute:value:forCharacterRange:
    1184                    layout color-attribute color range)))))))
    1185       (when blink-location
    1186         (#/addTemporaryAttribute:value:forCharacterRange:
    1187              layout color-attribute blink-color (ns:make-ns-range blink-location 1))))))
     1176                   layout color-attribute color range))))))))))
    11881177
    11891178(objc:defmethod (#/drawRect: :void) ((self hemlock-text-view) (rect :<NSR>ect))
     
    12001189      (#/removeTemporaryAttribute:forCharacterRange:
    12011190       layout #&NSForegroundColorAttributeName char-range)
     1191      (#/removeTemporaryAttribute:forCharacterRange:
     1192       layout #&NSBackgroundColorAttributeName char-range)
    12021193      (let* ((ts (#/textStorage self))
    12031194             (cache (hemlock-buffer-string-cache (slot-value ts 'hemlock-string)))
    12041195             (hi::*current-buffer* (buffer-cache-buffer cache)))
    1205         #+debug (#_NSLog #@"blink-phase = %d" :int (text-view-blink-phase self))
     1196        #+debug (#_NSLog #@"paren-highlight-phase = %d" :int (text-view-paren-highlight-phase self))
    12061197        (multiple-value-bind (start-line start-offset)
    12071198            (update-line-cache-for-index cache start)
     
    12111202             (- start start-offset)
    12121203             start-line
    1213              (hi::line-next end-line)
    1214              (and (eql #$YES (text-view-blink-enabled self))
    1215                   (eql #$YES (text-view-blink-phase self))
    1216                   (#/shouldDrawInsertionPoint self)
    1217                   (text-view-blink-location self))
    1218              (text-view-blink-color self))))))
     1204             (hi::line-next end-line))))))
     1205    (when (and (eql #$YES (text-view-paren-highlight-enabled self))
     1206               (#/isKeyWindow (#/window self))
     1207               (#/isSelectable self))
     1208      (let* ((background #&NSBackgroundColorAttributeName)
     1209             (paren-highlight-left (text-view-paren-highlight-left-pos self))
     1210             (paren-highlight-right (text-view-paren-highlight-right-pos self))
     1211             (paren-highlight-color (text-view-paren-highlight-color self)))
     1212        (#/addTemporaryAttribute:value:forCharacterRange:
     1213         layout background paren-highlight-color (ns:make-ns-range paren-highlight-left 1))
     1214        (#/addTemporaryAttribute:value:forCharacterRange:
     1215         layout background paren-highlight-color (ns:make-ns-range paren-highlight-right 1))))
    12191216    ;; Um, don't forget to actually draw the view..
    12201217    (call-next-method  rect)))
     
    14381435             (setf (hi::buffer-region-active buffer) nil)
    14391436             (move-hemlock-mark-to-absolute-position point d location)
    1440              (update-blink self))
     1437             (update-paren-highlight self))
    14411438            (t
    14421439             ;; We don't get much information about which end of the
     
    16651662(defmethod hemlock-view ((self text-pane))
    16661663  (text-pane-hemlock-view self))
     1664
     1665;;; This method gets invoked on the text pane, which is its containing
     1666;;; window's delegate object.
     1667(objc:defmethod (#/windowDidResignKey: :void)
     1668    ((self text-pane) notification)
     1669  (declare (ignorable notification))
     1670  ;; When the window loses focus, we should remove or change transient
     1671  ;; highlighting (like matching-paren highlighting).  Maybe make this
     1672  ;; more general ...
     1673  (let* ((tv (text-pane-text-view self)))
     1674    (remove-paren-highlight tv)
     1675    (remove-paren-highlight (slot-value tv 'peer))))
     1676
     1677;;; Likewise, reactivate transient highlighting when the window gets
     1678;;; focus.
     1679(objc:defmethod (#/windowDidBecomeKey: :void)
     1680    ((self text-pane) notification)
     1681  (declare (ignorable notification))
     1682  (let* ((tv (text-pane-text-view self)))
     1683    (force-paren-redisplay tv)
     1684    (force-paren-redisplay (slot-value tv 'peer))))
     1685 
    16671686
    16681687;;; Mark the buffer's modeline as needing display.  This is called whenever
     
    19671986       (let* ((pane (make-instance 'text-pane :with-frame pane-rect)))
    19681987         (#/addSubview: window-content-view pane)
     1988         (#/setDelegate: w pane)
    19691989         pane))))
    19701990
Note: See TracChangeset for help on using the changeset viewer.