home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 22 gnu / 22-gnu.zip / gwm18a.zip / data / twm-menus.gwm < prev    next >
Lisp/Scheme  |  1995-07-03  |  6KB  |  192 lines
  1. ; DEFAULT TWM MENUS (hacked up from def-menus.gwm)
  2. ; ================================================
  3.  
  4. ; This file is derived from the def-menus.gwm distributed with gwm 1.4.1.30
  5. ; The original file was written by Colas Nahaboo, BULL Research, France.
  6. ;
  7. ; Modifications  [Dec 1989] for twm emulation by Arup Mukherjee 
  8. ; (arup@grasp.cis.upenn.edu)
  9. ;
  10. ; Within the restrictions of the GWM copyright, you may do whatever you
  11. ; want with this code. It would be nice, however, if my name were to remain 
  12. ; in it somewhere.
  13.  
  14. ; create menus with lists of xterms and xloads
  15. ; ============================================
  16.  
  17. (defname-in-screen-to ()  xterm-pop xload-pop emacs-pop this-display-arg)
  18.  
  19. (df menu-app executable-args
  20.     (eval (+(list ! (# 0 executable-args))
  21.          (list "-display" this-display-arg)
  22.          (sublist 1 (length executable-args) executable-args)))
  23. )
  24.  
  25. (for screen (list-of-screens)
  26.      (: this-display-arg            ; useful for -display option to clients
  27.     (+ (match "\\(.*:.\\)" display-name 1) "." (itoa screen)))
  28.  
  29.      (if (= this-display-arg (+ "unix:0." (itoa screen)))
  30.      (: this-display-arg (+ hostname ":0." (itoa screen))))
  31.  
  32.      (if (not (boundp 'root-pop)) 
  33.      (: root-pop
  34.         (twm-menu-make
  35.          (twm-pop-label-make "Root Options")
  36.          (twm-item-make "Logins..." (twm-pop-menu xterm-pop))
  37.          (twm-item-make "Xloads..." (twm-pop-menu xload-pop))
  38.          (twm-item-make "EMACSen.." (twm-pop-menu emacs-pop))
  39.          (twm-item-make "refresh" (refresh))
  40.          (twm-item-make "restart" (restart))
  41.          (twm-item-make "reload" (load "twm"))
  42.          (twm-item-make "Xloads..." (twm-pop-menu xload-pop))
  43.          (twm-item-make "Exec cut" 
  44.                 (execute-string (+ "(? " cut-buffer ")")))
  45.          (twm-item-make "End" (end))
  46.          )))
  47.     
  48.      (if (not (boundp 'window-pop)) 
  49.      (: window-pop 
  50.         (twm-menu-make
  51.          (twm-pop-label-make "Window Options")
  52.          (twm-item-make "iconify" (iconify-window))
  53.          (twm-item-make "resize" (resize-window))
  54.          (twm-item-make "move" (move-window))
  55.          (twm-item-make "raise" (raise-window))
  56.          (twm-item-make "lower" (lower-window))
  57.          (twm-item-make "refresh" (refresh window))
  58.          (twm-item-make "re-load&dec" 
  59.             (progn (with (window window) (load "twm"))
  60.                    (re-decorate-window)))
  61.          (twm-item-make "redecorate" (re-decorate-window))
  62.          (twm-item-make "Exec cut" 
  63.                 (execute-string (+ "(? " cut-buffer ")")))
  64.          (twm-item-make "client info" 
  65.             (? "Window: " (window-client-class) "."
  66.                (window-client-name) "."
  67.                (window-name) "@"
  68.                (window-machine-name) "\n"))
  69.          (twm-item-make "Geometry" 
  70.             (progn (: WIN window)(? "Geometry:" window-width "x"
  71.                         window-height "+"
  72.                         window-x "+"
  73.                         window-y "\n")))
  74.          (twm-item-make "kill" (kill-window))
  75.          )))
  76.  
  77.      (if (not (boundp 'applications-pop)) 
  78.      (: applications-pop
  79.         (twm-menu-make
  80.          (twm-pop-label-make "Applications")
  81.          (twm-item-make "xterm"     (menu-app "/usr/bin/X11/xterm"))
  82.          (twm-item-make "xclock"    (menu-app "/usr/bin/X11/xclock"))
  83.          (twm-item-make "xload"     (menu-app "/usr/bin/X11/xload"))
  84.          (twm-item-make "xgone"     (menu-app "xgone"))
  85.          (twm-item-make "xbiff"     (! "/usr/ucb/rsh" "grip" "-n"
  86.                        "axbiff" 
  87.                        "-display" this-display-arg
  88.                        "<" "/dev/null" 
  89.                        ">&" "/dev/null" "&"))
  90.          (twm-item-make "gnu-emacs" (menu-app "gnu-emacs"))
  91.          (twm-item-make "vi window" 
  92.                 (menu-app "/usr/bin/X11/xterm" "-e" "vi"))
  93.          (twm-item-make "toggle icon mgr" 
  94.                 (if (boundp 'icon-mgr-toggle)
  95.                 (icon-mgr-toggle)
  96.                   (print "Icon Mgr not Loaded!\n")))
  97.          (twm-item-make "remote logins....." (twm-pop-menu xterm-pop)))))
  98.  
  99.      (if (not (boundp 'icon-pop)) (: icon-pop window-pop))
  100.      
  101.  
  102.      
  103.      (setq xterm-items '(twm-menu-make (twm-pop-label-make "Logins...")
  104.                    (twm-item-make "."
  105.                       (menu-app "/usr/bin/X11/xterm"))))
  106.  
  107.      (for xterm-item xterm-list
  108.       (: xterm-items 
  109.          (+ xterm-items 
  110.         (list (list 'twm-item-make xterm-item 
  111.                  (list '!
  112.                    "/usr/ucb/rsh"
  113.                    (+ "" xterm-item)
  114.                       "-n"
  115.                       "("
  116.                       "setenv" "DISPLAY" this-display-arg ";"
  117.                       "/usr/bin/X11/xterm" "-ls"
  118.                       "-n"
  119.                       "`hostname | sed -e \"s,\\..*,,\"`"
  120.                       ")"
  121.                       "<"
  122.                       "/dev/null"
  123.                       ">&"
  124.                       "/dev/null"
  125.                       "&" ))))))
  126.  
  127.  
  128.      (: xterm-pop (eval xterm-items))
  129.      
  130.      (setq xload-items '(twm-menu-make (twm-pop-label-make "Xloads")
  131.                    (twm-item-make "." 
  132.                        (menu-app "/usr/bin/X11/xload"))))
  133.      (for xload-item xload-list
  134.       (: xload-items 
  135.          (+ xload-items 
  136.         (list (list 'twm-item-make xload-item 
  137.                 (list '!
  138.                   "/usr/ucb/rsh"
  139.                   (+ "" xload-item)
  140.                   "-n"
  141.                   "/usr/bin/X11/xload"
  142.                   "-display" this-display-arg 
  143.                   "<" "/dev/null" ">&" "/dev/null" "&"))))))
  144.      (: xload-pop (eval xload-items))
  145.  
  146.      (setq emacs-items '(twm-menu-make (twm-pop-label-make "EMACSen")
  147.                        (twm-item-make "."
  148.                      (menu-app "/usr/bin/X11/gnu-emacs"))))
  149.  
  150.      (for emacs-item emacs-list 
  151.       (: emacs-items
  152.          (+ emacs-items 
  153.         (list (list 'twm-item-make emacs-item
  154.                 (list '!
  155.                   "/usr/ucb/rsh"
  156.                   (+ "" emacs-item)
  157.                   "-n"
  158.                   "(" "setenv" "DISPLAY" this-display-arg
  159.                     ";" "emacs" ")" 
  160.                     "<" "/dev/null" ">&" "/dev/null" "&"))))))
  161.  
  162.      (: emacs-pop (eval emacs-items))) 
  163.  
  164.  
  165. (de pop-root-menu ()
  166.     (set-colormap-focus ())    ; bugged on dpx???
  167.     (twm-pop-menu root-pop 2))
  168.  
  169.  
  170. (de using-next-window ()
  171.     (with (this-wob wob)
  172.       (with (wob root-window)
  173.         (print "testing....\n")
  174.         (tag press
  175. ;               (send-user-event 'choosing-window)
  176.              (grab-server root-window)
  177.              (while t
  178.                (: mouse-pos (current-mouse-position))
  179.                (if (and (not (= (# 2 mouse-pos) 0))
  180.                 (not (= this-wob 
  181.                     (wob-at-coords (# 0 mouse-pos)
  182.                                (# 1 mouse-pos)))))
  183.                (progn (print "got an event\n")
  184.                   (while t
  185.                     (: mouse-pos 
  186.                        (current-mouse-position))
  187.                     (if (= (# 2 mouse-pos) 0)
  188.                     (exit press)))))))
  189.         (ungrab-server root-window))))
  190.  
  191.     
  192.