[Openmcl-devel] Stalking the elusive matching-paren highlighting bug

[Ron Garret]

At the end of this message is some code that was designed to flush out  
the matching-paren highlighting bug.  (To review, that bug is that  
there is a significant delay between when you type a close paren and  
when the matching paren is highlighted.)  This code is designed to  
make the highlighting behavior apparent.  It works like this: there  
are three methods that I have been able to identify as being involved  
with matching paren highlighting: #/ 
drawInsertionPointInRect:color:turnedOn:, disable-blink, and update- 
blink.  Below, each of these has been modified to paint the rect that  
it is updating in a distinctive color, either red, green, blue or  
cyan.  If you load this code and type some open and close parens you  
will observe two things:

1.  First, matching parens are now highlighted by a brief flash of  
cyan as soon as you type a close paren.

2.  Notwithstanding that none of this code ever paints a white  
rectangle, the matching paren does turn white for a while between when  
it flashes cyan and when it starts to blink red/green.  Also, the red/ 
green rectangles are redrawn in white as you type more close parens.

That seems to indicate that there is some additional code somewhere  
that is repainting those rects in white.  I can't for the life of me  
figure out where it is.  Can anyone help?

Thanks,
rg

---


(in-package "GUI")

;;; Maybe cause 1 character in the textview to blink (by drawing an  
empty
;;; character rectangle) in synch with the insertion point.

(objc:defmethod (#/drawInsertionPointInRect:color:turnedOn: :void)
    ((self hemlock-textstorage-text-view)
     (r :<NSR>ect)
     color
     (flag :<BOOL>))
  (unless (#/editingInProgress (#/textStorage self))
    (unless (eql #$NO (text-view-blink-enabled self))
      (let* ((layout (#/layoutManager self))
             (container (#/textContainer self))
             (blink-color (text-view-blink-color self)))
        (ns:with-ns-range  (char-range (text-view-blink-location self)  
1)
          (let* ((glyph-range (#/ 
glyphRangeForCharacterRange:actualCharacterRange:
                               layout
                               char-range
                               +null-ptr+))
                 (rect (#/boundingRectForGlyphRange:inTextContainer:
                        layout
                        glyph-range
                        container)))
            (#/lockFocus self)
            ;(#/set blink-color)
            (#/set (if flag (#/redColor ns:ns-color) (#/greenColor  
ns:ns-color)))
            (#_NSRectFill rect)
            (unless flag
              (#/drawGlyphsForGlyphRange:atPoint:
               layout glyph-range (#/textContainerOrigin self)))
            (#/flushGraphics (#/currentContext ns:ns-graphics-context))
            (#/unlockFocus self)
            )))))
  (call-next-method r color flag))

(defmethod disable-blink ((self hemlock-textstorage-text-view))
  (when (eql (text-view-blink-enabled self) #$YES)
    (setf (text-view-blink-enabled self) #$NO)
    (ns:with-ns-range  (char-range (text-view-blink-location self) 1)
      (let* ((layout (#/layoutManager self))
             (glyph-range (#/ 
glyphRangeForCharacterRange:actualCharacterRange:
                               layout
                               char-range
                               +null-ptr+))
             (rect (#/boundingRectForGlyphRange:inTextContainer:
                       layout
                       glyph-range
                       (#/textContainer self))))
        (#/lockFocus self)

        (#/set (#/blueColor ns:ns-color))
        (#_NSRectFill rect)

        (#/drawGlyphsForGlyphRange:atPoint: layout glyph-range (#/ 
textContainerOrigin self))
        (#/flushGraphics (#/currentContext ns:ns-graphics-context))

        (#/unlockFocus self)))))


(defmethod update-blink ((self hemlock-textstorage-text-view))
  (disable-blink self)
  (let* ((d (hemlock-buffer-string-cache (#/hemlockString (#/ 
textStorage self))))
         (buffer (buffer-cache-buffer d)))
    (when (and buffer (string= (hi::buffer-major-mode buffer) "Lisp"))
      (let* ((hi::*current-buffer* buffer)
             (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)
               (when (hemlock::valid-spot point t)
                 (hi::with-mark ((temp point))
                   (when (hemlock::list-offset temp 1)
                     #+debug (#_NSLog #@"enable blink, forward")
                     (setf (text-view-blink-location self)
                           (1- (hi:mark-absolute-position temp))
                           (text-view-blink-enabled self) #$YES)))))
              ((eql (hi::previous-character point) #\))
               (hemlock::pre-command-parse-check point)
               (when (hemlock::valid-spot point nil)
                 (hi::with-mark ((temp point))
                   (when (hemlock::list-offset temp -1)
                     #+debug (#_NSLog #@"enable blink, backward")
                     (setf (text-view-blink-location self)
                           (hi:mark-absolute-position temp)
                           (text-view-blink-enabled self) #$YES))))))

        (when (eql (text-view-blink-enabled self) #$YES)
          (ns:with-ns-range  (char-range (text-view-blink-location  
self) 1)
            (let* ((layout (#/layoutManager self))
                   (glyph-range (#/ 
glyphRangeForCharacterRange:actualCharacterRange:
                                 layout
                                 char-range
                                 +null-ptr+))
                   (rect (#/boundingRectForGlyphRange:inTextContainer:
                          layout
                          glyph-range
                          (#/textContainer self))))
              (#/lockFocus self)

              (#/set (#/cyanColor ns:ns-color))
              (#_NSRectFill rect)
              (#/flushGraphics (#/currentContext ns:ns-graphics- 
context))

            (#/unlockFocus self))))

))))