home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 22 gnu / 22-gnu.zip / gwm18a.zip / data / mwm.gwm < prev    next >
Lisp/Scheme  |  1995-07-03  |  4KB  |  159 lines
  1. ;;File: mwm.gwm -- the main file for MWM emulation under GWM
  2. ;;Author: colas@mirsa.inria.fr (Colas NAHABOO) -- Bull Research FRANCE
  3. ;;Author: glen WHITNEY -- UCLA Math Department
  4. ;;Revision: 1.4 -- June 12 1989
  5. ;;Revision: 1.5 -- June 26 1992
  6. ;;State: Exp
  7. ;;GWM Version: 1.7l
  8.  
  9. ;; this profile is monoscreen only
  10.  
  11. (if (> (length (list-of-screens)) 1)
  12.     (progn
  13.       (? "The mwm profile works only on one screen. Restarting with -1fmwm\n")
  14.       (restart "gwm" "-1fmwm")))
  15.  
  16. ; banner
  17. ; ======
  18.  
  19. (if (= display-name "unix:0")
  20.     (if (: machine (getenv "machine"))
  21.     (: display-name (+ machine ":0"))))
  22.  
  23. (if (= 0 gwm-quiet)
  24.     (? display-name "." screen " " screen-width " x " screen-height " x " 
  25.        screen-depth "\n"))
  26. (if (= 0 gwm-quiet) (print "reading..."))
  27. (: original-load load)
  28. (if (= 0 gwm-quiet) (defun load (file) (? ".")(original-load file)))
  29.  
  30. ; global switches
  31. ; ===============
  32.  
  33. (: property ())
  34. (: borderwidth 1)
  35.  
  36. (: to-be-done-after-setup '(progn))
  37. (: screen-opening '(progn))        ; actions to be done before operation
  38. (: screen-closing '(progn))        ; actions to be done when ending
  39.  
  40. ; per-screen data setting
  41. ; =======================
  42.  
  43. (defunq defname-in-screen-to args
  44.     (with (value (eval (# 0 args))
  45.          vars (sublist 1 (length args) args))
  46.       (for var vars
  47.            (defname var screen. value))))
  48.  
  49. (defunq set-color (name value)
  50.     (if (not (= screen. (namespace-of name))) {
  51.     (defname name screen.)
  52.     (for screen (list-of-screens)
  53.          (set name (color-make value)))
  54.     }
  55.     ))
  56.  
  57. (defunq set-pixmap args
  58.     (with (name (# 0 args)
  59.         pixmap-make-call (# 0 args 'pixmap-make))
  60.       (if (not (= screen. (namespace-of name))) {
  61.           (defname name screen.)
  62.           (for screen (list-of-screens)
  63.            (set name (eval pixmap-make-call)))
  64.           }
  65.       ))))
  66.  
  67. ; per-screen data
  68. ; ===============
  69.  
  70. (defname-in-screen-to () tile screen-tile bordertile menu root-cursor)
  71.  
  72. (set-color black Black)
  73. (set-color white White)
  74. (set-color grey Grey)
  75. (set-color darkgrey DarkSlateGrey)
  76.  
  77. (load "mwmrc")
  78. (load "mwm-bindings")
  79.  
  80. (set-pixmap icon-pixmap "icon20")
  81.     
  82. (defname 'look-3d screen.)
  83. (for screen (list-of-screens)
  84.     (if (= 'mono screen-type)
  85.     (: look-3d ())
  86.     (: look-3d t)
  87.     ))))
  88.  
  89. (load "mwm-utils.gwm")
  90.  
  91. ; automatic placement
  92. ; ===================
  93.  
  94. (load "mwm-placements")
  95.  
  96. ; Pop-ups
  97. ; =======
  98.  
  99. (: window-grabs
  100.    (list (button any with-alt)
  101.      (button 1 (together with-shift with-alt))))
  102.  
  103. (: root-grabs
  104.    (list (button any with-alt)
  105.      (button 1 (together with-shift with-alt))))
  106.  
  107. (load "mwm-menus.gwm")
  108.  
  109. ; Menus and Bindings
  110. ;-------------------
  111.  
  112. ; get the internal default versions of these.
  113. (load "mwm-internal.gwmMwmrc")
  114.  
  115. ; For now, get the menu, key, and buttonbindings in gwm format
  116. ; from .gwmMwmrc, or if that doesn't exist, from system.gwmMwmrc
  117. ; The next revision would be to fork a process which interprets
  118. ; the .mwmrc file into gwm code and then causes gwm to load it.
  119.  
  120. (if (not (load ".gwmMwmrc")) (load "system.gwmMwmrc"))
  121.  
  122. (: buttonBindings (eval buttonBindings))
  123. (: keyBindings (eval keyBindings))
  124.  
  125. ; Read what used to be the profile
  126. (if (= 0 gwm-quiet) (? "["))
  127. (for screen (list-of-screens) (load "mwmprofile.gwm"))
  128. (if (= 0 gwm-quiet) (? "]"))
  129.     
  130. ; Get the mwm window and icon description
  131. (load "mwm-win")
  132. (load "mwm-icon")
  133.  
  134. ; DESCRIBE-SCREEN & DESCRIBE-WINDOW
  135. ; =================================
  136.  
  137. (de describe-screen ()
  138.   (with (fsm root-fsm cursor root-cursor tile screen-tile
  139.       grabs (+ (# 1 (# 'root keyBindings)) root-std-grabs)
  140.       opening 
  141.       '(progn (eval to-be-done-after-setup)
  142.     (eval screen-opening)
  143.     (if (= 0 gwm-quiet) (? "Screen #" screen " ready.\n")))
  144.       closing '(eval screen-closing)
  145.     )
  146.     (window-make () () () () ())))
  147.  
  148. (de describe-window ()
  149.     (list mwm-win mwm-icon))
  150.  
  151. ;  Bye bye
  152. ; ========
  153.  
  154. (setq load original-load)
  155. (if (= 0 gwm-quiet) (print "...done\n"))
  156.  
  157. (? "keyboardFocusPolicy = " keyboardFocusPolicy "\n")
  158. (setq keyboardFocusPolicy 'pointer)
  159.