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