Re: activating windows...

[bill@cambridge.apple.com (Bill St. Clair)]

>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 
>front?

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
behavior.

Ciao.

-Bill

--------------------------------------------------------------------------

; finder-like-window.lisp
;
; 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.

(in-package :ccl)

(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 (double-click-p))
                 (not (window-active-p w))
                 (maybe-drag-event-handler
                  w (subtract-points (pref event :eventRecord.where)
                                     (view-position w))))
      (call-next-method))))

; 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)))
    (when view
      (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)))
          (window-select-event-handler w)))
      t)))

; 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)))
    (when release-window
      (window-drop-event-handler
       release-window
       view
       (subtract-points global-position (view-position release-window)))
      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) ())

(defvar *window-manager-clip-region*)
(defvar *window-manager-port*)

(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))
  *window-manager-port*)

(defmethod view-clip-region ((view window-manager-view))
  *window-manager-clip-region*)

(defmethod view-origin ((view window-manager-view))
  #@(0 0))

(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)
  (let (rgn)
    (unwind-protect
      (rlet ((rect :rect
                   :top -32767 :left -32767
                   :bottom 32767 :right 32767))
        (setq rgn (view-drag-region view))
        (with-focused-view *window-manager-view*
          (#_DragGrayRgn rgn where rect rect #$noConstraint (%null-ptr))
          (subtract-points (view-mouse-position nil) where)))
      (when (and rgn (not (%null-ptr-p rgn)))
        (#_DisposeRgn 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)))
      (#_OffsetRgn
       :ptr rgn 
       :long (subtract-points #@(0 0) (view-position view)))
      rgn)))

(defmethod view-drag-region ((view view))
  (with-focused-view view
    (view-drag-region-internal view)))

(defmethod view-drag-region-internal ((view simple-view))
  (let ((rgn (#_NewRgn))
        (done nil))
    (unwind-protect
      (progn
        (#_OpenRgn)
        (view-draw-contents view)
        (setq done t))
      (#_CloseRgn rgn)
      (unless done
        (#_DisposeRgn rgn)
        (setq rgn nil)))
    rgn))

(defmethod window-drop-event-handler ((w window) view where)
  (declare (ignore view where))
  (ed-beep))

(defmethod window-drop-event-handler ((w finder-like-window) view where)
  (if (eq w (view-container view))
    (set-view-position view where)
    (progn
      ; 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
; windows.
(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)))

(defparameter *w*
  (make-instance 'finder-like-window))
(defparameter *w2* 
  (make-instance 'finder-like-window
    :view-position (add-points (view-position *w*) #@(20 60))))

(defparameter *b*
  (make-instance 'draggable-button
    :view-container *w*
    :dialog-item-text "Button"))

(defparameter *b2*
  (make-instance 'draggable-button
    :view-container *w2*
    :dialog-item-text "Button"))
|#