home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 22 gnu / 22-gnu.zip / gwm18a.zip / data / pick.gwm < prev    next >
Lisp/Scheme  |  1995-07-03  |  2KB  |  77 lines
  1. ;; pick.gwm --- Pick a window with the mouse, and do something with it.
  2. ;;
  3. ;; Author: Anders Holst  (aho@sans.kth.se)  
  4. ;; Copyright (C) 1994  Anders Holst
  5. ;; Last change: 13/9
  6. ;;
  7. ;; This file is copyrighted under the same terms as the rest of GWM
  8. ;; (see the X Inc license for details). There is no warranty that it
  9. ;; works. 
  10. ;;
  11. ;; --------------------------------------------------------------------- 
  12. ;; 
  13. ;; Let the user pick a window with the mouse, and then evaluate some
  14. ;; expression on that window.
  15. ;; The basic function is "(pick-window)", which lets the user pick a
  16. ;; window, and returns the wob number. It considers the variable
  17. ;; "cursor".
  18. ;; More advanced functions are "(with-picked EXPR)" which runs EXPR
  19. ;; on the picked window, and "(kill-picked)" which deletes the picked
  20. ;; window. Calls to these can for example be done from a root menu.
  21.  
  22. (setq pick-result ())
  23.  
  24. (setq pick-fsm
  25.   (fsm-make 
  26.    (state-make
  27.     (on (buttonrelease 1 any)
  28.         (with (xpos (current-event-x)
  29.                ypos (current-event-y))
  30.           (: pick-result (wob-at-coords xpos ypos))
  31.           (unpop-menu)))
  32.     (on (buttonrelease 2 any)
  33.         (progn (: pick-result ())
  34.                (unpop-menu)))
  35.     (on (buttonrelease 3 any)
  36.         (progn (: pick-result ())
  37.                (unpop-menu)))
  38.     )))
  39.  
  40. (defun pick-menu ()
  41.   (with (fsm pick-fsm
  42.          background black
  43.          borderwidth 0
  44.          inner-borderwidth 0
  45.          describe-window '(lambda () (list (window-make () () () () ())
  46.                                            (window-make () () () () ())))
  47.          reenter-on-opening ())
  48.      (with (menu-min-width 1
  49.             menu-max-width 1
  50.             bar-min-width 1
  51.             bar-max-width 1)
  52.        (menu-make (bar-make ())))))
  53.  
  54. (defun pick-window ()
  55.   (with (menu (pick-menu))
  56.     (move-window (menu-wob menu) -1 -1)
  57.     (: pick-result t)
  58.     (pop-menu menu 'here)
  59.     (while (= pick-result t) (process-events))  ; Wait for result (ugly).
  60.     pick-result))
  61.  
  62. (defunq with-picked expr
  63.   (with (win (with (cursor (or cursor (cursor-make 38)))
  64.                    (pick-window)))
  65.     (if win
  66.         (with (wob win)
  67.           (eval (+ '(progn) expr))))))
  68.  
  69. (defun kill-picked ()
  70.   (with (win (with (cursor (cursor-make 88))
  71.                    (pick-window)))
  72.     (if win
  73.         (with (wob win)
  74.           (or (delete-window)
  75.               (kill-window))))))
  76.  
  77.