home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 22 gnu / 22-gnu.zip / gwm18a.zip / data / twm.gwm < prev    next >
Lisp/Scheme  |  1995-07-03  |  12KB  |  428 lines
  1. ; TWM SETUP PROFILE
  2. ; =================
  3.  
  4. ; This file is derived from the .gwmrc.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.  
  15. ; banner
  16. ; ======
  17.  
  18. (setq display-name-radix (match "\\([^:]*:[0-9][0-9]*\\)" display-name 1))
  19. (defname 'x-screen-name screen. '(+ display-name-radix "." (itoa screen)))
  20.  
  21. (if (= gwm-quiet 0) {
  22.     (for screen (list-of-screens)
  23.      (? x-screen-name " " screen-width " x " screen-height " x " 
  24.         screen-depth "\n"))
  25.     (print "reading...")
  26.     (: original-load load)
  27.     (defun load (file) (? ".")(original-load file))
  28.     }
  29. )
  30.  
  31. ; appearance
  32. ; ==========
  33.  
  34. (: name-font (font-make "9x15"))
  35. (: meter-font (font-make "9x15"))
  36. (: bull-font (font-make "9x15"))
  37. (: small-font (font-make "6x10"))
  38.  
  39. ; global switches
  40. ; ===============
  41.  
  42. (: move-grid-style 3)
  43. (: resize-grid-style 4)
  44.  
  45. (: property ())
  46. (: borderwidth 1)
  47. (: any-button (button any any))
  48. (: any-key (key any any))
  49.  
  50. (: select-button 1)
  51. (: action-button 2)
  52. (: menu-button 3)
  53.  
  54. (: autoraise ())
  55. (: autocolormap t)
  56. (: xterm-list '())
  57. (: xload-list '())
  58. (: no-set-focus ())
  59. (: to-be-done-after-setup '(progn))
  60. (: no-reenter-on-placed-wobs 1)
  61. (: screen-opening '(progn))        ; actions to be done before operation
  62. (: screen-closing '(progn))        ; actions to be done when ending
  63.  
  64. ; per-screen data setting
  65. ; =======================
  66.  
  67. (defunq defname-in-screen-to args
  68.     (with (value (eval (# 0 args))
  69.          vars (sublist 1 (length args) args))
  70.       (for var vars
  71.            (defname var screen. value))))
  72.  
  73. (defunq set-color (name value)
  74.     (if (not (= screen. (namespace-of name))) {
  75.     (defname name screen.)
  76.     (for screen (list-of-screens)
  77.          (set name (color-make value)))
  78.     }
  79.     ))
  80.  
  81. (defunq set-pixmap args
  82.     (with (name (# 0 args)
  83.         pixmap-make-call (# 0 args 'pixmap-make))
  84.       (if (not (= screen. (namespace-of name))) {
  85.           (defname name screen.)
  86.           (for screen (list-of-screens)
  87.            (set name (eval pixmap-make-call)))
  88.           }
  89.       ))))
  90.  
  91. ; per-screen data
  92. ; ===============
  93.  
  94. (defname-in-screen-to () tile screen-tile bordertile menu root-cursor)
  95.  
  96. (defname 'root-pop screen.)
  97. (defname 'window-pop screen.)
  98. (defname 'icon-pop screen.)
  99. (defname 'applications-pop screen.)
  100. (set-color black Black)
  101. (set-color white White)
  102. (set-color grey Grey)
  103. (set-color darkgrey DarkSlateGrey)
  104.  
  105. (set-pixmap icon-pixmap "icon20")
  106.     
  107. (defname 'look-3d screen.)
  108. (for screen (list-of-screens)
  109.     (if (= 'mono screen-type)
  110.     (: look-3d ())
  111.     (: look-3d t)
  112.     (: invert-color (bitwise-xor black white))
  113.     ))))
  114.  
  115.  
  116. ; functions to affect decorations to a client name
  117. ; =================================================
  118.  
  119. ; The assignement of decorations to client names:
  120. ; a decoration is either:
  121. ;     a function yielding the decoration
  122. ;       an unbound variable: the corresponding file is then loaded, which
  123. ;           must define the function
  124.  
  125. (load "utils.gwm")
  126.  
  127. (defname '-screen-name screen.)
  128. (for screen (list-of-screens)
  129.     (: -screen-name (+ "S" (itoa screen)))
  130.     (resource-put (+ -screen-name ".GwmWindow." ".window" screen-type) ())
  131.     (resource-put (+ -screen-name ".GwmIconWindow." ".icon"  screen-type) ())
  132.     (resource-put (+ -screen-name ".GwmIconPixmap." ".icon" screen-type) ())
  133.     (resource-put (+ -screen-name ".GwmPlacement." ".window" screen-type)
  134.     'default-placement)
  135.     (resource-put (+ -screen-name ".GwmIconPlacement." ".icon" screen-type)
  136.     'default-placement)
  137. )
  138.  
  139. (: string-types '(string t atom t pointer t active t))
  140.  
  141. (defun autoload-description (name)
  142.     (if (= 'string (type name)) (: name (atom name)))
  143.     (if (not (boundp name))
  144.     (load name)))
  145.  
  146.  
  147. (defun set-window-resource (client description resource-prefix screentype)
  148.   (if (or (= 'any screentype) (= screentype screen-type)) (progn
  149.     (if (# (type description) string-types)
  150.     (progn
  151.           (if (match ".*[.]gwm" description)
  152.           (: description (match "\\(.*\\)[.]gwm" description 1)))
  153.           (autoload-description description)))
  154.     (setq description (eval description))
  155.     (if (: tmp 
  156.        (if (= (type description) 'client)
  157.            description
  158.            (eval (list description))))
  159.     (resource-put (+ -screen-name resource-prefix client "." screentype)
  160.         tmp)
  161.     ))))))
  162.  
  163. (defunq set-window args
  164.     (if (= 3 (length args)) (set-window-resource 
  165.         (# 1 args) (# 2 args) '.GwmWindow. (# 0 args))
  166.     (= 2 (length args)) (set-window-resource
  167.         (# 0 args) (# 1 args) '.GwmWindow. 'any)
  168.     (? "ERROR: set-window must have 2 or 3 args "
  169.        (+ '(set-window) args) "\n")
  170.     ))))   
  171.  
  172. (defunq set-icon-window args
  173.     (if (= 3 (length args)) (set-window-resource
  174.         (# 1 args) (# 2 args) '.GwmIconWindow. (# 0 args))
  175.     (= 2 (length args)) (set-window-resource
  176.         (# 0 args) (# 1 args) '.GwmIconWindow. 'any)
  177.     (? "ERROR: set-icon-window must have 2 or 3 args "
  178.        (+ '(set-icon-window) args) "\n")
  179.     ))))
  180.  
  181. (defunq set-icon args
  182.     (if (= 3 (length args)) 
  183.     (resource-put 
  184.         (+ -screen-name '.GwmIconPixmap. (# 1 args) "." (# 0 args))
  185.         (expand-pixmap (# 2 args)))
  186.     
  187.     (= 2 (length args))
  188.     (resource-put
  189.         (+ -screen-name '.GwmIconPixmap. (# 0 args) ".any")
  190.         (expand-pixmap (# 1 args)))
  191.     
  192.     (? "ERROR: set-icon must have 2 or 3 args "
  193.        (+ '(set-icon) args) "\n")
  194.     ))
  195.  
  196. (defun expand-pixmap (obj)
  197.     (if (= 'list (type obj))
  198.     (eval obj)
  199.     (pixmap-make obj)))
  200.  
  201. (defunq set-placement args
  202.     (if (= 3 (length args))
  203.     (resource-put 
  204.         (+ -screen-name '.GwmPlacement. (# 1 args) "." (# 0 args))
  205.         (# 2 args))
  206.     (= 2 (length args))
  207.     (resource-put (+ -screen-name '.GwmPlacement. (# 0 args) ".any")
  208.         (# 1 args))
  209.     (? "ERROR: set-placement must have 2 or 3 args "
  210.        (+ '(set-placement) args) "\n")
  211.     ))
  212.  
  213. (defunq set-icon-placement args
  214.     (if (= 3 (length args))
  215.     (resource-put 
  216.         (+ -screen-name '.GwmIconPlacement. (# 1 args) "." (# 0 args))
  217.         (# 2 args))
  218.     (= 2 (length args))
  219.     (resource-put (+ -screen-name ".GwmIconPlacement." (# 0 args) ".any")
  220.         (# 1 args))
  221.     (? "ERROR: set-icon-placement must have 2 or 3 args "
  222.        (+ '(set-icon-placement) args) "\n")
  223.     ))
  224.  
  225. ; automatic placement
  226. ; ===================
  227.  
  228. (de apply1 (func arg)
  229.     (eval (list (eval func) arg)))
  230.  
  231. (: opening 
  232.     '(progn 
  233.         (apply1 (if (= window-status 'icon)
  234.             (resource-get 
  235.                 (+ -screen-name ".GwmIconPlacement." 
  236.                    window-client-class "." screen-type)
  237.                 "S.GwmIconPlacement.any.any")
  238.             (resource-get 
  239.                 (+ -screen-name ".GwmPlacement." 
  240.                    window-client-class "." screen-type)
  241.                 "S.GwmPlacement.any.any"))
  242.         t)
  243.         (if (and (and (not (= (compare window-name icon-mgr-name) 0))
  244.               show-icon-mgr)
  245.              (boundp 'setup-done)
  246.              (not (= window-status 'icon)))
  247.         (icon-mgr-display window))))
  248. (: closing 
  249.     '(progn 
  250.         (apply1 (if (= window-status 'icon)
  251.          (resource-get 
  252.              (+ -screen-name ".GwmIconPlacement."
  253.              window-client-class "." screen-type)
  254.              "S.GwmIconPlacement.any.any")
  255.          (resource-get 
  256.              (+ -screen-name ".GwmPlacement." 
  257.              window-client-class "." screen-type)
  258.              "S.GwmPlacement.any.any"))
  259.          ())
  260.         (if (and (not (= (compare window-name icon-mgr-name) 0))
  261.              show-icon-mgr)
  262.         (with (icon-mgr-dying-window window)
  263.               (icon-mgr-display)))))
  264.  
  265. ; default placement make title bar in screen
  266. (defun default-placement (flag)
  267.     (if flag
  268.     (if (< window-y 0) (move-window window-x 0))))
  269.  
  270. (load "placements")
  271.  
  272. ; default behaviors
  273. ; ==================
  274.  
  275. (: standard-behavior
  276.     (state-make
  277.     (on (buttonpress 1 alone) (twm-pop-menu window-pop))
  278.     (on (buttonpress 2 alone) (move-window))
  279.     (on (buttonpress 2 with-alt) (move-window))
  280.     (on (buttonpress 3 alone) (twm-pop-menu root-pop))
  281.     (on (buttonpress 3 with-alt) (iconify-window))))
  282.  
  283. (: standard-title-behavior
  284.     (state-make
  285.      (on (buttonpress 2 alone) (move-window))
  286.     standard-behavior
  287.     ))
  288. (: window-behavior
  289.     (state-make
  290.     standard-behavior
  291.     (on (buttonpress 1 with-alt) (twm-pop-menu window-pop))
  292.     (on (buttonpress 2 alone) (move-window))
  293.     (on (buttonpress 2 with-alt) (move-window))
  294.     (on name-change (send-user-event 'name-change))
  295.     (on focus-in (progn (if autoraise (raise-window))
  296.                 (send-user-event 'focus-in)))
  297.     (on focus-out (send-user-event 'focus-out))
  298.     (if no-set-focus
  299.         (on enter-window (progn (if autoraise (raise-window))))
  300.         (on enter-window (progn (if autoraise (raise-window))
  301.                     (set-focus)
  302.                     (if autocolormap (set-colormap-focus)))))
  303.     (on leave-window (set-focus ()))
  304.     (on (property-change 'WM_ICON_NAME)
  305.         (if (window-icon?)
  306.         (send-user-event 'get-icon window-icon)))
  307.     (on window-icon-pixmap-change 
  308.         (if (window-icon?)
  309.         (send-user-event 'icon-pixmap-change window-icon)))
  310.     ))
  311. (: icon-behavior
  312.     (state-make
  313.     (on (buttonpress 1 any) (progn (iconify-window)(raise-window)))
  314.     (on (buttonpress 3 any) (progn (iconify-window)(raise-window)))
  315.     standard-behavior
  316.     ))
  317. (: root-behavior
  318.     (state-make
  319.      (on (buttonpress 1 any) (twm-pop-menu root-pop))
  320.      (on (buttonpress 2 any) (twm-pop-menu applications-pop 0))
  321.      (on (buttonpress 3 any) (twm-pop-menu root-pop 0))
  322.      (on (key (key-make "BackSpace") with-alt) 
  323.      (execute-string (+ "(? " cut-buffer ")")))
  324.      (on (key (key-make "Delete") with-alt) (end))
  325.      ))
  326.  
  327. (: grabs 
  328.     (: root-grabs
  329.        (: window-grabs 
  330.       (: icon-grabs
  331.          (list
  332.           (button any with-alt)
  333.           (button 1 (together with-shift with-alt)))))))
  334.  
  335. ; simple fsms
  336.  
  337. (: fsm (fsm-make (state-make standard-behavior)))
  338. (: window-fsm (fsm-make (state-make window-behavior))))
  339. (: icon-fsm (fsm-make (state-make icon-behavior)))
  340. (: root-fsm (fsm-make (state-make root-behavior)))
  341.  
  342. ;; for running under gwm 1.7
  343.  
  344. (if (not (boundp 'simple-win)) (load 'simple-win-old))
  345. (if (not (boundp 'simple-icon)) (load 'simple-icon-old))
  346.  
  347. ; Pop-ups
  348. ; =======
  349.  
  350. (load "twm-popups.gwm")        ; the twm menu package
  351.  
  352. ; read user customizations in .profile.gwm, once per screen
  353. ; =========================================================
  354.  
  355. (if (= 0 gwm-quiet) (? "["))
  356. (for screen (list-of-screens) 
  357.     (load "twmrc.gwm")
  358.     (load "twm-icon-mgr.gwm")
  359.     (if (= 'string (type screen-tile))
  360.     (: screen-tile (pixmap-make screen-tile)))
  361. )
  362. (if (= 0 gwm-quiet) (? "]"))
  363.     
  364. (load "twm-menus.gwm")
  365. (for screen (list-of-screens) (: menu 'window-pop))
  366.  
  367.  
  368. ; The simplest window: no-decoration
  369. ; ==================================
  370.  
  371. ; use the "simple-icon" package as the defaults for icons
  372. (if (not (boundp 'simple-icon)) (load 'simple-icon-old))))
  373.  
  374. (defun simple-window-decoration ()
  375.       (with (fsm window-fsm
  376.              borderwidth 0
  377.              inner-borderwidth any
  378.              menu window-pop)
  379.         (window-make () () () () ())))
  380. (: no-frame-no-borders (: simple-icon-decoration
  381.     (: no-decoration simple-window-decoration))
  382. )
  383.  
  384. ; no-decoration by a small border
  385.  
  386. (df no-frame () (window-make ()()()()()))
  387.  
  388. ; DESCRIBE-SCREEN & DESCRIBE-WINDOW
  389. ; =================================
  390.  
  391. (de describe-screen ()
  392.   (with (fsm root-fsm cursor root-cursor menu root-pop tile screen-tile
  393.       opening 
  394.       '(progn (eval to-be-done-after-setup) 
  395.     (eval screen-opening)
  396.     (if (= 0 gwm-quiet) 
  397.       (? "Screen #" screen " ready.\n")))
  398.       closing '(eval screen-closing)
  399.     )
  400.     (window-make () () () () ()))))
  401.  
  402. (de describe-window ()
  403.     (list
  404.      (if (: tmp (resource-get 
  405.             (+ -screen-name ".GwmWindow." 
  406.                window-client-class "." screen-type) 
  407.             "S.GwmWindow.any.any"))
  408.          tmp
  409.          simple-window-decoration)
  410.      (if (: tmp (resource-get
  411.             (+ -screen-name ".GwmIconWindow." 
  412.                window-client-class "." screen-type) 
  413.             "S.GwmIconWindow.any.any"))
  414.          tmp
  415.          simple-icon-decoration)
  416.      )
  417. )))
  418.  
  419. ;  Bye bye
  420. ; ========
  421.  
  422. (if (= 0 gwm-quiet) {
  423.     (setq load original-load)
  424.     (print "...done\n")
  425.     }
  426.     (bell)
  427. )
  428.