home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 22 gnu / 22-gnu.zip / gwm18a.zip / data / .profile.gwm < prev    next >
Lisp/Scheme  |  1995-07-03  |  35KB  |  1,086 lines
  1. ; GWM: an exemple of a user customisation file for the standard profile
  2. ; =====================================================================
  3. ;; code indented by the amc-lisp package of epoch
  4.  
  5. ; How to add code to each window decoration
  6. ;(setq opening
  7. ;  (+ opening '((? "Decorating " window-status " " window-name "\n"))))
  8.  
  9. ;;=============================================================================
  10. ;;                    Colas: My personal profile for gwm-1.7
  11. ;;=============================================================================
  12.  
  13. ;; You may want to put this profile as "site-defs.gwm", and make users include
  14. ;; it in their smaller profiles...
  15.  
  16. ;;=============================================================================
  17. ;;                    general setup: menus, cursors
  18. ;;=============================================================================
  19.  
  20.                     ; global flags
  21. (setq confine-windows t)        ; windows stay on screen
  22.                     ; cursors
  23.  
  24. ;; for me only: how to set the background pattern to a screen-dependent value
  25.  
  26. (setq screen-background (color-make "lightseagreen"))
  27. (setq screen-opening (+ screen-opening 
  28.     (list '(wob-background screen-background)) 
  29. ))
  30.  
  31. (if (not (= 0 (length (getenv "HOSTNAME"))))
  32.   (setq hostname (getenv "HOSTNAME"))
  33.   (setq hostname "local")
  34. )
  35.  
  36. (if (= (getenv "USER") "colas")        
  37.   (progn
  38.     (setq USER 'colas)
  39.     ;; (setq root-cursor  (cursor-make 2))
  40.     (with (background (color-make 'DeepPink)
  41.     foreground (color-make 'DeepPink4))
  42.       (setq cursor  (cursor-make "arrow3d-f" "arrow3d-m"))
  43.     )
  44.     (with (background (color-make 'HotPink)
  45.     foreground (color-make 'HotPink4))
  46.       (setq root-cursor  (cursor-make "arrow3d-f" "arrow3d-m"))
  47.     )
  48.         ;; (setq cursor root-cursor)
  49.     (if (> screen-depth 2)
  50. ;;      uncomment these lines to get a "grainy" background
  51. ;;      (: screen-tile 
  52. ;;        (pixmap-make screen-background "grainy" (color-make "#7bb")))
  53.       (: screen-tile ())
  54.       (> screen-depth 1)
  55.       (: screen-tile (pixmap-make white "back" grey))
  56.       (: screen-tile (pixmap-make "back")))
  57.     
  58.     (set-threshold 1)
  59.     (set-acceleration 2 1)
  60.     (stack-print-level 1000)
  61.   )
  62.   ;; general code for non-me users
  63.   (progn
  64.     (setq USER 'other)
  65.     (stack-print-level 3)
  66.   )
  67. )
  68.  
  69.                     ; menus colors & fonts
  70.  
  71. (setq pop-label.font (font-make "*-helvetica-bold-o-normal--18-*"))
  72. (setq pop-item.font (font-make "*-helvetica-medium-r-normal--14-*"))
  73. (setq pop-item.background (color-make "pink"))
  74. (setq pop-item.foreground (color-make "NavyBlue"))
  75. (setq name-font (font-make "*-times-bold-r-normal--18-*"))
  76. (setq fixed-font (font-make "fixed"))
  77.  
  78.                     ;insert a menu item to root menu
  79. (insert-at '(item-make
  80.     "reset backgrnd" (! "xsetroot" "-solid" "lightseagreen")
  81.       )
  82.       root-pop-items
  83.     6
  84. )
  85.     
  86.  
  87.  
  88.  
  89. ; if you do not see the grid lines when moving/resizing, do a:
  90. ; (setq grid-color (bitwise-xor (color-make "fore") (color-make "back")))
  91. ; with fore and back being the predominant colors on your screen
  92. ; do the same thing with invert-color if you have problems with menus
  93.  
  94. ;;=============================================================================
  95. ;;                    general packages
  96. ;;=============================================================================
  97.  
  98. ;;=============================================================================
  99. ;; NOTE: put here all behavior (fsm) modifications, before loading decorations
  100. ;;=============================================================================
  101.  
  102. ;; how to add a function (iconify on control-alt clik-right) to windows,
  103. ;; and a delta functionality to raise/move windows on button 1:
  104. ;; first, define what to do on these events
  105.  
  106. (load 'deltabutton)
  107.  
  108. (: standard-behavior
  109.    (state-make
  110.     (on (buttonpress 1 alone)
  111.     (if (deltabutton) (progn (raise-window)(move-window))
  112.       (raise-window)))
  113.     (on (buttonpress 1 with-alt)
  114.     (if (deltabutton) (progn (raise-window)(move-window))
  115.       (raise-window)))
  116.     (on (buttonrelease 3 (together with-alt with-control))
  117.     (progn (iconify-window) (raise-window)))
  118.     standard-behavior
  119.     ))
  120.  
  121. ;; second, "grab" these events to prevent them to go to the decorated 
  122. ;; application
  123.  
  124. (setq window-grabs 
  125.     (+ window-grabs 
  126.        (list (buttonpress 3 (together with-alt with-control)))))
  127.  
  128. ;; I also like to be able to do "Exec Cut" anywhere by Ctrl-Alt-F1
  129. ;;================================================================
  130. ;; first abbrev for the event
  131. (setq CtrlAltF1 (key "F1" (together with-alt with-control)))
  132.  
  133. ;; second, put the transition in the relevant behaviors
  134. (: standard-behavior (state-make    ; for windows & icons
  135.     standard-behavior
  136.     (on CtrlAltF1 (execute-string (+ "(? " cut-buffer ")")))
  137. ))
  138. (: root-behavior (state-make        ; root window only
  139.     root-behavior
  140.     (on CtrlAltF1 (execute-string (+ "(? " cut-buffer ")")))
  141. ))   
  142.  
  143. ;; third, grab these events to catch them anywhere
  144. (: window-grabs (+ window-grabs (list CtrlAltF1)))
  145. (: icon-grabs (+ icon-grabs (list CtrlAltF1)))
  146. (: root-grabs (+ root-grabs (list CtrlAltF1)))
  147.  
  148. ;; last register these changes
  149. (reparse-standard-behaviors)
  150.  
  151. ;; load misc little packages
  152. ;;==========================
  153.  
  154. (load 'float)                ; to make sticky windows
  155. (load 'unconf-move)            ; to allow control-moving out of screen
  156. ;(load 'suntools-keys)            ; to add L7 for iconify
  157. (load 'move-opaque)            ; to move windows in real time (NeXT)
  158. ;(load 'mon-keys)            ; M.Newton functions key bindings
  159.  
  160. ;;=============================================================================
  161. ;;                    virtual screen
  162. ;;=============================================================================
  163.  
  164. (setq std-virtual.doors '(
  165.     ("Home" screen-background)
  166.     ("Comp" "LightBlue3")
  167.     ("Mail" 
  168.       (pixmap-make (color-make "seagreen3") "grainy" (color-make "seagreen2"))
  169.       background (color-make "seagreen3"))    
  170.     ("WWW" lightgrey door-icon (pixmap-load "netscape-small.xpm"))
  171.     ("Text" "LightYellow3")
  172.     ("Games" grey)
  173. ))
  174.  
  175. (load "std-virtual.gwm")
  176.  
  177. ;;=============================================================================
  178. ;;                    menus
  179. ;;=============================================================================
  180.  
  181. (if (not (boundp 'Screensaver.menu-added)) (progn
  182.     (setq Screensaver.menu-added t)
  183.  
  184.     (insert-at '(item-make "Screensaver" (! "xscreensaver-command" "-activate"))
  185.       root-pop-items
  186.       6
  187.     )
  188. ))
  189.  
  190.  
  191. ;;=============================================================================
  192. ;; NOTE: Now we can actually load decorations, the fsms have been updated
  193. ;;=============================================================================
  194.  
  195. ;;=============================================================================
  196. ;;                    simple-ed-win
  197. ;;=============================================================================
  198.  
  199. (: edit-keys.backspace "Delete")
  200. (: edit-keys.delete "Escape")
  201.  
  202. ;; My Bull Icon... comment out this code to get rid of my company's logo :-)
  203.  
  204. (setq icon-pixmap         ; put the BULL logo in the upper left corner
  205.   (if (= screen-depth 1)
  206.     (pixmap-make white "bull_1" black "bull_2" white)
  207.       (= screen-depth 2)
  208.     (pixmap-make white "bull_1" darkgrey "bull_2" grey)
  209.       (pixmap-make white "bull_1" (color-make "DarkSlateBlue")
  210.              "bull_2" (color-make "Green")))))
  211.  
  212. ;;=============================================================================
  213. ;;                    icon groups
  214. ;;=============================================================================
  215.  
  216. ;; I don't want to have only one icon for all my epoch screens!
  217.  
  218. (setq icon-groups.excluded '(Emacs Xmh XRn MinibufferScreen))
  219. (load "icon-groups")        ; iconify groups as a whole
  220.  
  221. ;;=============================================================================
  222. ;;                    icons
  223. ;;=============================================================================
  224.  
  225. (setq simple-icon.legend ())        ; no title under icons
  226.  
  227. ;; How to have different icon colors. as you can see, customize is quite
  228. ;; flexible on how to specify arguments
  229.  
  230. (customize simple-icon any Xman
  231.   background (color-make "MistyRose")
  232. )
  233. (customize simple-icon any Xedit
  234.   background (color-make "thistle2")
  235. )
  236. (customize simple-icon any Xdir
  237.   (background (color-make "LightSeaGreen"))
  238. )
  239. (customize simple-icon any Xarchie
  240.   (background (color-make "yellow3"))
  241. )
  242. (customize simple-icon any Xls
  243.   (background (color-make "aquamarine1"))
  244. )
  245. (customize simple-icon any Emacs 
  246.   background (color-make "wheat1")
  247.   label 
  248.   (lambdaq (s) 
  249.     (with (ss (match "^\\([^ ]*\\) @ \\([a-z][a-z]*\\)[.].*$" s 1 2)) 
  250.       (if (or (= "" ss)(= '("" "") ss)) s 
  251.     (if (= hostname (# 1 ss)) (# 0 ss) ;omit host name on local host
  252.       (+ (# 0 ss) " @" (# 1 ss)))
  253.   )))
  254. )
  255.  
  256. (customize simple-icon any MinibufferScreen
  257.   background (color-make "wheat1"))
  258. (customize simple-icon any Xmh
  259.   background (color-make "LightCyan2")
  260.   foreground (color-make "DeepPink2")
  261. )
  262. (customize simple-icon any XRn
  263.   background (color-make "aquamarine2")
  264.   foreground (color-make "DarkSeaGreen4")
  265.   borderwidth 0
  266. )
  267. (customize simple-icon any XRn.xrncma
  268.   background (color-make "LightGoldenrod2")
  269. )
  270. (customize simple-icon any XPostit
  271.   background (color-make "Red")
  272.   foreground (color-make "Yellow")
  273. )
  274. (customize simple-icon any XClipboard
  275.   background (color-make "IndianRed2")
  276. )
  277. (customize simple-win any XClipboard
  278.   font small-font
  279.   background (color-make "IndianRed2")
  280.   active.background (color-make "IndianRed4")
  281.   label.background (color-make "IndianRed2")
  282. ))
  283.  
  284. ;; note that you can specify a client by its class.name.windowname.machine
  285.  
  286. (customize term-icon any XTerm.Console.Console.any
  287.   '(background (color-make "LightSkyBlue2"))
  288. )
  289. (customize term-icon any XTerm.xterm.any.opossum
  290.   background (color-make "PowderBlue")
  291. )
  292. (customize term-icon any XTerm
  293.   background (color-make "LightBlue2")
  294. )
  295.  
  296. (customize term-icon any XTerm.hobbes
  297.   '(background (color-make "LightGoldenRod3"))
  298. )
  299. (customize simple-icon any Xmh.any.any.lemur
  300.   background (color-make "LightGoldenRod3")
  301.   foreground (color-make "MidnightBlue")
  302. )
  303. (customize simple-icon any Tk.zircon
  304.   background (color-make "yellow2")
  305. )
  306. (customize simple-icon any Zircon
  307.   background (color-make "yellow2")
  308. )
  309.       
  310. (set-icon XLess (pixmap-load "xterm.xpm"))
  311. (customize simple-icon any XLess
  312.   background (color-make "LavenderBlush2")
  313.   legend t
  314.   stretch t
  315.   borderwidth 0
  316. )
  317. (customize simple-icon any Zircon.@info
  318.   simple-icon.plug-name "Zircon info"
  319.   background (color-make "yellow2")
  320. )
  321. (customize simple-icon any Tk.zircon.Zircon_Control_Panel
  322.   simple-icon.plug-name "Zircon MAIN"
  323.   background (color-make "yellow2")
  324. )
  325.  
  326. (defun xpm-icon-zircon (init?)
  327.   (if ( = window-icon-name "*#koala*")
  328.     (pixmap-load (+ window-client-class "-icon." "yes"))
  329.     (pixmap-load (+ window-client-class "-icon." "no"))))
  330. (require 'near-mouse)
  331. (set-placement Zircon near-mouse)
  332.  
  333. (set-icon-window any Zircon*IRC_Channel_#koala (xpm-icon xpm-icon-zircon))
  334. (set-icon-window any Zircon.channel16.IRC_Channel_#koala (xpm-icon xpm-icon-zircon))
  335. (set-icon-window any Zircon.any.IRC_Channel_#koala (xpm-icon xpm-icon-zircon))
  336.  
  337. (set-icon XPostit (pixmap-load "xpostit-icon"))
  338. (set-icon-window XTerm.Console ())
  339. (set-icon XTerm.Console (pixmap-load "xterm.xpm"))
  340. (set-icon Pixmap (pixmap-load "pixmap.xpm"))
  341.  
  342. ;;=============================================================================
  343. ;;                    affectation of decorations to windows
  344. ;;=============================================================================
  345.  
  346. (set-window any simple-win)    ; Any X Client
  347.  
  348. ;; how to fully customize decos: define a Lisp function to choose the
  349. ;; deco for the client with full lisp power, then affect it as a deco to 
  350. ;; clients
  351.  
  352. (defun xterm-deco ()
  353.   (if (= window-client-name "test") 'test-win ; atoms
  354.     (= window-client-name "vb") "vb-term"     ; or strings are equivalent
  355.       'simple-ed-win                  ; means load file & execute func
  356. ))
  357.  
  358. (set-window XTerm.Console vb-term)    ; XTERM
  359. (set-window XTerm simple-ed-win)    ; XTERM
  360.  
  361. ;(setq term-icon:background screen-background)
  362. (setq term-icon:background "none")
  363. (load 'term-icon-xpm.gwm)
  364.  
  365. (set-icon-window XTerm
  366.   (term-icon-xpm "xterm3" pop-item.font
  367.   (color-make "#73737F7F8A8A")
  368.   (color-make "yellow")))
  369.  
  370. (setq xterm-decos.sony 
  371.   '(term-icon-xpm "xterm3" pop-item.font
  372.   (color-make "green4")
  373.   (color-make "yellow")))
  374. (set-icon-window XTerm*maki xterm-decos.sony)
  375. (set-icon-window XTerm*lemur xterm-decos.sony)
  376.  
  377. (setq xterm-decos.indri 
  378.   '(term-icon-xpm "xterm3" pop-item.font
  379.   (color-make "HotPink4")
  380.   (color-make "yellow")))
  381. (set-icon-window XTerm*indri xterm-decos.indri)
  382.  
  383. (setq xterm-decos.mips 
  384.   '(term-icon-xpm "xterm3" pop-item.font
  385.   (color-make "blue4")
  386.   (color-make "yellow")))
  387. (set-icon-window XTerm*opossum xterm-decos.mips)
  388. (set-icon-window XTerm*aye xterm-decos.mips)
  389. (set-icon-window XTerm*koala xterm-decos.mips)
  390. (set-icon-window XTerm*wombat xterm-decos.mips)
  391.  
  392.  
  393. (set-window XLoad no-frame) ; XLOAD
  394. (set-window XPostit no-frame-no-borders)
  395. (set-window XCal no-frame-no-borders)
  396. (set-window XBiff no-frame-no-borders)
  397. (set-window Sxpm no-frame-no-borders)
  398.  
  399. ;(set-window XClock frame-win)    ; XCLOCK
  400. (set-window XClock no-frame)    ; XCLOCK
  401. (set-window Clock frame-win)
  402.  
  403. (set-window chaos no-frame)
  404.  
  405. (set-icon-window any simple-icon) ; Any icon
  406. (set-window client no-frame-no-borders) ; xwud
  407.  
  408. (set-icon XCol (pixmap-load 'xcol-icon.xpm))
  409.  
  410. ;(load 'waiting-xterm)            ; prepared in advance xterms
  411.  
  412. (set-placement Netrek.wait rows.right-top.placement)
  413. (set-window  Netrek.wait no-frame-no-borders)
  414. (set-window XPmview no-frame-no-borders)
  415. (set-icon TkMan (pixmap-load "LRom1.xpm"))
  416. (set-icon Dayview (pixmap-load "datebook.xpm"))
  417. ;;(set-icon Mosaic (pixmap-load "mosaic.xpm"))
  418. (customize simple-icon any Mosaic
  419.   borderwidth 0
  420. )
  421. (set-icon Xfilemanager (pixmap-load "cdrom1.xpm"))
  422.  
  423. (defun xpm-icon-xrn (init?)
  424.   (if ( = window-icon-name "xrn-nonews")
  425.     (pixmap-load "xrn-nonews")
  426.     (= window-icon-name "xrn-busy")
  427.     (pixmap-load "xrn-busy")
  428.     (pixmap-load "xrn")
  429. ))
  430. (defun xpm-icon-xrn2 (init?)
  431.   (if ( = window-icon-name "xrn2-nonews")
  432.     (pixmap-load "xrn2-nonews")
  433.     (= window-icon-name "xrn-busy")
  434.     (pixmap-load "xrn2-busy")
  435.     (pixmap-load "xrn2")
  436. ))
  437. (set-icon-window any XRn (xpm-icon xpm-icon-xrn))
  438. (set-icon-window any XRn.xrn2 (xpm-icon xpm-icon-xrn2))
  439. (set-icon-window any XRn.Composition ())
  440. (set-icon-window any XRn.Information ())
  441.  
  442. (setq bar-max-width 500)
  443. (set-icon Netscape (pixmap-load "netscape-small.xpm"))
  444. (customize simple-icon any Netscape
  445.   legend "left"
  446.   stretch t
  447.   borderwidth 0
  448.   background screen-background
  449.   label (lambdaq (s)     (if (= s "icon") "Bookmarks" (match "Netscape: \\(.*\\)$" s 1)))
  450. )
  451.  
  452. ;;=============================================================================
  453. ;;                    placements
  454. ;;=============================================================================
  455.  
  456. (set-placement XTerm user-positioning)  ; place manually xterms
  457.  
  458. (if (not (= USER 'colas))        ; people other than me like to have 
  459.                     ; interactive placement for all windows
  460.   (set-placement * user-positioning)
  461. )
  462.  
  463. (set-icon-placement any rows.right-top.placement) ; place most icons on right
  464.  
  465. ; xloads, xclocks, etc goes on NE corner
  466.  
  467. (set-placement XLoad.xload rows.top-right.placement) 
  468. (set-placement XPostit.xpostit.xpostit rows.top-right.placement) 
  469. (set-placement XClock rows.top-right.placement) 
  470. (set-placement Clock rows.top-right.placement) 
  471. (set-placement XBiff rows.top-right.placement) 
  472. (set-placement XLogo rows.down-right.placement) 
  473.  
  474. (set-icon-placement Gwm rows.down-right.placement) ; inactive dvrooms
  475. (set-window Gwm no-frame)
  476. (set-placement Gwm            ; active dvrooms
  477.            (lambda (f) (if (= window-name "rmgr")
  478.                      (if f
  479.                    (move-window
  480.                     (- screen-width 175)
  481.                     60)))))))))
  482.  
  483. (set-placement XPostit.xpostit rows.top-right.placement)
  484.  
  485. (set-placement XCal rows.top-right.placement) ; XCal windows
  486.  
  487. ;; specify the ordering of icons
  488.  
  489. (setq icon-order '(Xmh 10 XPostit 5 XRn 20 XClock 2 Clock 2 XBiff 1 XLoad 20
  490.     XTerm 90 Emacs 30 XDvi 250 XCal 1000
  491.     Zircon 15 Tk.zircon 15))
  492.  
  493. (rows.limits rows.right-top 'start 55 'separator 1 'sort sort-icons 'end 1000)
  494. (rows.limits rows.down-right 'start 100 'separator 1 'offset
  495.      (- screen-height 70))
  496. (rows.limits rows.down-left 'start 600 'separator 1 'offset 1)
  497. (rows.limits rows.top-right 'start 55  'sort sort-icons)
  498.  
  499.  
  500. ;; I want my local xload on the top right corner
  501.  
  502. (set-placement XLoad.xloadlocal
  503.   (lambda (f) (if f (progn
  504.     (move-window (- screen-width window-width wob-borderwidth) 0)
  505.     (## 'update-placement window  ())
  506. )))))
  507.  
  508. ;;=============================================================================
  509. ;;                    a better icon sorter, weigths given by customize
  510. ;;=============================================================================
  511.  
  512. (defun pack-icons (w1 w2)
  513.   (with (wob w1 weight1 100 weight2 100 n1 window-icon-name)
  514.     (setq weight1 (# 'weight (std-resource-get 'PackIcons 'pack-icons)))
  515.     (if (not weight1) (setq weight1 100))
  516.     (setq wob w2)
  517.     (setq weight2 (# 'weight (std-resource-get 'PackIcons 'pack-icons)))
  518.     (if (not weight2) (setq weight2 100))
  519.     
  520.     (if (= weight1 weight2)
  521.       (compare n1 window-icon-name)
  522.       (compare weight1 weight2)
  523. )))
  524.  
  525. (customize pack-icons any any weight 100)
  526.  
  527. (rows.limits rows.right-top 'sort pack-icons)
  528.  
  529. ;; my personal weights
  530.  
  531. (customize pack-icons any Xmh weight 10)
  532. (customize pack-icons any XPostit weight 5)
  533. (customize pack-icons any XRn weight 20)
  534. (customize pack-icons any XClock weight 2)
  535. (customize pack-icons any Clock weight 2)
  536. (customize pack-icons any XBiff weight 1)
  537. (customize pack-icons any XLoad weight 20)
  538. (customize pack-icons any XTerm weight 90)
  539. (customize pack-icons any Emacs weight 30)
  540. (customize pack-icons any XDvi weight 250)
  541. (customize pack-icons any XCal weight 1000)
  542. (customize pack-icons any Zircon weight 15)
  543. (customize pack-icons any Tk.zircon weight 15)
  544.  
  545. ;;=============================================================================
  546. ;;                    Misc Examples
  547. ;;=============================================================================
  548.  
  549. ; have a list of machines for xterms and xload alphabetically sorted
  550.  
  551. (setq xload-list (: xterm-list '(
  552.       avahi lemur  aye maki indri
  553.       celeste rataxes columbo
  554.       aenegada capa
  555.       modja crios ploum milos rhea
  556.       babar  paprika trinidad bahia oural arthur
  557.       tatoo almeria tsoris mbili bagheera falbala
  558.       oaxaca))))
  559.  
  560. ; I sort the list of machines alphabetically
  561.  
  562. (sort xterm-list (lambdaq (atom1 atom2) (compare atom1 atom2)))
  563.  
  564. ;; Example on how to make a window start as iconic: 
  565. ;; first, sets its window-starts-iconic to t,
  566. ;; then return deco
  567.  
  568. (defun no-frame-iconic ()
  569.     '(progn
  570.     (window-starts-iconic t)
  571.     (no-frame)))
  572. ;; we use this for xdvi, which has no -iconic option
  573. (set-window XDvi no-frame-iconic)
  574.  
  575. ; how to affect a decoration by some other criterions:
  576. ; example: set deco of xrn windows by size: small windows (popups) do not
  577. ; have decos, big ones (height > 200) have
  578.  
  579. (setq XRn-deco '(if (> window-height 200)
  580.     (progn
  581.       (require 'simple-win)        ; we must load it if it wasn't here
  582.       (simple-win 'font small-font
  583.     'background (color-make "PaleGreen2")
  584.     'active.background (color-make "PaleGreen4")
  585.     'label.background (color-make "PaleGreen2")
  586.     ))
  587.     no-frame-no-borders            ; no visible frame on popups
  588. ))
  589. (set-window XRn XRn-deco)
  590.  
  591. (setq XRn-deco.xrncma '(if (> window-height 200)
  592.     (progn
  593.       (require 'simple-win)        ; we must load it if it wasn't here
  594.       (simple-win 'font small-font
  595.     'background (color-make "GoldenRod2")
  596.     'active.background (color-make "GoldenRod4")
  597.     'label.background (color-make "GoldenRod2")
  598.     ))
  599.     no-frame-no-borders            ; no visible frame on popups
  600. ))
  601. (set-window XRn.xrncma XRn-deco.xrncma)
  602.  
  603. ;; in fact, you can give customization argiments either to the function itself
  604. ;; or like here by another call to customize...
  605.  
  606. (set-window XTerm.xterm_Lpq simple-win)
  607. (customize simple-win any XTerm.xterm_Lpq font small-font
  608.     background (color-make "Yellow3")
  609.     active.background (color-make "Yellow1")
  610.     label.background (color-make "Yellow3")
  611. )))
  612.  
  613. ;;=============================================================================
  614. ;;                    stacking xmemuse windows ont top of each other
  615. ;;=============================================================================
  616.  
  617. (customize simple-win any Xmemuse.xmemuse.xmemuse.aye
  618.   font fixed-font
  619.   active.font fixed-font
  620.   active.label.background grey
  621.   label (lambda (s) window-machine-name)
  622.   tile t
  623.   label.background screen-background
  624.   legend "right"
  625.   lpad 0
  626.   rpad 4
  627. )
  628. (customize simple-win any Xmemuse.xmemuse.xmemuse.lemur
  629.   font fixed-font
  630.   active.font fixed-font
  631.   active.label.background grey
  632.   label (lambda (s) window-machine-name)
  633.   tile t
  634.   label.background screen-background
  635.   legend "right"
  636.   lpad 1
  637.   rpad 3
  638. )
  639. (customize simple-win any Xmemuse.xmemuse.xmemuse.maki
  640.   font fixed-font
  641.   active.font fixed-font
  642.   active.label.background grey
  643.   label (lambda (s) window-machine-name)
  644.   tile t
  645.   label.background screen-background
  646.   legend "right"
  647.   lpad 2
  648.   rpad 2
  649. )
  650. (customize simple-win any Xmemuse
  651.   font fixed-font
  652.   active.font fixed-font
  653.   active.label.background grey
  654.   label (lambda (s) window-machine-name)
  655.   tile t
  656.   label.background screen-background
  657.   legend "right"
  658.   lpad 4
  659.   rpad 0
  660. )
  661.  
  662. ;;=============================================================================
  663. ;;                    emacs windows: small-win is a  variant of simple-win
  664. ;;=============================================================================
  665.  
  666. ;; first, we create the variant by calling the simple-win deco with a
  667. ;; context as argument (think of it as a closure made with the simple-win
  668. ;; deco + another environnement)
  669.  
  670. (require 'simple-win)            ; ensure simple-win func is defined
  671. (: small-win '(simple-win 'font small-font
  672.     'background (color-make "BurlyWood")
  673.     'active.background (color-make "orange4")
  674.     'label.background (color-make "BurlyWood")
  675. ))
  676. (: lemacs-win '(with (ignore-take-focus t)
  677.     (simple-win 'font small-font
  678.     'background (color-make "BurlyWood")
  679.     'active.background (color-make "orange4")
  680.     'label.background (color-make "BurlyWood")
  681. )))
  682. ;; then we can use it
  683.  
  684. (set-window Emacs small-win)
  685. (set-window Emacs.emacs lemacs-win)
  686. (set-window emacs (simple-win 'font small-font))
  687. (set-window Emacs.epoch.minibuffer no-frame)
  688. (set-window MinibufferScreen no-frame)
  689.  
  690. ;;=============================================================================
  691. ;;                    xmh
  692. ;;=============================================================================
  693.  
  694. (load 'xpm-icon)
  695. (set-icon-window any Xmh.xmh.xmh:_inbox (xpm-icon xpm-icon-by-size))
  696. (set-icon-window any Xmh ())
  697.  
  698. (set-icon XClipboard (pixmap-load "clipboard.xpm"))
  699. (set-icon XRn.xrn (pixmap-load "Xrn-icon"))
  700. (set-icon XRn.xrn-6_18 (pixmap-load "Xrn-icon"))
  701. (set-window Clock.oclock no-frame-no-borders)
  702.  
  703. ;;=============================================================================
  704. ;;                    epoch placement
  705. ;;=============================================================================
  706.  
  707. ;; this is a code to arrange my epoch window: make new epoch windows occupy
  708. ;; vacant slots in the "Epoch-windows-list"
  709. ;; Sample list is one to the left, and a cascade to the right
  710.  
  711. (if (= USER 'colas) (progn
  712.     (setq Epoch-windows-list '(
  713.     ;; free (width height x-pixel-pos y-pixel-pos ordering-number)    
  714.     free (80 87 0 0 0)
  715.     free (80 87 585 0 1)
  716.     free (80 85 605 22 2)
  717.     free (80 83 625 44 3)
  718.     free (80 81 645 66 4)
  719.     free (80 79 665 88 5)
  720.     free (80 77 685 110 6)
  721.     free (80 75 705 132 7)
  722.     ))
  723.     
  724.     (set-placement Emacs.epoch 
  725.       (lambda (flag)
  726.     (if flag            ; opening: seek free slot
  727.       (if (not window-starts-iconic) ; then put window-id instead of free
  728.         (place-epoch-window)
  729.       )
  730.                     ; closing: put 'free in slot
  731.       (with (e (member window Epoch-windows-list))
  732.         (if e
  733.           (replace-nth e Epoch-windows-list 'free)
  734.     )))))
  735.     
  736. ;; search Epoch-windows-list for free slots, and move & resize window there
  737.     (defun place-epoch-window ()
  738.       (with (geometry (nth 'free Epoch-windows-list))
  739.     (if geometry
  740.       (progn
  741.         (move-window (nth 2 geometry) (nth 3 geometry))
  742.         (setq window-size (sublist 0 2 geometry))
  743.         (replace-nth (* 2 (nth 4 geometry)) Epoch-windows-list window)
  744.     ))))
  745.  
  746.  
  747. ;;; same for lucid emacs
  748.     (setq Emacs-windows-list '(
  749.     ;; free (width height x-pixel-pos y-pixel-pos ordering-number)    
  750.     free (82 69 20 0 0)
  751.     free (82 69 540 0 1)
  752.     free (82 67 560 22 2)
  753.     free (82 65 580 44 3)
  754.     free (82 63 600 66 4)
  755.     free (82 61 620 88 5)
  756.     free (82 59 640 110 6)
  757.     free (82 57 660 132 7)
  758.     ))
  759.     
  760.     (set-placement Emacs.emacs 
  761.       (lambda (flag)
  762.     (if flag            ; opening: seek free slot
  763.       (if (not window-starts-iconic) ; then put window-id instead of free
  764.         (place-emacs-window)
  765.       )
  766.                     ; closing: put 'free in slot
  767.       (with (e (member window Emacs-windows-list))
  768.         (if e
  769.           (replace-nth e Emacs-windows-list 'free)
  770.     )))))
  771.     ;; search Emacs-windows-list for free slots, and move & resize window there
  772.     (defun place-emacs-window ()
  773.       (with (geometry (nth 'free Emacs-windows-list))
  774.     (if geometry
  775.       (progn
  776.         (move-window (nth 2 geometry) (nth 3 geometry))
  777.         (setq window-size (sublist 0 2 geometry))
  778.         (replace-nth (* 2 (nth 4 geometry)) Emacs-windows-list window)
  779.     ))))
  780.  
  781.  
  782. ))
  783.  
  784. ;; Personal clients
  785. (if (= USER 'colas) (progn
  786.     (setq xlpwatch.color (color-make "bisque"))
  787.     (set-icon Tk.xlpwatch (pixmap-make xlpwatch.color "printer.xbm" black))
  788.     (set-window Tk.xlpwatch no-frame-no-borders)
  789.     (set-icon Tk.xlpwatch_#2 (pixmap-make xlpwatch.color "printer.xbm" black))
  790.     (set-window Tk.xlpwatch_#2 no-frame-no-borders)
  791.     (set-icon Tk.xlpwatch_#3 (pixmap-make xlpwatch.color "printer.xbm" black))
  792.     (set-window Tk.xlpwatch_#3 no-frame-no-borders)
  793. ))
  794.  
  795. (set-window XQuery.NewMail no-frame-no-borders)
  796. (set-placement XQuery.NewMail rows.left-top.placement)
  797.  
  798. ;;=============================================================================
  799. ;; buttons for often done actions
  800. ;; button creation must be done at screen-opening-time
  801. ;;=============================================================================
  802.  
  803. (if (and (= USER 'colas) (not (boundp 'TEST)))
  804.   (progn
  805.     (setq screen-opening (+ screen-opening '(
  806.       
  807. ;;      ;; kill all my "new mail" windows
  808. ;;      (place-3d-button "kill-mails"
  809. ;;        black  'CadetBlue
  810. ;;        '(for window (list-of-windows) 
  811. ;;          (if (= window-client-name 'NewMail)(kill-window))
  812. ;;      ))
  813. ;;      
  814. ;;      ;; show/hide my vital postit, determined by its size
  815. ;;      (place-3d-button "admin-post"
  816. ;;        black 'khaki
  817. ;;        '(for window (list-of-windows) 
  818. ;;          (if (and (= window-name 'PostItNote)
  819. ;;          (= window-width 515)(= window-height 191)
  820. ;;        )
  821. ;;        (if window-is-mapped (iconify-window)
  822. ;;          (progn (map-window)(raise-window))
  823. ;;      ))))
  824. ;;      
  825. ;;      ;; toggle on/off all big postits
  826. ;;      (place-3d-button "Post Big"
  827. ;;        black 'thistle
  828. ;;        '(for window (list-of-windows) 
  829. ;;          (if (= window-name 'PostItNoteBig)
  830. ;;        (if window-is-mapped (iconify-window)
  831. ;;          (progn (map-window)(raise-window))
  832. ;;      ))))
  833. ;;      
  834. ;;      ;; toggle on/off all normal postits
  835. ;;      (place-3d-button "Post Norm"
  836. ;;        black 'khaki
  837. ;;        '(for window (list-of-windows) 
  838. ;;          (if (= window-name 'PostItNote)
  839. ;;        (if window-is-mapped (iconify-window)
  840. ;;          (progn (map-window)(raise-window))
  841. ;;      ))))
  842. ;;      
  843. ;;      ;; toggle on/off all small postits
  844. ;;      (place-3d-button "Post Small"
  845. ;;        black 'SpringGreen
  846. ;;        '(for window (list-of-windows) 
  847. ;;          (if (= window-name 'PostItNoteSmall)
  848. ;;        (if window-is-mapped (iconify-window)
  849. ;;          (progn (map-window)(raise-window))
  850. ;;        )))
  851. ;;      )
  852. ;;      
  853.       
  854.       ;; raise/lower/iconify (depending of button) all xterms
  855.       (place-3d-button "XTerms"
  856.         black 'LightBlue
  857.         '(if (= 0 (current-event-modifier))
  858.           (for window (list-of-windows 'window) 
  859.         (if (and (= window-client-class 'XTerm) window-is-mapped)
  860.           (if (= 1 (current-event-code))
  861.             (raise-window)
  862.             (= 2 (current-event-code))
  863.             (lower-window)
  864.             (= 3 (current-event-code))
  865.             (iconify-window)
  866.           )))
  867.           (for window (list-of-windows 'icon)
  868.         (if (and (= window-client-class 'XTerm) window-is-mapped)
  869.           (if (= 1 (current-event-code))
  870.             () ;; to be completed
  871.             (= 2 (current-event-code))
  872.             () ;; to be completed
  873.             (= 3 (current-event-code))
  874.             (iconify-window)
  875.       )))))
  876.       
  877.       ;; forks an lpwatch
  878.       (place-3d-button "lpq"
  879.         black 'bisque
  880.         '(! "rx" "paprika" "PATH=`cat ~/bin/sun4/.path`; xlpwatch -geometry +750+900")
  881.       )
  882.  
  883.       ;; resets the selection state of the server
  884.       (place-3d-button "blank" black 'pink
  885.         '(! "xscreensaver-command" "-activate")
  886.       )
  887.     )))
  888.     
  889.     (set-placement Gwm.button rows.right-down.placement)
  890.     (set-window Gwm.button no-frame-no-borders)
  891. ))
  892.  
  893. ;;=============================================================================
  894. ;; some little modifications after modules have been loaded
  895. ;;=============================================================================
  896. ;; a bit of a hack. just to show it can be done.
  897.  
  898. ;; change font of first item of window menu
  899. (## 0 window-pop-items
  900.   (list 'with '(pop-item.font (font-make "*-helvetica-bold-r-normal--14-*"))
  901.     (# 0 window-pop-items)
  902. ))
  903.  
  904. (setq old-get-x-resource resource-get)
  905. ;(defun resource-get (class name)
  906. ;;  (? "GET [" class "] [" name "]\n")
  907. ;  (old-get-x-resource class name)
  908. ;)
  909. (setq reenter-on-opening ())
  910.  
  911. ;; idraw: place pop-up on left top
  912.  
  913. (set-placement Dialog.idraw26
  914.   (lambda (f) (if f (progn (move-window 0 0) (resize-window 210 800)
  915. ))))
  916.  
  917. ;;=============================================================================
  918. ;; framemaker windows
  919. ;;=============================================================================
  920. (load 'framemaker)
  921.  
  922. (setq frame-icon-color.1 (color-make "LightYellow2"))
  923. (setq frame-icon-font.1 pop-item.font)
  924. (setq frame-icon-color.2 (color-make "LightYellow3"))
  925. (setq frame-icon-font.2 small-font)
  926. (setq frame-inactive-color frame-icon-color.1)
  927. (setq frame-active-color (color-make "LightYellow4"))
  928.  
  929. (set-icon Maker.makerkit (pixmap-load "App_write.xpm"))
  930. (set-icon-window Maker
  931.   (if (= "makerkit" window-client-name) ; top window(menu): use frame pixmap
  932.     (simple-icon 'background frame-icon-color.2)
  933.  
  934.     (match ".*kit" window-client-name)
  935.     (progn                ; main edit windows: icon name
  936.       (simple-icon 'background frame-icon-color.1
  937.     'simple-icon.plug-name (+ "[ " window-icon-name " ]")
  938.     'simple-icon.no-center-plug t
  939.     'font frame-icon-font.1
  940.       )
  941.     )
  942.  
  943.                     ; all popups, use a smaller name
  944.     (with (name (match "FrameMaker - \\(.*\\)$" window-name 1))
  945.       (if (= name "")
  946.     (setq name window-name)
  947.       )
  948.       (if
  949.     (= name "Character Format") (setq name "Format Chr")
  950.     (= name "Paragraph Format") (setq name "Format Par")
  951.     (= name "\xB6 Catalog") (progn
  952.       (setq window-name "Par Catalog")
  953.       (setq name "Catalog Par")
  954.     )
  955.     (= name "C Catalog") (setq name "Catalog Chr")
  956.     (= name "Spelling Checker") (setq name "Spell")
  957.       )
  958.       (simple-icon 'background frame-icon-color.2
  959.     'font frame-icon-font.2
  960.     'simple-icon.plug-name name)
  961. )))
  962.  
  963. (setq icon-order (+ icon-order '(Maker 210)))
  964.  
  965. ;; experimental epoch menus
  966.  
  967. (setq epoch-color "bisque")
  968.  
  969. (for i '("1" "2" "3" "4")
  970.   (set (atom (+ "epoch-color" i))
  971.     (color-make (+ epoch-color i))
  972. ))
  973.  
  974. (: widget.Bfont  (font-make "*clean-medium*--10*c-60*"))
  975. (: widget.font (font-make "*clean-bold*--10*c-60*"))
  976. (setq widget.foreground epoch-color4)
  977. (setq widget.background epoch-color1)
  978. (setq widget.name-font (font-make "fixed"))
  979. (setq widget.name-foreground black)
  980.  
  981. (: widget.weave (pixmap-make
  982.     epoch-color4
  983.     "/usr/include/X11/bitmaps/cross_weave"
  984.     epoch-color1
  985. ))
  986. (: widget.black (pixmap-make
  987.     black
  988.     "/usr/include/X11/bitmaps/black"
  989.     epoch-color4
  990. ))
  991. (: widget.gray (pixmap-make
  992.     black
  993.     "/usr/include/X11/bitmaps/black"
  994.     epoch-color4
  995. ))
  996. (: widget.lt-gray (pixmap-make
  997.     black
  998.     "/usr/include/X11/bitmaps/black"
  999.     epoch-color2
  1000. ))
  1001.  
  1002. (load "em-widgets.gwm")
  1003. (load "em-drop-menus.gwm")
  1004. (set-window Emacs.epoch style:select)
  1005.  
  1006. (Dmenu: Dmenu.fonts
  1007.    '("fonts" (
  1008.       ("screen-11" "(progn (font \"screen.r.11\") (redraw-display))")
  1009.       ("screen-12" "(progn (font \"screen.r.12\") (redraw-display))")
  1010.       ("screen-12-Bold" "(progn (font \"screen.b.12\") (redraw-display))")
  1011.       ("screen-13" "(progn (font \"screen.r.13\") (redraw-display))")
  1012.       ("screen-14" "(progn (font \"screen.r.14\") (redraw-display))")
  1013.       ("screen-14-Bold" "(progn (font \"screen.b.14\") (redraw-display))")
  1014.       ("screen-7" "(progn (font \"screen.r.7\") (redraw-display))")
  1015.       ("fixed" "(progn (font \"fixed\") (redraw-display))")
  1016.       )))
  1017.  
  1018. (Dmenu: Dmenu.buffers 
  1019.    '("buffers" (
  1020.       ("list of buffers"
  1021.     "(progn \
  1022. (list-buffers) \
  1023. (switch-to-buffer \"*Buffer List*\") \
  1024. (delete-other-windows) \
  1025. (if (not (boundp 'mouse-Buffer-menu-select)) (progn \
  1026.     (setq mouse-Buffer-menu-select t)\
  1027.     (defun mouse-Buffer-menu-select (&optional mdata) (interactive) \
  1028.       (Buffer-menu-select) \
  1029. ))) \
  1030. (if (boundp 'imouse-version)\
  1031.   (local-set-mouse mouse-middle mouse-down 'mouse-set-point-or-select) \
  1032.   (local-set-mouse mouse-middle mouse-down 'mouse::set-point)) \
  1033. (local-set-mouse mouse-middle mouse-up 'mouse-Buffer-menu-select) \
  1034. )")
  1035.       ("other buffer" "(switch-to-buffer (other-buffer))")
  1036.       ("*scratch* buffer" "(switch-to-buffer \"*scratch*\")")
  1037.       ("-" (bell))
  1038.       ("kill buffer" "(kill-buffer (current-buffer))")
  1039.       )))
  1040.  
  1041. (Dmenu: Dmenu.files 
  1042.    '("files" (
  1043.       ("list of directory"
  1044.     "(progn \
  1045. (dired \".\") \
  1046. (delete-other-windows) \
  1047. (if (not (boundp 'mouse-dired-find-file)) (progn \
  1048.     (setq mouse-dired-find-file t)\
  1049.     (defun mouse-dired-find-file (&optional mdata) (interactive) \
  1050.       (dired-find-file) \
  1051. ))) \
  1052. (if (boundp 'imouse-version)\
  1053.   (local-set-mouse mouse-middle mouse-down 'mouse-set-point-or-select) \
  1054.   (local-set-mouse mouse-middle mouse-down 'mouse::set-point)) \
  1055. (local-set-mouse mouse-middle mouse-up 'mouse-dired-find-file) \
  1056. )")
  1057.     (" - - - " "")
  1058.     (".Xdefaults" "(find-file \"~/.Xdefaults\")")
  1059.     ("profile-epoch" "(find-file \"~/el/profile-epoch-4.0.el\")")
  1060.     ("wool TODO" "(find-file \"~/Wool2/src/TODO\")")
  1061.     ("wool Log" "(find-file \"~/Wool2/src/Log\")")
  1062.     ("gwm-talk" "(find-file \"~/mailist/gwm-talk\")")
  1063.     ("gwm-bugs" "(find-file \"~/mailist/gwm-bugs\")")
  1064.     ("gwm-welcome" "(find-file \"~/mailist/newusers-gwm\")")
  1065.  
  1066.       )))
  1067.  
  1068. (Dmenu: Dmenu.db
  1069.     '("db" 
  1070.      (
  1071.       (" " "")
  1072.       ("byte-compile-current-file" "(byte-compile-current-file)")
  1073.       ("toggle debug" "(setq debug-on-error (not debug-on-error))")
  1074.       ("debug on" "(setq debug-on-error t)")
  1075.       ("debug off" "(setq debug-on-error f)")
  1076.       )))
  1077.  
  1078. (: Dmenu.epoch-menus
  1079.    (list 
  1080.     Dmenu.fonts
  1081.     Dmenu.files
  1082.     Dmenu.buffers
  1083.     Dmenu.db
  1084.     ))
  1085.  
  1086.