home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 22 gnu / 22-gnu.zip / gwm18a.zip / data / def-menus.gwm < prev    next >
Lisp/Scheme  |  1995-07-03  |  2KB  |  62 lines
  1. ; DEFAULT MENUS
  2. ; =============
  3.  
  4. ;;File: def-menus.gwm -- default root/window/icon menus
  5. ;;Author: colas@mirsa.inria.fr (Colas NAHABOO) -- Bull Research FRANCE
  6. ;;Revision: 1.4 -- July 20 1989
  7. ;;State: Exp
  8. ;;GWM Version: 1.4
  9.  
  10. ; create menus with lists of xterms and xloads
  11. ; ============================================
  12.  
  13. (defname-in-screen-to ()  xterm-pop xload-pop)
  14. (defaults-to xterm-list ())
  15. (defaults-to xload-list ())
  16.  
  17. (for screen (list-of-screens)
  18.      (with (fsm pop-fsm menu ())
  19.        (defaults-to root-pop (menu-make-from-list root-pop-items))
  20.        (defaults-to window-pop (menu-make-from-list window-pop-items))
  21.        (if (eq window-pop-items icon-pop-items)
  22.        (defaults-to icon-pop window-pop)
  23.      (defaults-to icon-pop (menu-make-from-list icon-pop-items)))
  24.        
  25.        (menu-default-action root-pop '(refresh))
  26.        (menu-default-item root-pop 3)
  27.        (menu-default-action window-pop '(std-iconify-window))
  28.        (menu-default-action icon-pop '(std-iconify-window))
  29.       
  30.        (setq xterm-items 
  31.          '(menu-make (pop-label-make "Xterms")
  32.              (item-make "Local" (! "xterm" "-n" hostname
  33.                            "-display" x-screen-name))))
  34.        (for xterm-item xterm-list
  35.         (: xterm-items 
  36.            (+ xterm-items 
  37.           (list (list 'item-make xterm-item 
  38.                   (list '! "/bin/sh" "-c" 
  39.                     (+ "DISPLAY=" x-screen-name
  40.                        ";export DISPLAY; rxterm "
  41.                        xterm-item "</dev/null")))))))
  42.        (: xterm-pop (eval xterm-items))
  43.       
  44.        (setq xload-items 
  45.          '(menu-make (pop-label-make "Xloads")
  46.              (item-make "Local" (! "xload" "-display" x-screen-name))))
  47.        (for xload-item xload-list
  48.         (: xload-items 
  49.            (+ xload-items 
  50.           (list (list 'item-make xload-item
  51.                   (list '! "/bin/sh" "-c"
  52.                     (+ "DISPLAY=" x-screen-name
  53.                        ";export DISPLAY; rxload "
  54.                        xload-item "</dev/null")))))))
  55.        (: xload-pop (eval xload-items)))
  56.      )
  57.  
  58. (de pop-root-menu ()
  59.     (set-colormap-focus ())    ; bugged on dpx???
  60.     (std-pop-menu root-pop))
  61.  
  62.