;; timeout-win: make some windows disappear after a while
;; Colas Nahaboo <colas@sa.inria.fr>
;; v 1.0 25 July 1995
;; --------------------------------------------------------------------- 
;;
;; timeout-win allows you to specify a command to be applied to a window 
;; N seconds after its creation. Very useful to get rid of unwanted pop-ups
;; such as XMH mime requesters each time I go into a mail error message...
;;
;; It is implemented as a decoration modifier. It will add timeout to any
;; existing window decoration. 
;; IMPORTANT: the command "gwmsend" must be installed. source under
;; contrib/gwmsend in the gwm distrib.
;;
;; USAGE: (timeout-win <decoration> options...)
;;        where options are:
;;        delay     specifies the delay in seconds before the action takes
;;                  place. defaults to 3 seconds. 0 means that the command
;;                  is run immediately, so gwmsend is not needed
;;        command   a wool function name that will be executed without
;;                  arguments in the context of the window if it is still 
;;                  there. defaults to "delete-window"
;;        NOTE: you must quote the delay and command keywords.
;; e.g.:
;; (require 'timeout-win)			; load it if wasnt there
;; ;;mime popups from xmh
;; (set-window Xmh.confirm 
;;   (timeout-win simple-win 'delay (if (= window-size '(370 70)) 0 10))
;; 
;; in the above I discriminate the popup to put away immediately by its size
;; the other have a 10s timeout. Another example is to iconify Xrn Information 
;; window after 2 seconds:
;; (set-window XRn.Information
;;   (timeout-win simple-win 'delay 2 'command "iconify-window"))
;;
;; Obeys the "customize" protocol under the class "TimeoutWin" and name
;; "timeout-win", so that you can say
;; (customize simple-win any Xmh.confirm 'font fixed)
;; (customize timeout-win any Xmh.confirm 'command "lower-window")
;;
;; If you want to be able to set a command to save a window from its coming 
;; death, you can make a button or menu item executing 
;; (timeout-win.remove-exec) in the context of the window.

;; --------------------------------------------------------------------- 

;; default options

(setq timeout-win.context (list
    'delay 3
    'command "delete-window"
))

;;============================================================================
;; The actual decoration
;;============================================================================
;; (timeout-win <window-decoration> ['delay seconds] ['command function-name])

(defunq timeout-win args
  (if (= window root-window)		; trap user errors
    (trigger-error "Decoration function \"timeout-win\" called on root window")
  )
 (with-eval (+ timeout-win.context
      (get-context (std-resource-get 'TimeoutWin 'timeout-win))
      (mapfor elt (sublist 1 (length args) args) (eval elt))
    )					; concatenates the context
    (with (
	;; sets timeout daemon
	closing closing			;protect
	opening
	(with (delay (if (= 'number (type delay)) delay (eval delay)))
	  (setq opening (if
	      (< delay 0)			;negative = nothing
	      opening
	      (= delay 0)		; 0=>immediate command
	      (+ opening (list (list (atom command))))
	      (progn		; >= 1
		(timeout-win.add-exec (atom command))
		(setq closing (+ closing '((timeout-win.remove-exec))))
		(+ opening (list
		    (list '! "sh" "-c" (list '+ "sleep " (itoa delay) 
			"; gwmsend \"(timeout-win.exec " 
			(itoa window-window) ")\""
      )))))))))
      (get-context (# 0 args))
)))

(setq timeout-win.exec-table (list))

(defun timeout-win.add-exec (command)
  (## (atom (itoa window-window)) 'timeout-win.exec-table (list command))
)

(defun timeout-win.remove-exec ()
  (delete-nth (atom (itoa window-window)) timeout-win.exec-table)
)

(defun timeout-win.exec (w)
  (with (com (# (atom (itoa w)) timeout-win.exec-table))
    (if com				;still ok to apply?
      (with (wob w) (eval com))
  ))
  (unbind (atom (itoa w)))
)))