1151 lines
36 KiB
Plaintext
1151 lines
36 KiB
Plaintext
; GWM: an exemple of a user customisation file for the standard profile
|
|
; =====================================================================
|
|
;; code indented by the amc-lisp package of epoch
|
|
|
|
; How to add code to each window decoration
|
|
;(setq opening
|
|
; (+ opening '((? "Decorating " window-status " " window-name "\n"))))
|
|
|
|
;;=============================================================================
|
|
;; Colas: My personal profile for gwm-1.7
|
|
;;=============================================================================
|
|
|
|
;; You may want to put this profile as "site-defs.gwm", and make users include
|
|
;; it in their smaller profiles...
|
|
|
|
;;=============================================================================
|
|
;; general setup: menus, cursors
|
|
;;=============================================================================
|
|
|
|
; global flags
|
|
(setq confine-windows t) ; windows stay on screen
|
|
; cursors
|
|
|
|
;; for me only: how to set the background pattern to a screen-dependent value
|
|
|
|
(setq screen-background (color-make "lightseagreen"))
|
|
(if (not (= 0 (length (getenv "HOSTNAME"))))
|
|
(setq hostname (getenv "HOSTNAME"))
|
|
(setq hostname "local")
|
|
)
|
|
|
|
(if (= (getenv "USER") "colas")
|
|
(progn
|
|
(setq USER 'colas)
|
|
;; (setq root-cursor (cursor-make 2))
|
|
(with (background (color-make 'DeepPink)
|
|
foreground (color-make 'DeepPink4))
|
|
(setq cursor (cursor-make "arrow3d-f" "arrow3d-m"))
|
|
)
|
|
(with (background (color-make 'HotPink1)
|
|
foreground (color-make 'HotPink4))
|
|
(setq root-cursor (cursor-make "arrow3d-f" "arrow3d-m"))
|
|
)
|
|
;; (setq cursor root-cursor)
|
|
(if (> screen-depth 2)
|
|
;; (: screen-tile (pixmap-make (color-make "DeepSkyBlue3")
|
|
;; "grainy" (color-make "DodgerBlue3")))
|
|
(: screen-tile ())
|
|
(> screen-depth 1)
|
|
(: screen-tile (pixmap-make white "back" grey))
|
|
(: screen-tile (pixmap-make "back")))
|
|
|
|
(set-threshold 1)
|
|
(set-acceleration 2 1)
|
|
(stack-print-level 1000)
|
|
)
|
|
;; general code for non-me users
|
|
(progn
|
|
(setq USER 'other)
|
|
(stack-print-level 3)
|
|
)
|
|
)
|
|
|
|
; menus colors & fonts
|
|
|
|
(setq pop-label.font (font-make "*-helvetica-bold-o-normal--18-*"))
|
|
(setq pop-item.font (font-make "*-helvetica-medium-r-normal--14-*"))
|
|
(setq pop-item.background (color-make "pink"))
|
|
(setq pop-item.foreground (color-make "blue4"))
|
|
(setq name-font (font-make "*-times-bold-r-normal--18-*"))
|
|
(setq fixed-font (font-make "fixed"))
|
|
|
|
;insert a menu item to root menu
|
|
(insert-at '(item-make
|
|
"reset backgrnd" (! "xsetroot" "-solid" "lightseagreen")
|
|
)
|
|
root-pop-items
|
|
6
|
|
)
|
|
|
|
|
|
|
|
|
|
; if you do not see the grid lines when moving/resizing, do a:
|
|
; (setq grid-color (bitwise-xor (color-make "fore") (color-make "back")))
|
|
; with fore and back being the predominant colors on your screen
|
|
; do the same thing with invert-color if you have problems with menus
|
|
|
|
;;=============================================================================
|
|
;; general packages
|
|
;;=============================================================================
|
|
|
|
;;=============================================================================
|
|
;; NOTE: put here all behavior (fsm) modifications, before loading decorations
|
|
;;=============================================================================
|
|
|
|
;; how to add a function (iconify on control-alt clik-right) to windows,
|
|
;; and a delta functionality to raise/move windows on button 1:
|
|
;; first, define what to do on these events
|
|
|
|
(load 'deltabutton)
|
|
|
|
(: standard-behavior
|
|
(state-make
|
|
(on (buttonpress 1 alone)
|
|
(if (deltabutton) (progn (raise-window)(move-window))
|
|
(raise-window)))
|
|
(on (buttonpress 1 with-alt)
|
|
(if (deltabutton) (progn (raise-window)(move-window))
|
|
(raise-window)))
|
|
(on (buttonrelease 3 (together with-alt with-control))
|
|
(progn (iconify-window) (raise-window)))
|
|
standard-behavior
|
|
))
|
|
|
|
;; second, "grab" these events to prevent them to go to the decorated
|
|
;; application
|
|
|
|
(setq window-grabs
|
|
(+ window-grabs
|
|
(list (buttonpress 3 (together with-alt with-control)))))
|
|
|
|
;; I also like to be able to do "Exec Cut" anywhere by Ctrl-Alt-F1
|
|
;;================================================================
|
|
;; first abbrev for the event
|
|
(setq CtrlAltF1 (key "F1" (together with-alt with-control)))
|
|
|
|
;; second, put the transition in the concerned behaviors
|
|
(: standard-behavior (state-make ; for windows & icons
|
|
standard-behavior
|
|
(on CtrlAltF1 (execute-string (+ "(? " cut-buffer ")")))
|
|
))
|
|
(: root-behavior (state-make ; root window only
|
|
root-behavior
|
|
(on CtrlAltF1 (execute-string (+ "(? " cut-buffer ")")))
|
|
))
|
|
|
|
(: window-grabs (+ window-grabs (list CtrlAltF1)))
|
|
(: icon-grabs (+ icon-grabs (list CtrlAltF1)))
|
|
(: root-grabs (+ root-grabs (list CtrlAltF1)))
|
|
|
|
;; then register these changes
|
|
(reparse-standard-behaviors)
|
|
|
|
;; load misc little packages
|
|
;;==========================
|
|
|
|
(load 'float) ; to make sticky windows
|
|
(load 'unconf-move) ; to allow control-moving out of screen
|
|
;(load 'suntools-keys) ; to add L7 for iconify
|
|
(load 'move-opaque) ; to move windows in real time (NeXT)
|
|
;(load 'mon-keys) ; M.Newton functions key bindings
|
|
|
|
;;=============================================================================
|
|
;; virtual screen
|
|
;;=============================================================================
|
|
|
|
|
|
;; (setq std-virtual.doors '(
|
|
;; ("Home" screen-background)
|
|
;; ("Comp" "LightBlue3")
|
|
;; ("Mail"
|
|
;; (pixmap-make (color-make "seagreen3") "grainy" (color-make "seagreen2"))
|
|
;; background (color-make "seagreen3"))
|
|
;; ("WWW" lightgrey door-icon (pixmap-load "netscape-small.xpm"))
|
|
;; ("Text" "LightYellow3")
|
|
;; ("Games" grey)
|
|
;; ))
|
|
;;
|
|
;; (load "std-virtual.gwm")
|
|
|
|
;;=============================================================================
|
|
;; menus
|
|
;;=============================================================================
|
|
|
|
(if (not (boundp 'Screensaver.menu-added)) (progn
|
|
(setq Screensaver.menu-added t)
|
|
|
|
(insert-at '(item-make "Screensaver" (! "xscreensaver-command" "-activate"))
|
|
root-pop-items
|
|
6
|
|
)
|
|
))
|
|
|
|
|
|
;;=============================================================================
|
|
;; NOTE: Now we can actually load decorations, the fsms have been updated
|
|
;;=============================================================================
|
|
|
|
;;=============================================================================
|
|
;; simple-ed-win
|
|
;;=============================================================================
|
|
|
|
(: edit-keys.backspace "Delete")
|
|
(: edit-keys.delete "Escape")
|
|
|
|
;; My Bull Icon... comment out this code to get rid of my company's logo :-)
|
|
|
|
(setq icon-pixmap ; put the BULL logo in the upper left corner
|
|
(if (= screen-depth 1)
|
|
(pixmap-make white "bull_1" black "bull_2" white)
|
|
(= screen-depth 2)
|
|
(pixmap-make white "bull_1" darkgrey "bull_2" grey)
|
|
(pixmap-make white "bull_1" (color-make "DarkSlateBlue")
|
|
"bull_2" (color-make "Green")))))
|
|
|
|
;;=============================================================================
|
|
;; windows
|
|
;;=============================================================================
|
|
|
|
(customize simple-win any Xmemuse.xmemuse.xmemuse.aye
|
|
font fixed-font
|
|
active.font fixed-font
|
|
active.label.background grey
|
|
label (lambda (s) window-machine-name)
|
|
tile t
|
|
label.background screen-background
|
|
legend "right"
|
|
lpad 0
|
|
rpad 4
|
|
)
|
|
(customize simple-win any Xmemuse.xmemuse.xmemuse.lemur
|
|
font fixed-font
|
|
active.font fixed-font
|
|
active.label.background grey
|
|
label (lambda (s) window-machine-name)
|
|
tile t
|
|
label.background screen-background
|
|
legend "right"
|
|
lpad 1
|
|
rpad 3
|
|
)
|
|
(customize simple-win any Xmemuse.xmemuse.xmemuse.maki
|
|
font fixed-font
|
|
active.font fixed-font
|
|
active.label.background grey
|
|
label (lambda (s) window-machine-name)
|
|
tile t
|
|
label.background screen-background
|
|
legend "right"
|
|
lpad 2
|
|
rpad 2
|
|
)
|
|
(customize simple-win any Xmemuse
|
|
font fixed-font
|
|
active.font fixed-font
|
|
active.label.background grey
|
|
label (lambda (s) window-machine-name)
|
|
tile t
|
|
label.background screen-background
|
|
legend "right"
|
|
lpad 4
|
|
rpad 0
|
|
)
|
|
|
|
;;=============================================================================
|
|
;; icon groups
|
|
;;=============================================================================
|
|
|
|
;; I don't want to have only one icon for all my epoch screens!
|
|
|
|
(setq icon-groups.excluded '(Emacs Xmh XRn MinibufferScreen))
|
|
(load "icon-groups") ; iconify groups as a whole
|
|
|
|
;;=============================================================================
|
|
;; icons
|
|
;;=============================================================================
|
|
|
|
(setq simple-icon.legend ()) ; no title under icons
|
|
|
|
;; How to have different icon colors. as you can see, customize is quite
|
|
;; flexible on how to specify arguments
|
|
|
|
(customize simple-icon any Xman
|
|
background '(color-make "MistyRose")
|
|
)
|
|
(customize simple-icon any Xedit
|
|
background '(color-make "thistle2")
|
|
)
|
|
(customize simple-icon any Xdir
|
|
(background '(color-make "LightSeaGreen"))
|
|
)
|
|
(customize simple-icon any Xarchie
|
|
(background '(color-make "yellow3"))
|
|
)
|
|
(customize simple-icon any Xls
|
|
(background '(color-make "aquamarine1"))
|
|
)
|
|
(customize simple-icon any Emacs
|
|
background '(color-make "wheat1")
|
|
label
|
|
(lambdaq (s)
|
|
(with (ss (match "^\\([^ ]*\\) @ \\([a-z][a-z]*\\)[.].*$" s 1 2))
|
|
(if (or (= "" ss)(= '("" "") ss)) s
|
|
(if (= hostname (# 1 ss)) (# 0 ss) ;omit host name on local host
|
|
(+ (# 0 ss) " @" (# 1 ss)))
|
|
)))
|
|
)
|
|
|
|
(customize simple-icon any MinibufferScreen
|
|
background '(color-make "wheat1"))
|
|
(customize simple-icon any Xmh
|
|
background '(color-make "LightCyan2")
|
|
foreground '(color-make "DeepPink2")
|
|
)
|
|
(customize simple-icon any XRn
|
|
background '(color-make "aquamarine2")
|
|
foreground '(color-make "DarkSeaGreen4")
|
|
borderwidth 0
|
|
)
|
|
(customize simple-icon any XRn.xrncma
|
|
background '(color-make "LightGoldenrod2")
|
|
)
|
|
(customize simple-icon any XPostit
|
|
background '(color-make "Red")
|
|
foreground '(color-make "Yellow")
|
|
)
|
|
(customize simple-icon any XClipboard
|
|
background '(color-make "IndianRed2")
|
|
)
|
|
(customize simple-win any XClipboard
|
|
font small-font
|
|
background '(color-make "IndianRed2")
|
|
active.background '(color-make "IndianRed4")
|
|
label.background '(color-make "IndianRed2")
|
|
))
|
|
|
|
(customize simple-icon any Ghostview background '(color-make "LemonChiffon2"))
|
|
|
|
;; note that you can specify a client by its class.name.windowname.machine
|
|
|
|
(customize term-icon any XTerm.Console.Console.any
|
|
'(background (color-make "LightSkyBlue2"))
|
|
)
|
|
(customize term-icon any XTerm.xterm.any.opossum
|
|
background '(color-make "PowderBlue")
|
|
)
|
|
(customize term-icon any XTerm
|
|
background "none"
|
|
)
|
|
|
|
(customize term-icon any XTerm.hobbes
|
|
'(background '(color-make "LightGoldenRod3"))
|
|
)
|
|
(customize simple-icon any Xmh.any.any.lemur
|
|
background '(color-make "LightGoldenRod3")
|
|
foreground '(color-make "blue4")
|
|
)
|
|
(customize simple-icon any Tk.zircon
|
|
background (color-make "yellow")
|
|
)
|
|
(customize simple-icon any Zircon
|
|
background (color-make "yellow")
|
|
)
|
|
(customize simple-icon any XLess
|
|
background '(color-make "LavenderBlush2")
|
|
)
|
|
(customize simple-icon any Zircon.@info
|
|
simple-icon.plug-name "Zircon info"
|
|
background (color-make "yellow")
|
|
)
|
|
(customize simple-icon any Tk.zircon.Zircon_Control_Panel
|
|
simple-icon.plug-name "Zircon MAIN"
|
|
background (color-make "yellow")
|
|
)
|
|
|
|
(set-icon any Zorro.@todo (pixmap-load "xedit.xpm"))
|
|
(customize simple-icon any Zorro
|
|
background lightgrey
|
|
label (lambdaq (s)
|
|
(if (= s "icon") "todo-pops" "TODO"))
|
|
)
|
|
|
|
(defun xpm-icon-zircon (init?)
|
|
(if ( = window-icon-name "*#koala*")
|
|
(pixmap-load (+ window-client-class "-icon." "yes"))
|
|
(pixmap-load (+ window-client-class "-icon." "no"))))
|
|
(require 'near-mouse)
|
|
(set-placement Zircon near-mouse)
|
|
|
|
(set-icon-window any Zircon*IRC_Channel_#koala (xpm-icon xpm-icon-zircon))
|
|
(set-icon-window any Zircon.channel16.IRC_Channel_#koala (xpm-icon xpm-icon-zircon))
|
|
(set-icon-window any Zircon.any.IRC_Channel_#koala (xpm-icon xpm-icon-zircon))
|
|
|
|
(set-icon XPostit (pixmap-load "xpostit-icon"))
|
|
(set-icon-window XTerm.Console ())
|
|
(set-icon XTerm.Console (pixmap-load "xterm.xpm"))
|
|
(set-icon Pixmap (pixmap-load "pixmap.xpm"))
|
|
|
|
;;=============================================================================
|
|
;; affectation of decorations to windows
|
|
;;=============================================================================
|
|
|
|
(set-window any simple-win) ; Any X Client
|
|
|
|
;; how to fully customize decos: define a Lisp function to choose the
|
|
;; deco for the client with full lisp power, then affect it as a deco to
|
|
;; clients
|
|
|
|
(defun xterm-deco ()
|
|
(if (= window-client-name "test") 'test-win ; atoms
|
|
(= window-client-name "vb") "vb-term" ; or strings are equivalent
|
|
'simple-ed-win ; means load file & execute func
|
|
))
|
|
|
|
(set-window XTerm.Console vb-term) ; XTERM
|
|
(set-window XTerm simple-ed-win) ; XTERM
|
|
|
|
(setq term-icon:background "none")
|
|
(load 'term-icon-xpm.gwm)
|
|
|
|
(set-icon-window XTerm
|
|
(term-icon-xpm "xterm3" pop-item.font
|
|
darkgrey
|
|
(color-make "yellow")))
|
|
|
|
(setq xterm-decos.sony
|
|
'(term-icon-xpm "xterm3" pop-item.font
|
|
(color-make "green4")
|
|
(color-make "yellow")))
|
|
(set-icon-window XTerm*maki xterm-decos.sony)
|
|
(set-icon-window XTerm*lemur xterm-decos.sony)
|
|
|
|
(setq xterm-decos.indri
|
|
'(term-icon-xpm "xterm3" pop-item.font
|
|
(color-make "HotPink4")
|
|
(color-make "yellow")))
|
|
(set-icon-window XTerm*indri xterm-decos.indri)
|
|
|
|
(setq xterm-decos.mips
|
|
'(term-icon-xpm "xterm3" pop-item.font
|
|
(color-make "blue4")
|
|
(color-make "yellow")))
|
|
(set-icon-window XTerm*opossum xterm-decos.mips)
|
|
(set-icon-window XTerm*aye xterm-decos.mips)
|
|
(set-icon-window XTerm*koala xterm-decos.mips)
|
|
(set-icon-window XTerm*wombat xterm-decos.mips)
|
|
|
|
|
|
(set-window XLoad no-frame) ; XLOAD
|
|
(set-window XPostit no-frame-no-borders)
|
|
(set-window XCal no-frame-no-borders)
|
|
(set-window XBiff no-frame-no-borders)
|
|
(set-window Sxpm no-frame-no-borders)
|
|
|
|
;(set-window XClock frame-win) ; XCLOCK
|
|
(set-window XClock no-frame) ; XCLOCK
|
|
(set-window Clock frame-win)
|
|
|
|
(set-window chaos no-frame)
|
|
|
|
(set-icon-window any simple-icon) ; Any icon
|
|
(set-window client no-frame-no-borders) ; xwud
|
|
|
|
(set-icon XCol (pixmap-load 'xcol-icon.xpm))
|
|
|
|
;(load 'waiting-xterm) ; prepared in advance xterms
|
|
|
|
(set-placement Netrek.wait rows.right-top.placement)
|
|
(set-window Netrek.wait no-frame-no-borders)
|
|
(set-window XPmview no-frame-no-borders)
|
|
(set-icon TkMan (pixmap-load "LRom1.xpm"))
|
|
(set-icon Dayview (pixmap-load "datebook.xpm"))
|
|
;;(set-icon Mosaic (pixmap-load "mosaic.xpm"))
|
|
(customize simple-icon any Mosaic
|
|
borderwidth 0
|
|
)
|
|
(set-icon Xfilemanager (pixmap-load "cdrom1.xpm"))
|
|
|
|
(defun xpm-icon-xrn (init?)
|
|
(if ( = window-icon-name "xrn-nonews")
|
|
(pixmap-load "xrn-nonews")
|
|
(= window-icon-name "xrn-busy")
|
|
(pixmap-load "xrn-busy")
|
|
(pixmap-load "xrn")
|
|
))
|
|
(defun xpm-icon-xrn2 (init?)
|
|
(if ( = window-icon-name "xrn2-nonews")
|
|
(pixmap-load "xrn2-nonews")
|
|
(= window-icon-name "xrn-busy")
|
|
(pixmap-load "xrn2-busy")
|
|
(pixmap-load "xrn2")
|
|
))
|
|
|
|
(set-icon-window any XRn.Information simple-icon)
|
|
(set-icon-window any XRn (xpm-icon xpm-icon-xrn))
|
|
(set-icon-window any XRn.xrn2 (xpm-icon xpm-icon-xrn2))
|
|
(set-icon-window any XRn.Composition ())
|
|
|
|
(setq bar-max-width 500)
|
|
|
|
;;=============================================================================
|
|
;; Netscape
|
|
;;=============================================================================
|
|
|
|
;; I want my netscape search popups under the mouse
|
|
(set-placement Netscape.findDialog_popup near-mouse)
|
|
(set-placement Netscape.openURL_popup near-mouse)
|
|
|
|
(set-icon Netscape (pixmap-load "netscape-small.xpm")) ;a nice small logo
|
|
(set-icon-window Netscape 'simple-icon)
|
|
|
|
(customize simple-icon any Netscape
|
|
legend "left"
|
|
stretch t
|
|
borderwidth 0
|
|
background screen-background
|
|
;;strip the Netscape: prefix from icon titles
|
|
label (lambdaq (s)
|
|
(if (= s "icon") "Bookmarks" (match "Netscape: \\(.*\\)$" s 1)))
|
|
;;add behaviors to netscape icons:
|
|
;; - selecting an URL and control-middle-mouse on a netscape icon will make
|
|
;; this netscape instance open the URL
|
|
;; - selecting an URL and control-left-mouse or control-alt-middle-mouse will
|
|
;; create a new netscape window on the URL
|
|
icon-grabs '(+ icon-grabs (list
|
|
(button action-button with-control)
|
|
(button action-button (together with-alt with-control))
|
|
(button select-button with-control)
|
|
))
|
|
icon-fsm (fsm-make (state-make
|
|
(state-make
|
|
(on (buttonrelease action-button with-control)
|
|
(if (match "^[hftp][hftp]*:[/][/][^ ]*$" cut-buffer)
|
|
(! "netscape-remote" "-id"
|
|
(itoa (window-to-client window-window))
|
|
"-remote" (+ "openURL(" cut-buffer ")")
|
|
)
|
|
(? "selection is not an URL: " cut-buffer "\n")
|
|
))
|
|
(on (buttonrelease action-button (together with-alt with-control))
|
|
(if (match "^[hftp][hftp]*:[/][/][^ ]*$" cut-buffer)
|
|
(! "netscape-remote" "-id"
|
|
(itoa (window-to-client window-window))
|
|
"-remote" (+ "openURL(" cut-buffer ",new-window)")
|
|
)
|
|
(? "selection is not an URL: " cut-buffer "\n")
|
|
))
|
|
(on (buttonrelease select-button with-control)
|
|
(if (match "^[hftp][hftp]*:[/][/][^ ]*$" cut-buffer)
|
|
(! "netscape-remote" "-id"
|
|
(itoa (window-to-client window-window))
|
|
"-remote" (+ "openURL(" cut-buffer ",new-window)")
|
|
)
|
|
(? "selection is not an URL: " cut-buffer "\n")
|
|
))
|
|
)
|
|
icon-behavior standard-behavior)
|
|
)
|
|
)
|
|
|
|
;;=============================================================================
|
|
;; placements
|
|
;;=============================================================================
|
|
|
|
(set-placement XTerm user-positioning) ; place manually xterms
|
|
|
|
(if (not (= USER 'colas)) ; people other than me like to have
|
|
; interactive placement for all windows
|
|
(set-placement * user-positioning)
|
|
)
|
|
|
|
(set-icon-placement any rows.right-top.placement) ; place most icons on right
|
|
|
|
; xloads, xclocks, etc goes on NE corner
|
|
|
|
(set-placement XLoad.xload rows.top-right.placement)
|
|
(set-placement XPostit.xpostit.xpostit rows.top-right.placement)
|
|
(set-placement XClock rows.top-right.placement)
|
|
(set-placement Clock rows.top-right.placement)
|
|
(set-placement XBiff rows.top-right.placement)
|
|
(set-placement XLogo rows.down-right.placement)
|
|
|
|
(set-icon-placement Gwm rows.down-right.placement) ; inactive dvrooms
|
|
(set-window Gwm no-frame)
|
|
(set-placement Gwm ; active dvrooms
|
|
(lambda (f) (if (= window-name "rmgr")
|
|
(if f
|
|
(move-window
|
|
(- screen-width 175)
|
|
60)))))))))
|
|
|
|
(set-placement XPostit.xpostit rows.top-right.placement)
|
|
|
|
(set-placement XCal rows.top-right.placement) ; XCal windows
|
|
|
|
;; specify the ordering of icons
|
|
|
|
(setq icon-order '(Xmh 10 XPostit 5 XRn 20 XClock 2 Clock 2 XBiff 1 XLoad 20
|
|
XTerm 90 Emacs 30 XDvi 250 XCal 1000
|
|
Zircon 15 Tk.zircon 15))
|
|
|
|
(rows.limits rows.right-top 'start 55 'separator 1 'sort sort-icons 'end 1000)
|
|
(rows.limits rows.down-right 'start 100 'separator 1 'offset
|
|
(- screen-height 70))
|
|
(rows.limits rows.down-left 'start 600 'separator 1 'offset 1)
|
|
(rows.limits rows.top-right 'start 55 'sort sort-icons)
|
|
|
|
|
|
;; I want my local xload on the top right corner
|
|
|
|
(set-placement XLoad.xloadlocal
|
|
(lambda (f) (if f (progn
|
|
(move-window (- screen-width window-width wob-borderwidth) 0)
|
|
(## 'update-placement window ())
|
|
)))))
|
|
|
|
;;=============================================================================
|
|
;; a better icon sorter, weigths given by customize
|
|
;;=============================================================================
|
|
|
|
(defun pack-icons (w1 w2)
|
|
(with (wob w1 weight1 100 weight2 100 n1 window-icon-name)
|
|
(setq weight1 (# 'weight (std-resource-get 'PackIcons 'pack-icons)))
|
|
(if (not weight1) (setq weight1 100))
|
|
(setq wob w2)
|
|
(setq weight2 (# 'weight (std-resource-get 'PackIcons 'pack-icons)))
|
|
(if (not weight2) (setq weight2 100))
|
|
|
|
(if (= weight1 weight2)
|
|
(compare n1 window-icon-name)
|
|
(compare weight1 weight2)
|
|
)))
|
|
|
|
(customize pack-icons any any weight 100)
|
|
|
|
(rows.limits rows.right-top 'sort pack-icons)
|
|
|
|
;; my personal weights
|
|
|
|
(customize pack-icons any Xmh weight 10)
|
|
(customize pack-icons any XPostit weight 5)
|
|
(customize pack-icons any XRn weight 20)
|
|
(customize pack-icons any XClock weight 2)
|
|
(customize pack-icons any Clock weight 2)
|
|
(customize pack-icons any XBiff weight 1)
|
|
(customize pack-icons any XLoad weight 20)
|
|
(customize pack-icons any XTerm weight 90)
|
|
(customize pack-icons any Emacs weight 30)
|
|
(customize pack-icons any XDvi weight 250)
|
|
(customize pack-icons any XCal weight 1000)
|
|
(customize pack-icons any Zircon weight 15)
|
|
(customize pack-icons any Tk.zircon weight 15)
|
|
|
|
;;=============================================================================
|
|
;; Misc Examples
|
|
;;=============================================================================
|
|
|
|
; have a list of machines for xterms and xload alphabetically sorted
|
|
|
|
(setq xload-list (: xterm-list '(
|
|
lemur aye maki indri ;koala
|
|
borneo mururoa ;solaris
|
|
ganesa rataxes columbo celeste ;alpha
|
|
cma.cma.fr legend.cma.fr
|
|
entropy ;sgi
|
|
casa ;decstations
|
|
babar arthur ;sun 4 croap
|
|
miracle zenon ;semir
|
|
))))
|
|
|
|
; I sort the list of machines alphabetically
|
|
|
|
(sort xterm-list (lambdaq (atom1 atom2) (compare atom1 atom2)))
|
|
|
|
;; Example on how to make a window start as iconic:
|
|
;; first, sets its window-starts-iconic to t,
|
|
;; then return deco
|
|
|
|
(defun no-frame-iconic ()
|
|
'(progn
|
|
(window-starts-iconic t)
|
|
(no-frame)))
|
|
;; we use this for xdvi, which has no -iconic option
|
|
(set-window XDvi no-frame-iconic)
|
|
|
|
; how to affect a decoration by some other criterions:
|
|
; example: set deco of xrn windows by size: small windows (popups) do not
|
|
; have decos, big ones (height > 200) have
|
|
|
|
(setq XRn-deco '(if (> window-height 200)
|
|
(progn
|
|
(require 'simple-win) ; we must load it if it wasn't here
|
|
(simple-win 'font small-font
|
|
'background (color-make "PaleGreen2")
|
|
'active.background (color-make "PaleGreen4")
|
|
'label.background (color-make "PaleGreen2")
|
|
))
|
|
no-frame-no-borders ; no visible frame on popups
|
|
))
|
|
(set-window XRn XRn-deco)
|
|
|
|
(setq XRn-deco.xrncma '(if (> window-height 200)
|
|
(progn
|
|
(require 'simple-win) ; we must load it if it wasn't here
|
|
(simple-win 'font small-font
|
|
'background '(color-make "GoldenRod2")
|
|
'active.background '(color-make "GoldenRod4")
|
|
'label.background '(color-make "GoldenRod2")
|
|
))
|
|
no-frame-no-borders ; no visible frame on popups
|
|
))
|
|
(set-window XRn.xrncma XRn-deco.xrncma)
|
|
|
|
;; in fact, you can give customization argiments either to the function itself
|
|
;; or like here by another call to customize...
|
|
|
|
(set-window XTerm.xterm_Lpq simple-win)
|
|
(customize simple-win any XTerm.xterm_Lpq font small-font
|
|
background '(color-make "Yellow3")
|
|
active.background '(color-make "Yellow1")
|
|
label.background '(color-make "Yellow3")
|
|
)))
|
|
|
|
|
|
;;=============================================================================
|
|
;; transient windows that I want gwm to get rid of itself after a delay
|
|
;;=============================================================================
|
|
|
|
(require 'timeout-win) ; load it if wasnt there
|
|
;;mime popups from xmh
|
|
(set-window Xmh.confirm
|
|
(timeout-win simple-win 'delay (if (= window-size '(370 70)) 0 10))
|
|
)
|
|
(set-window XRn.Information
|
|
(timeout-win simple-win 'delay 2 'command "iconify-window")
|
|
)
|
|
|
|
;;=============================================================================
|
|
;; emacs windows: small-win is a variant of simple-win
|
|
;;=============================================================================
|
|
|
|
;; first, we create the variant by calling the simple-win deco with a
|
|
;; context as argument (think of it as a closure made with the simple-win
|
|
;; deco + another environnement)
|
|
|
|
(require 'simple-win) ; ensure simple-win func is defined
|
|
(: small-win '(simple-win 'font small-font
|
|
'background (color-make "BurlyWood")
|
|
'active.background (color-make "orange4")
|
|
'label.background (color-make "BurlyWood")
|
|
))
|
|
(: lemacs-win '(with (ignore-take-focus t)
|
|
(simple-win 'font small-font
|
|
'background (color-make "BurlyWood")
|
|
'active.background (color-make "orange4")
|
|
'label.background (color-make "BurlyWood")
|
|
)))
|
|
;; then we can use it
|
|
|
|
(set-window Emacs small-win)
|
|
(set-window Emacs.emacs lemacs-win)
|
|
(set-window emacs (simple-win 'font small-font))
|
|
(set-window Emacs.epoch.minibuffer no-frame)
|
|
(set-window MinibufferScreen no-frame)
|
|
|
|
;;=============================================================================
|
|
;; xmh
|
|
;;=============================================================================
|
|
|
|
(load 'xpm-icon)
|
|
(set-icon-window any Xmh.xmh.xmh:_inbox (xpm-icon xpm-icon-by-size))
|
|
(set-icon-window any Xmh ())
|
|
|
|
(set-icon XClipboard (pixmap-load "clipboard.xpm"))
|
|
(set-icon XRn.xrn (pixmap-load "Xrn-icon"))
|
|
(set-icon XRn.xrn-6_18 (pixmap-load "Xrn-icon"))
|
|
(set-window Clock.oclock no-frame-no-borders)
|
|
|
|
;;=============================================================================
|
|
;; epoch placement
|
|
;;=============================================================================
|
|
|
|
;; this is a code to arrange my epoch window: make new epoch windows occupy
|
|
;; vacant slots in the "Epoch-windows-list"
|
|
;; Sample list is one to the left, and a cascade to the right
|
|
|
|
(if (= USER 'colas) (progn
|
|
(setq Epoch-windows-list '(
|
|
;; free (width height x-pixel-pos y-pixel-pos ordering-number)
|
|
free (80 87 0 0 0)
|
|
free (80 87 585 0 1)
|
|
free (80 85 605 22 2)
|
|
free (80 83 625 44 3)
|
|
free (80 81 645 66 4)
|
|
free (80 79 665 88 5)
|
|
free (80 77 685 110 6)
|
|
free (80 75 705 132 7)
|
|
))
|
|
|
|
(set-placement Emacs.epoch
|
|
(lambda (flag)
|
|
(if flag ; opening: seek free slot
|
|
(if (not window-starts-iconic) ; then put window-id instead of free
|
|
(place-epoch-window)
|
|
)
|
|
; closing: put 'free in slot
|
|
(with (e (member window Epoch-windows-list))
|
|
(if e
|
|
(replace-nth e Epoch-windows-list 'free)
|
|
)))))
|
|
|
|
;; search Epoch-windows-list for free slots, and move & resize window there
|
|
(defun place-epoch-window ()
|
|
(with (geometry (nth 'free Epoch-windows-list))
|
|
(if geometry
|
|
(progn
|
|
(move-window (nth 2 geometry) (nth 3 geometry))
|
|
(setq window-size (sublist 0 2 geometry))
|
|
(replace-nth (* 2 (nth 4 geometry)) Epoch-windows-list window)
|
|
))))
|
|
|
|
|
|
;;; same for lucid emacs
|
|
(setq Emacs-windows-list '(
|
|
;; free (width height x-pixel-pos y-pixel-pos ordering-number)
|
|
free (82 89 0 0 0)
|
|
free (82 89 590 0 1)
|
|
free (82 87 610 22 2)
|
|
free (82 85 630 44 3)
|
|
free (82 83 650 66 4)
|
|
free (82 81 670 88 5)
|
|
free (82 79 690 110 6)
|
|
free (82 77 710 132 7)
|
|
))
|
|
|
|
(set-placement Emacs.emacs
|
|
(lambda (flag)
|
|
(if flag ; opening: seek free slot
|
|
(if (not window-starts-iconic) ; then put window-id instead of free
|
|
(place-emacs-window)
|
|
)
|
|
; closing: put 'free in slot
|
|
(with (e (member window Emacs-windows-list))
|
|
(if e
|
|
(replace-nth e Emacs-windows-list 'free)
|
|
)))))
|
|
;; search Emacs-windows-list for free slots, and move & resize window there
|
|
(defun place-emacs-window ()
|
|
(with (geometry (nth 'free Emacs-windows-list))
|
|
(if geometry
|
|
(progn
|
|
(move-window (nth 2 geometry) (nth 3 geometry))
|
|
(setq window-size (sublist 0 2 geometry))
|
|
(replace-nth (* 2 (nth 4 geometry)) Emacs-windows-list window)
|
|
))))
|
|
|
|
|
|
))
|
|
|
|
;; Personal clients
|
|
(if (= USER 'colas) (progn
|
|
(setq xlpwatch.color (color-make "bisque"))
|
|
(set-icon Tk.xlpwatch (pixmap-make xlpwatch.color "printer.xbm" black))
|
|
(set-window Tk.xlpwatch no-frame-no-borders)
|
|
(set-icon Tk.xlpwatch_#2 (pixmap-make xlpwatch.color "printer.xbm" black))
|
|
(set-window Tk.xlpwatch_#2 no-frame-no-borders)
|
|
(set-icon Tk.xlpwatch_#3 (pixmap-make xlpwatch.color "printer.xbm" black))
|
|
(set-window Tk.xlpwatch_#3 no-frame-no-borders)
|
|
))
|
|
|
|
(set-window XQuery.NewMail no-frame-no-borders)
|
|
(set-placement XQuery.NewMail rows.left-top.placement)
|
|
|
|
;;=============================================================================
|
|
;; buttons for often done actions
|
|
;; button creation must be done at screen-opening-time
|
|
;;=============================================================================
|
|
|
|
(if (and (= USER 'colas) (not (boundp 'TEST)))
|
|
(progn
|
|
(setq screen-opening (+ screen-opening '(
|
|
|
|
;; ;; kill all my "new mail" windows
|
|
;; (place-3d-button "kill-mails"
|
|
;; black 'CadetBlue
|
|
;; '(for window (list-of-windows)
|
|
;; (if (= window-client-name 'NewMail)(kill-window))
|
|
;; ))
|
|
;;
|
|
;; ;; show/hide my vital postit, determined by its size
|
|
;; (place-3d-button "admin-post"
|
|
;; black 'khaki
|
|
;; '(for window (list-of-windows)
|
|
;; (if (and (= window-name 'PostItNote)
|
|
;; (= window-width 515)(= window-height 191)
|
|
;; )
|
|
;; (if window-is-mapped (iconify-window)
|
|
;; (progn (map-window)(raise-window))
|
|
;; ))))
|
|
;;
|
|
;; ;; toggle on/off all big postits
|
|
;; (place-3d-button "Post Big"
|
|
;; black 'thistle
|
|
;; '(for window (list-of-windows)
|
|
;; (if (= window-name 'PostItNoteBig)
|
|
;; (if window-is-mapped (iconify-window)
|
|
;; (progn (map-window)(raise-window))
|
|
;; ))))
|
|
;;
|
|
;; ;; toggle on/off all normal postits
|
|
;; (place-3d-button "Post Norm"
|
|
;; black 'khaki
|
|
;; '(for window (list-of-windows)
|
|
;; (if (= window-name 'PostItNote)
|
|
;; (if window-is-mapped (iconify-window)
|
|
;; (progn (map-window)(raise-window))
|
|
;; ))))
|
|
;;
|
|
;; ;; toggle on/off all small postits
|
|
;; (place-3d-button "Post Small"
|
|
;; black 'SpringGreen
|
|
;; '(for window (list-of-windows)
|
|
;; (if (= window-name 'PostItNoteSmall)
|
|
;; (if window-is-mapped (iconify-window)
|
|
;; (progn (map-window)(raise-window))
|
|
;; )))
|
|
;; )
|
|
;;
|
|
|
|
;; raise/lower/iconify (depending of button) all xterms
|
|
(place-3d-button "XTerms"
|
|
black 'LightBlue
|
|
'(if (= 0 (current-event-modifier))
|
|
(for window (list-of-windows 'window)
|
|
(if (and (= window-client-class 'XTerm) window-is-mapped)
|
|
(if (= 1 (current-event-code))
|
|
(raise-window)
|
|
(= 2 (current-event-code))
|
|
(lower-window)
|
|
(= 3 (current-event-code))
|
|
(iconify-window)
|
|
)))
|
|
(for window (list-of-windows 'icon)
|
|
(if (and (= window-client-class 'XTerm) window-is-mapped)
|
|
(if (= 1 (current-event-code))
|
|
() ;; to be completed
|
|
(= 2 (current-event-code))
|
|
() ;; to be completed
|
|
(= 3 (current-event-code))
|
|
(iconify-window)
|
|
)))))
|
|
|
|
;; forks an lpwatch
|
|
(place-3d-button "lpq"
|
|
black 'bisque
|
|
'(! "/net/koala/bin/sun4/lpwatch" "-geometry" "+750+900")
|
|
)
|
|
|
|
;; resets the selection state of the server
|
|
(place-3d-button "blank" black 'pink
|
|
'(! "xscreensaver-command" "-activate")
|
|
)
|
|
)))
|
|
|
|
(set-placement Gwm.button rows.right-down.placement)
|
|
(set-window Gwm.button no-frame-no-borders)
|
|
))
|
|
|
|
;;=============================================================================
|
|
;; some little modifications after modules have been loaded
|
|
;;=============================================================================
|
|
;; a bit of a hack. just to show it can be done.
|
|
|
|
;; change font of first item of window menu
|
|
(## 0 window-pop-items
|
|
(list 'with '(pop-item.font (font-make "*-helvetica-bold-r-normal--14-*"))
|
|
(# 0 window-pop-items)
|
|
))
|
|
|
|
(setq old-get-x-resource resource-get)
|
|
;(defun resource-get (class name)
|
|
;; (? "GET [" class "] [" name "]\n")
|
|
; (old-get-x-resource class name)
|
|
;)
|
|
(setq reenter-on-opening ())
|
|
|
|
;; idraw: place pop-up on left top
|
|
|
|
(set-placement Dialog.idraw26
|
|
(lambda (f) (if f (progn (move-window 0 0) (resize-window 210 800)
|
|
))))
|
|
|
|
;;=============================================================================
|
|
;; framemaker windows
|
|
;;=============================================================================
|
|
(load 'framemaker)
|
|
|
|
(setq frame-icon-color.1 '(color-make "LightYellow2"))
|
|
(setq frame-icon-font.1 pop-item.font)
|
|
(setq frame-icon-color.2 '(color-make "LightYellow3"))
|
|
(setq frame-icon-font.2 small-font)
|
|
(setq frame-inactive-color frame-icon-color.1)
|
|
(setq frame-active-color '(color-make "LightYellow4"))
|
|
|
|
(set-icon Maker.makerkit (pixmap-load "App_write.xpm"))
|
|
(set-icon-window Maker
|
|
(if (= "makerkit" window-client-name) ; top window(menu): use frame pixmap
|
|
(simple-icon 'background frame-icon-color.2)
|
|
|
|
(match ".*kit" window-client-name)
|
|
(progn ; main edit windows: icon name
|
|
(simple-icon 'background frame-icon-color.1
|
|
'simple-icon.plug-name (+ "[ " window-icon-name " ]")
|
|
'simple-icon.no-center-plug t
|
|
'font frame-icon-font.1
|
|
)
|
|
)
|
|
|
|
; all popups, use a smaller name
|
|
(with (name (match "FrameMaker - \\(.*\\)$" window-name 1))
|
|
(if (= name "")
|
|
(setq name window-name)
|
|
)
|
|
(if
|
|
(= name "Character Format") (setq name "Format Chr")
|
|
(= name "Paragraph Format") (setq name "Format Par")
|
|
(= name "\xB6 Catalog") (progn
|
|
(setq window-name "Par Catalog")
|
|
(setq name "Catalog Par")
|
|
)
|
|
(= name "C Catalog") (setq name "Catalog Chr")
|
|
(= name "Spelling Checker") (setq name "Spell")
|
|
)
|
|
(simple-icon 'background frame-icon-color.2
|
|
'font frame-icon-font.2
|
|
'simple-icon.plug-name name)
|
|
)))
|
|
|
|
(setq icon-order (+ icon-order '(Maker 210)))
|
|
|
|
;; experimental epoch menus
|
|
|
|
(setq epoch-color "bisque")
|
|
|
|
(for i '("1" "2" "3" "4")
|
|
(set (atom (+ "epoch-color" i))
|
|
(color-make (+ epoch-color i))
|
|
))
|
|
|
|
(: widget.Bfont (font-make "*clean-medium*--10*c-60*"))
|
|
(: widget.font (font-make "*clean-bold*--10*c-60*"))
|
|
(setq widget.foreground epoch-color4)
|
|
(setq widget.background epoch-color1)
|
|
(setq widget.name-font (font-make "fixed"))
|
|
(setq widget.name-foreground black)
|
|
|
|
(: widget.weave (pixmap-make
|
|
epoch-color4
|
|
"/usr/include/X11/bitmaps/cross_weave"
|
|
epoch-color1
|
|
))
|
|
(: widget.black (pixmap-make
|
|
black
|
|
"/usr/include/X11/bitmaps/black"
|
|
epoch-color4
|
|
))
|
|
(: widget.gray (pixmap-make
|
|
black
|
|
"/usr/include/X11/bitmaps/black"
|
|
epoch-color4
|
|
))
|
|
(: widget.lt-gray (pixmap-make
|
|
black
|
|
"/usr/include/X11/bitmaps/black"
|
|
epoch-color2
|
|
))
|
|
|
|
(load "em-widgets.gwm")
|
|
(load "em-drop-menus.gwm")
|
|
(set-window Emacs.epoch style:select)
|
|
|
|
(Dmenu: Dmenu.fonts
|
|
'("fonts" (
|
|
("screen-11" "(progn (font \"screen.r.11\") (redraw-display))")
|
|
("screen-12" "(progn (font \"screen.r.12\") (redraw-display))")
|
|
("screen-12-Bold" "(progn (font \"screen.b.12\") (redraw-display))")
|
|
("screen-13" "(progn (font \"screen.r.13\") (redraw-display))")
|
|
("screen-14" "(progn (font \"screen.r.14\") (redraw-display))")
|
|
("screen-14-Bold" "(progn (font \"screen.b.14\") (redraw-display))")
|
|
("screen-7" "(progn (font \"screen.r.7\") (redraw-display))")
|
|
("fixed" "(progn (font \"fixed\") (redraw-display))")
|
|
)))
|
|
|
|
(Dmenu: Dmenu.buffers
|
|
'("buffers" (
|
|
("list of buffers"
|
|
"(progn \
|
|
(list-buffers) \
|
|
(switch-to-buffer \"*Buffer List*\") \
|
|
(delete-other-windows) \
|
|
(if (not (boundp 'mouse-Buffer-menu-select)) (progn \
|
|
(setq mouse-Buffer-menu-select t)\
|
|
(defun mouse-Buffer-menu-select (&optional mdata) (interactive) \
|
|
(Buffer-menu-select) \
|
|
))) \
|
|
(if (boundp 'imouse-version)\
|
|
(local-set-mouse mouse-middle mouse-down 'mouse-set-point-or-select) \
|
|
(local-set-mouse mouse-middle mouse-down 'mouse::set-point)) \
|
|
(local-set-mouse mouse-middle mouse-up 'mouse-Buffer-menu-select) \
|
|
)")
|
|
("other buffer" "(switch-to-buffer (other-buffer))")
|
|
("*scratch* buffer" "(switch-to-buffer \"*scratch*\")")
|
|
("-" (bell))
|
|
("kill buffer" "(kill-buffer (current-buffer))")
|
|
)))
|
|
|
|
(Dmenu: Dmenu.files
|
|
'("files" (
|
|
("list of directory"
|
|
"(progn \
|
|
(dired \".\") \
|
|
(delete-other-windows) \
|
|
(if (not (boundp 'mouse-dired-find-file)) (progn \
|
|
(setq mouse-dired-find-file t)\
|
|
(defun mouse-dired-find-file (&optional mdata) (interactive) \
|
|
(dired-find-file) \
|
|
))) \
|
|
(if (boundp 'imouse-version)\
|
|
(local-set-mouse mouse-middle mouse-down 'mouse-set-point-or-select) \
|
|
(local-set-mouse mouse-middle mouse-down 'mouse::set-point)) \
|
|
(local-set-mouse mouse-middle mouse-up 'mouse-dired-find-file) \
|
|
)")
|
|
(" - - - " "")
|
|
(".Xdefaults" "(find-file \"~/.Xdefaults\")")
|
|
("profile-epoch" "(find-file \"~/el/profile-epoch-4.0.el\")")
|
|
("wool TODO" "(find-file \"~/Wool2/src/TODO\")")
|
|
("wool Log" "(find-file \"~/Wool2/src/Log\")")
|
|
("gwm-talk" "(find-file \"~/mailist/gwm-talk\")")
|
|
("gwm-welcome" "(find-file \"~/mailist/newusers-gwm\")")
|
|
|
|
)))
|
|
|
|
(Dmenu: Dmenu.db
|
|
'("db"
|
|
(
|
|
(" " "")
|
|
("byte-compile-current-file" "(byte-compile-current-file)")
|
|
("toggle debug" "(setq debug-on-error (not debug-on-error))")
|
|
("debug on" "(setq debug-on-error t)")
|
|
("debug off" "(setq debug-on-error f)")
|
|
)))
|
|
|
|
(: Dmenu.epoch-menus
|
|
(list
|
|
Dmenu.fonts
|
|
Dmenu.files
|
|
Dmenu.buffers
|
|
Dmenu.db
|
|
))
|