Generic_Window_Manager/data/pick.gwm

105 lines
3.1 KiB
Plaintext

;; pick.gwm --- Pick a window with the mouse, and do something with it.
;;
;; Author: Anders Holst (aho@sans.kth.se)
;; Copyright (C) 1994 Anders Holst
;; Last change: 13/9
;;
;; This file is copyrighted under the same terms as the rest of GWM
;; (see the X Inc license for details). There is no warranty that it
;; works.
;;
;; ---------------------------------------------------------------------
;;
;; Let the user pick a window with the mouse, and then evaluate some
;; expression on that window.
;; The basic function is "(pick-window)", which lets the user pick a
;; window, and returns the wob number. It considers the variable
;; "cursor".
;; More advanced functions are "(with-picked EXPR)" which runs EXPR
;; on the picked window, and "(kill-picked)" which deletes the picked
;; window. Calls to these can for example be done from a root menu.
(setq pick-result ())
(setq pick-fsm
(fsm-make
(state-make
(on (buttonrelease 1 any)
(with (xpos (current-event-x)
ypos (current-event-y))
(: pick-result (wob-at-coords xpos ypos))
(unpop-menu)))
(on (buttonrelease 2 any)
(progn (: pick-result ())
(unpop-menu)))
(on (buttonrelease 3 any)
(progn (: pick-result ())
(unpop-menu)))
)))
(setq pick-onpress-fsm
(fsm-make
(state-make
(on (buttonpress 1 any)
(with (xpos (current-event-x)
ypos (current-event-y))
(: pick-result (wob-at-coords xpos ypos))
(unpop-menu)
(process-events)
(if pick-result
(with (wob pick-result)
(: pick-return (eval pick-expr))))))
(on (buttonpress 2 any)
(progn (: pick-result ())
(unpop-menu)))
(on (buttonpress 3 any)
(progn (: pick-result ())
(unpop-menu)))
)))
(defun pick-menu ()
(with (fsm pick-fsm
background black
borderwidth 0
inner-borderwidth 0
describe-window '(lambda () (list (window-make () () () () ())
(window-make () () () () ())))
reenter-on-opening ())
(with (menu-min-width 1
menu-max-width 1
bar-min-width 1
bar-max-width 1)
(menu-make (bar-make ())))))
(defun pick-window ()
(with (menu (pick-menu))
(move-window (menu-wob menu) -1 -1)
(: pick-result t)
(pop-menu menu 'here)
(while (= pick-result t) (process-events)) ; Wait for result (ugly).
pick-result))
(defunq with-picked expr
(with (win (with (cursor (or cursor (cursor-make 38)))
(pick-window)))
(if win
(with (wob win)
(eval (+ '(progn) expr))))))
(defunq with-picked-on-press expr
(with (cursor (or cursor (cursor-make 38))
pick-fsm pick-onpress-fsm
pick-expr (+ '(progn) expr)
pick-return ())
(if (pick-window)
pick-return)))
(defun kill-picked ()
(with (win (with (cursor (cursor-make 88))
(pick-window)))
(if win
(with (wob win)
(or (delete-window)
(kill-window))))))