[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: activating windows...
- To: berger@SOE.Berkeley.Edu (Daniel Berger)
- Subject: Re: activating windows...
- From: email@example.com (Bill St. Clair)
- Date: Fri, 4 Sep 1992 16:33:18 -0500
- Cc: info-mcl
>Is it possible to have a window that is active (i.e. responsive to mouse
>actions - say selecting and dragging of icons), but not brought to the
It's possible, but it takes a little doing (a little more than I
had thought when I started doing it). Here's an example file that
illustrates what you need to know to make it work. The important
thing is that all events get passed through the WINDOW-EVENT
generic function which dispatches to an xxx-EVENT-HANDLER.
If you specialize WINDOW-EVENT, you can override the default
; How to handle mouse down events like the finder.
; Shows how to specialize the WINDOW-EVENT generic function
; to override always selecting any window in which the mouse
; is clicked.
; Also shows one way to define a view which draws to the
; window manager port.
; Does not do any kind of highlighting of selected views.
; You'll have to do that yourself.
(export '(finder-like-window maybe-drag-event-handler drop-view
*window-manager-view* view-drag-region window-drop-event-handler))
(require "QUICKDRAW") ; for local-to-global
(defclass finder-like-window (window) ())
; part-code from #_FindWindow is squirrelled away in *current-event*
(defconstant $event-part-code 16)
(defmethod window-event ((w finder-like-window))
(let* ((event *current-event*)
(what (pref event :eventRecord.what))
(part-code (%get-word event $event-part-code)))
(unless (and (eql what #$mouseDown)
(eql part-code #$inContent)
(not (window-active-p w))
w (subtract-points (pref event :eventRecord.where)
; If WHERE is inside one of my subviews, drag it and return true.
; Otherwise, return NIL.
; If a mouse-up occurs while the mouse is still within the window,
; select it by calling window-select-event-handler.
(defmethod maybe-drag-event-handler ((w finder-like-window) where)
(let ((view (find-view-containing-point w where nil t)))
(let* ((view-offset (subtract-points where (view-position view)))
(release-position (drag-view view view-offset)) ; global coords
(when (and (eq w (drop-view view release-position))
(not (window-active-p w)))
; Find the window at GLOBAL-POSITION and call WINDOW-DROP-EVENT-HANDLER
; on it. Return the window.
(defmethod drop-view ((view simple-view) global-position)
(let ((release-window (find-view-containing-point nil global-position nil t)))
(subtract-points global-position (view-position release-window)))
; Here's the window manager view.
; The important generic functions, called by FOCUS-VIEW,
; are WPTR, VIEW-CLIP-REGION, and VIEW-ORIGIN.
(defclass window-manager-view (view) ())
(def-load-pointers window-manager-view ()
(let ((rgn (#_NewRgn)))
(#_SetRectRgn rgn -32767 -32767 32767 32767)
(setq *window-manager-clip-region* rgn))
(setq *window-manager-port* (%get-ptr (%int-to-ptr #$WMgrPort))))
(defmethod wptr ((view window-manager-view))
(defmethod view-clip-region ((view window-manager-view))
(defmethod view-origin ((view window-manager-view))
(defvar *window-manager-view* (make-instance 'window-manager-view))
; Drag an outline of the view as returned by VIEW-DRAG-REGION
; until the mouse is released. Return the new global position
; for the view. Where is the difference between the current mouse
; position and the view's position.
(defmethod drag-view ((view simple-view) where)
(rlet ((rect :rect
:top -32767 :left -32767
:bottom 32767 :right 32767))
(setq rgn (view-drag-region view))
(#_DragGrayRgn rgn where rect rect #$noConstraint (%null-ptr))
(subtract-points (view-mouse-position nil) where)))
(when (and rgn (not (%null-ptr-p rgn)))
; view-drag-region computes a region for the view.
; The default methods do this by drawing the view with an open region.
(defmethod view-drag-region ((view simple-view))
(with-focused-view (view-container view)
(let ((rgn (view-drag-region-internal view)))
:long (subtract-points #@(0 0) (view-position view)))
(defmethod view-drag-region ((view view))
(defmethod view-drag-region-internal ((view simple-view))
(let ((rgn (#_NewRgn))
(setq done t))
(setq rgn nil)))
(defmethod window-drop-event-handler ((w window) view where)
(declare (ignore view where))
(defmethod window-drop-event-handler ((w finder-like-window) view where)
(if (eq w (view-container view))
(set-view-position view where)
; Done this way to prevent invalidating the old position
; in the new window.
(set-view-container view nil)
(set-view-position view where)
(set-view-container view w))))
; This example makes two windows, each with a draggable button.
; Try dragging either button and dropping it on one of the two
(defclass draggable-button (button-dialog-item) ())
(defmethod view-click-event-handler ((b draggable-button) where)
(let ((pos (drag-view b (subtract-points where (view-position b)))))
(drop-view b pos)))
:view-position (add-points (view-position *w*) #@(20 60))))