[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

bug: icon-dialog-item doesn't use view container (and fix)



Following is an example of the bug, then the fix. -matt

#|
;;; Here's a bug involving ICON-DIALOG-ITEMs in subviews: Eval the
;;; form then try clicking the extreme right and left sides of each
;;; button. The button works fine but clicking the icon's right side
;;; causes momentary flashing then nothing.
 
(require "QUICKDRAW")
(require "ICON-DIALOG-ITEM")
 
(let* ((button (make-instance 'button-dialog-item :dialog-item-text "Click Me!"))
       (icon (make-dialog-item 'icon-dialog-item #@(60 10) #@(32 32)
                               "Untitled" #'identity :icon *stop-icon*))
       (subview (make-instance 'view
                  :view-size #@(100 70)
                  :view-position #@(0 0)
                  :view-subviews (list button icon))))
  (make-instance 'window :view-subviews (list subview))
  ;; Make view draw its border.
  (defmethod view-draw-contents :after ((view (eql subview)))
    (multiple-value-bind (pt-top-left pt-bot-right)
                         (view-corners view)
      (frame-rect (view-container view) pt-top-left pt-bot-right)))
  ;; Move to show bug with offsets.
  (set-view-position subview #@(10 0)))
|#

;;;
;;; icon-dialog-item-patch.lisp
;;;
 
(in-package "COMMON-LISP-USER")
 
;;  Change Log
;;  
;; ...
;;
;; 11-Mar-94 mc	Fixed bug in view-click-event-handler. Was using
;;              view-window instead of  view-container. (cornell@cs.umass.edu)
;;           
 
(in-package :ccl)
 
 
(defmethod view-click-event-handler ((item icon-dialog-item) where)
  (declare (ignore where))
  (let* ((pos (view-position item))
         (inverted-p nil))              ;true when the mouse is over the icon
    (with-focused-view (view-container item)   ;Draw in the container's coordinates
      (rlet ((temp-rect :rect           ;temporarily allocate a rectangle
                        :topLeft pos
                        :botRight (add-points pos (view-size item))))
        (without-interrupts                
         (#_invertrect temp-rect)       ;initially invert the icon.
         (setq inverted-p t)
         (loop                          ;loop until the button is released
           (unless (mouse-down-p)
             (when inverted-p           ;if button released with mouse
                                        ;  over the icon, run the action
               (dialog-item-action item)
               (#_invertrect temp-rect)
               (setq inverted-p nil))
             (return-from view-click-event-handler))
           (if (#_PtInRect
                (view-mouse-position (view-container item)) ;view-container was view-window
                temp-rect)           ;is mouse over the icon's rect?
             (unless inverted-p              ;yes, make sure it's
inverted.
               (#_invertrect temp-rect)
               (setq inverted-p t))    
             (when inverted-p                ;no, make sure it's not inverted.
               (#_invertrect temp-rect)
               (setq inverted-p nil)))))))))