;;; -*- Mode: Common-Lisp; Package: User; Base: 10.; Patch-File: T -*-

;;; Reason: Delete the update events for a window when the window is deleted.

;;;                           RESTRICTED RIGHTS LEGEND
;;;
;;; Use, duplication, or disclosure by the Government is subject to
;;; restrictions as set forth in subdivision (c)(1)(ii) of the Rights in
;;; Technical Data and Computer Software clause at 52.227-7013.
;;;
;;;   TEXAS INSTRUMENTS INCORPORATED      
;;;   P.O. BOX 2909, M/S 2151             
;;;   AUSTIN, TEXAS 78769                 
;;;
;;; Copyright (C) 1989 Texas Instruments Incorporated.
;;; All rights reserved.

;;; Written 08/09/89 08:54:06 by jones,
;;; while running on HOBBS from band LOD1
;;; With SYSTEM 6.14, GC 6.3, VIRTUAL-MEMORY 6.1, MICRONET 6.0, MICRONET-COMM 6.1,
;;;  DISK-IO 6.1, DISK-LABEL 6.0, BASIC-PATHNAME 6.1, MAC-PATHNAME 6.0, NETWORK-SUPPORT-COLD 6.0,
;;;  BASIC-NAMESPACE 6.2, BASIC-FILE 6.2, RPC 6.1, NFS 6.0, EH 6.4, MAKE-SYSTEM 6.0,
;;;  MEMORY-AUX 6.0, COMPILER 6.10, TV 6.15, NVRAM 6.1, UCL 6.0, INPUT-EDITOR 6.0,
;;;  MACTOOLBOX 2.6, METER 6.1, ZWEI 6.5, DEBUG-TOOLS 6.3, WINDOW-MX 6.5, PRINTER 6.3,
;;;  MAC-PRINTER-TYPES 6.1, CLIPBOARD 6.1, NETWORK-PATHNAME 6.0, NETWORK-NAMESPACE 6.0,
;;;  DATALINK 6.0, CHAOSNET 6.0, NETWORK-SUPPORT 6.0, NETWORK-SERVICE 6.1, DATALINK-DISPLAYS 6.0,
;;;  MX-DATALINK 6.1, NAMESPACE-EDITOR 6.0, IP 3.47, NFS-SERVER 6.0, MX-SERIAL 6.1,
;;;  PRINTER-TYPES 6.1, IMAGEN 6.0, MAIL-DAEMON 6.2, MAIL-READER 6.2, TELNET 6.0,
;;;  VT100 6.0, STREAMER-TAPE 6.4, DECNET 1.69, VISIDOC 6.2, PROFILE 6.1, TI-CLOS 6.20,
;;;  CLEH 6.5, Experimental CLX 6.2, CLUE 6.10, Experimental BUG 11.12, Experimental ACTION 2.0,
;;;   microcode 138, Band Name: p616*3



#!C
; From file MAC-APPLICATIONS.LISP#> JONES; HEYERDAHL:
#10R MACTOOLBOX#:
(COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "MACTOOLBOX"))
                          (SI:*LISP-MODE* :Common-lisp)
                          (*READTABLE* Sys:Common-lisp-readtable)
                          (SI:*READER-SYMBOL-SUBSTITUTIONS* Sys::*common-lisp-symbol-substitutions*))
  (COMPILER#:PATCH-SOURCE-FILE "SYS: toolbox-interface; MAC-APPLICATIONS.#"


(proclaim '(special !DisposeWindowInternal !CloseWindowInternal))

(unless (fboundp '!CloseWindowInternal)
  (setf (symbol-function '!CloseWindowInternal) #'!CloseWindow))

(unless (fboundp '!DisposeWindowInternal)
  (setf (symbol-function '!DisposeWindowInternal) #'!DisposeWindow))

(defun !CloseWindow (window)
  (!CloseWindowInternal window)
  (when *mac-application*
    (send *mac-application* :flush-update-events window)))

(defun !DisposeWindow (window)
  (!DisposeWindowInternal window)
  (when *mac-application*
    (send *mac-application* :flush-update-events window)))

(defmethod (mac-application-internal :flush-update-events) (window)
  (without-interrupts
    ;; WAit until all pending events are in the queue.
    (process-wait "Event Wait" #'(lambda (ch)
				   (zerop (add:q-length (send ch :host-queue))))
		  (find-channel *application-channel*))
    ;; Now flush all update events for window.
    (dolist (event event-list)
      (when (and (= (send event :what) !UpdateEvt)
		 (= (send event :message) (send window :pointer)))
	(setf event-list (delete event event-list :test #'eq :count 1))
	(deallocate-event event)))))

(defmethod (mac-application-internal :handle-event) (acb)
  (block handle-event
    
    (case (add:opcode acb)
      (0
       (when (or (not (= last-mouse-h (parm-16b acb 7)))
		 (not (= last-mouse-v (parm-16b acb 6))))
	 (setf last-mouse-h   (parm-16b acb 7))
	 (setf last-mouse-v   (parm-16b acb 6))
	 (setf last-mouse-moved-time (time)))
       
       (setf last-event-arrival-time (time))
       (setf last-when      (parm-32b acb 2))
       (setf last-modifiers (parm-16b acb 8))
       (setf last-event-current-port (parm-32b acb 5))
       
       ;; Don't queue mouse moved or null events.
       (when (or (zerop (parm-16b acb 0))
		 (and (eql (parm-16b acb 0) !App4Evt)
		      (= (ldb (byte 8 24)  (parm-32b acb 1)) *mouse-moved-event-opcode*)))
	 (return-from handle-event))
       
       (push-end	    
	 (allocate-event
	   (parm-16b acb 0)
	   (parm-32b acb 1)
	   (parm-32b acb 2)
	   (parm-16b acb 8)
	   (parm-16b acb 6)
	   (parm-16b acb 7)
	   )
	 event-list))
      (1 ;; Follow a suspend event to make sure that it is retrieved.
       (let ((limit-time (+ (time) 650))
	     (event (allocate-event)))
	 (increase-suspend-event-limit-time 600)
	 
	 (setf last-time-i-saw-suspend (time))
	 ;; Make sure that the application has pulled the suspend event.
	 (when (and (!EventAvail !App4Mask event)
		    (= (ldb (byte 8 24)  (send event :message)) 1))
	   (process-wait "Suspend Event Wait" #'(lambda (event app limit-time)
						  (let ((*mac-application* app)
							(*application-channel* (send app :*application-channel*)))
						    (cond ((time-lessp limit-time (time)) t)
							  ((and (!EventAvail !App4Mask event)
								(= (ldb (byte 8 24)  (send event :message)) 1))
							   (setf (send app :last-time-i-saw-suspend) (time))
							   nil)
							  (t t))))
			 event self limit-time))
	 
	 ;; Wait until the application has called one of the traps that give up time before
	 ;; releasing the mac.
	 (unless (time-lessp (send *mac-application* :last-time-i-saw-suspend)
			     (send *mac-application* :last-time-time-given-up))
	   (process-wait "Suspend Event Wait" #'(lambda (app limit-time)
						  (or (time-lessp (send app :last-time-i-saw-suspend)
								  (send app :last-time-time-given-up))
						      (time-lessp limit-time (time))))
			 *mac-application* limit-time))
	 
	 )
       ))))
))