105 lines
3.9 KiB
Plaintext
105 lines
3.9 KiB
Plaintext
;; 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)))
|
|
)))
|