;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: OPAL; Base: 10 -*-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;         The Garnet User Interface Development Environment.      ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; This code was written as part of the Garnet project at          ;;;
;;; Carnegie Mellon University, and has been placed in the public   ;;;
;;; domain.  If you are using this code or any part of Garnet,      ;;;
;;; please contact garnet@cs.cmu.edu to be put on the mailing list. ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; CHANGE LOG:
;;; 22-Jul-92 Mickish Added total-p parameter to update-all
;;; 18-Jun-92 ECP Undid change of 24-Feb-92; rewrote clean-up to do what
;;;		  it was supposed to do.
;;; 18-Apr-92 ECP In update-all, check that windows are not destroyed.
;;;  6-Apr-92 BAM Wrap (let ((kr::*constants-disabled* T)) around all destroying.
;;; 25-Mar-92 Mickish  Dolist-->Do in update-all to remove CMUCL warning
;;; 24-Feb-92 ECP In get-table-contents, remove destroyed windows that
;;;		  are accidentally still in the hash table.
;;; 17-Feb-92 ECP kr::schema-name --> kr::schema-slots
;;; 15-Aug-90 ECP Total rewrite of change-garnet-display.
;;; 21-Aug-90 ECP In clean-up, make sure each window hasn't
;;;               already been destroyed.
;;;
;;;
(in-package "OPAL" :use '("LISP" "KR"))

(defmacro already-been-destroyed (a-window)
  `(not (kr:schema-p ,a-window)))


;;; Returns all non-destroyed windows.
;;; Windows which are already destroyed but are accidentally still
;;; in the hash table are removed.
(defun get-table-contents ()
  (let ((windows nil))
    (maphash #'(lambda (key val)
		  (push (cons key val) windows))
	     *drawable-to-window-mapping*)
    (values windows)))


(defun clean-up (&optional (how-to :orphans-only))
  "options are: 
  1) :opal => destroy all garnet windows by calling xlib:destroy-window on orphaned
  clx-windows and opal:destroy on non-orphaned windows
  2) :opal-set-agg-to-nil => same as above, but before calling opal:destroy,
  set the aggregate to nil so it won't get destroyed too
  3) :orphans-only => destroy all orphaned garnet windows
  4) :clx => destroy all garnet windows by calling xlib:destroy-window

  return value is how many windows were destroyed"

  (let ((windows (get-table-contents))
	(num-killed 0))
    (case how-to
      ;; destroy all garnet windows by calling xlib:destroy-window on orphaned
      ;; clx-windows and opal:destroy on non-orphaned windows.
      ;; In the case of :opal-set-agg-to-nil,
      ;; set the aggregate to nil so it won't get destroyed too
      ((:opal :opal-set-agg-to-nil)
       (dolist (window-pair windows)
	 (let* ((opal-window (opal-window window-pair))
		(clx-window (clx-window window-pair))
		(display (xlib:window-display clx-window)))
	   (if (or (already-been-destroyed opal-window)
		   (not (equal clx-window (g-value opal-window :drawable))))
	       (progn
		 (xlib:destroy-window clx-window)
	         (remhash clx-window *drawable-to-window-mapping*)
		 (when display
		   (xlib:display-force-output display)))
	       (let ((kr::*constants-disabled* T))
		 (when (eq how-to :opal-set-agg-to-nil)
		   (s-value opal-window :aggregate nil))
		 (destroy opal-window)))
	   (remhash clx-window *drawable-to-window-mapping*)))
       (dolist (w (cdr *windows-that-have-never-been-updated*))
	 (let ((kr::*constants-disabled* T))
	   (when (eq how-to :opal-set-agg-to-nil)
	     (s-value w :aggregate nil))
	   (destroy w))))
      (:orphans-only
       ;;  destroy all orphaned garnet windows
       (dolist (window-pair windows)
	 (let* ((opal-window (opal-window window-pair))
		(clx-window (clx-window window-pair))
		(display (xlib:window-display clx-window)))
	   (when (or (already-been-destroyed opal-window)
	             (not (equal clx-window (g-value opal-window :drawable))))
	       (incf num-killed)
	       (xlib:destroy-window clx-window )
	       (remhash clx-window *drawable-to-window-mapping*)
	       (when display
		 (xlib:display-force-output display))))))
      (:clx
       ;; destroy all garnet windows by calling xlib:destroy-window"
       (dolist (window-pair windows)
	 (let* ((clx-window (clx-window window-pair))
		(opal-window (opal-window window-pair))
		(display (xlib:window-display clx-window)))
	   (xlib:destroy-window clx-window )
	   (remhash clx-window *drawable-to-window-mapping*)
	   (unless (already-been-destroyed opal-window)
	     (s-value opal-window :drawable nil))
	   (when display
	     (xlib:display-force-output display)))))
      (t (format t "options are :opal, :opal-set-agg-to-nil, :orphans-only, :clx")))
    (if (eq how-to :orphans-only) num-killed
	(length windows))))

(defun change-garnet-display (new-display)
  (disconnect-garnet)
  (reconnect-garnet new-display))

(defun update-all (&optional (total-p NIL))
  ; update all top-level windows
  (maphash #'(lambda (drawable window)
	       (declare (ignore drawable))
	       (if (already-been-destroyed window)
		   (remhash window *drawable-to-window-mapping*)
	           (unless (g-value window :parent)
		     (update window total-p))))
	   *drawable-to-window-mapping*)
  (do ((windows (cdr *windows-that-have-never-been-updated*)
		(cdr windows)))
      ((null windows) T)
    (let ((window (car windows)))
      (if (not (g-value window :parent))
	  (update window total-p)))))

(defun reset-cursor (a-window)
  (s-value a-window :cursor (cons arrow-cursor arrow-cursor-mask))
  (update a-window))
