;;; "juhp.scwmrc" -*-scwm-*- (display "reading \".scwmrc\"...\n") (display (scwm-version-date)) (newline) ;; Uncomment the below to send a single UDP packet to ;; the scwm usage counter machine at startup ;; The single packet just contains the hostname and version number ;; To disable, set environment variable SCWM_DO_NOT_LOG_USAGE ;;(define thank-scwm-authors-with-usage-note #t) ;;-------------------------------;; ;; import the scwm modules ;; (use-scwm-modules base decor doc face flux fvwm-module optargs style defoption wininfo winlist winlist-menu winops) ;; menu compatibility (define (display-menu . rest) (let ((form (if (list? (car rest)) (car rest) rest))) (popup-menu (menu form)))) (define (create-menu . rest) (let ((form (if (list? (car rest)) (car rest) rest))) (menu form))) ;;-------------------------------;; ;; set some basic styles info ;; (define font12 (make-font "-adobe-helvetica-bold-r-*-*-12-*-*-*-*-*-*-*")) (define font14 (make-font "-adobe-helvetica-bold-r-*-*-14-*-*-*-*-*-*-*")) (menu-style #:fg "black" #:bg "grey" #:stipple "grey30" #:font font14 ; #:mwm #f ) ;; (define menu-bg-color (make-color "grey")) ;; (define menu-text-color (make-color "black")) (set-icon-font! font12) (scwm-option-set! *opaque-move-percent* 100) (scwm-option-set! *opaque-resize-percent* 100) (define user-image-path (list (string-append (user-home) "/pixmaps") (string-append (user-home) "/bitmaps") (string-append (user-home) "/icons") (string-append (user-home) "/mini-icons"))) ;;-------------------------------;; ;; set some paths ;; ;; ;; these are OK for my system, but may need to be changed for ;; yours. This should probably be eventually autoconfed or something. (set! image-load-path (append user-image-path '("/usr/X11/include/X11/bitmaps" "/usr/local/X11/include/X11/pixmaps" "/usr/local/lib/icons" "/uns/include/X11/pixmaps" "/usr/lib/icons" "/usr/X11/include/X11/pixmaps" "/usr/X11/lib/X11/mini-icons") image-load-path)) (set! image-load-path (append '("/usr/local/X11R6.1/include/X11/pixmaps" "/usr/local/X11R6.1/include/X11/bitmaps") image-load-path)) ;;; decor (define initial-decor (default-decor)) (with-decor initial-decor (set-highlight-foreground! "white") (set-highlight-background! "blue4")) (define pix-decor (make-decor)) (with-decor pix-decor (border-style #:hidden-handles #f #:no-inset #t #:pixmap (make-image "br_wood_1.xpm") #:inactive (list #:hidden-handles #f #:no-inset #t #:pixmap (make-image "br_wood_0.xpm"))) (title-style #:justify 'center #:font font12 #:relief 'flat) (set-highlight-foreground! "white") (set-highlight-background! "black")) ;;-------------------------------;; ;; set some window styles ;; (window-style "*" #:fg "grey" #:bg "black" #:icon-box (list (x- 5) (%y 30) (x- 90) (y- 5)) #:border-width 6 #:focus 'click #:mwm-func-hint #t #:mwm-decor-hint #t #:hint-override #t #:decorate-transient #t #:PPosition-hint #f #:OL-decor-hint #t #:lenience #t #:use-decor pix-decor ) (define desk-widget (make-style #:use-decor initial-decor #:fg "light grey" #:bg "dark slate grey" ;; is this a portable name for this color? #:sticky #t #:winlist-skip #t #:border-width 3 #:circulate-skip #t #:no-titlebar #t )) (window-style "*lock" #:use-style desk-widget) (window-style "xload" #:use-style desk-widget) (window-style "xscreensaver" #:use-style desk-widget) (window-style "xbiff" #:use-style desk-widget) ;; (window-style "xcalc" #:icon "xcalc.xpm") ;; (window-style "xman" #:icon "xman.xpm") ;; (window-style "xmag" #:icon "mag_glass.xpm") ;; (window-style "Emacs" #:icon "gnu-animal.bmp") (window-style "XTerm" #:icon "xterm.xpm") (window-style "XBuffy" #:use-style desk-widget #:focus 'none) (window-style "*clock" #:use-style desk-widget) (window-style "swisswatch" #:use-style desk-widget) (window-style "perfmeter" #:use-style desk-widget) (window-style "xconsole" #:use-style desk-widget) (window-style "NoClass" #:use-style desk-widget) (window-style "balloon-help" #:use-style desk-widget) (window-style "* Properties" #:no-titlebar #f) (window-style "asmail" #:use-style desk-widget) (window-style "FvwmPager" #:use-style desk-widget) (set-edge-scroll! 0 0) ;;-------------------------------;; ;; define some useful menus ;; (define (root-menu) (display-menu (menu-title "Root") menu-separator ;; (menuitem "Print" #:action print-window) (menuitem "&Window actions" #:action (lambda () (display-menu (menuitem "More" #f) menu-separator (menuitem "&Move" #:image-left "mini-move.xpm" #:action interactive-move) (menuitem "Re&size" #:image-left "mini-resize.xpm" #:action interactive-resize) (menuitem "&Raise" #:image-left "mini-raise.xpm" #:action raise-window) (menuitem "&Lower" #:image-left "mini-lower.xpm" #:action lower-window) (menuitem "&Info" #:action window-info-menu) (menuitem "(Un)Window-Shade" #:action toggle-window-shade) (menuitem "(De)Iconify" #:image-left "mini-iconify.xpm" #:action toggle-iconify) (menuitem "(Un)&Maximize" #:image-left "mini-maxtall.xpm" #:action toggle-maximize-vertical) (menuitem "(Un)Stick" #:image-left "mini-stick.xpm" #:action toggle-stick) (menuitem "(Un)Keep On Top" #:action toggle-on-top) menu-separator (menuitem "Delete" #:image-left "mini-cross.xpm" #:action delete-window) (menuitem "Close" #:image-left "mini-bomb.xpm" #:action close-window) (menuitem "Destroy" #:image-left "mini-bomb.xpm" #:action destroy-window)))) menu-separator (menuitem "&Switch to..." #:action (lambda () (show-window-list-menu #f #f #:show-geometry #t))) (menuitem "Re&fresh Screen" #:action refresh) menu-separator (menuitem "&Restart scwm" #:action (lambda () (restart "scwm"))) (menuitem "&Exit scwm" #:action quit-verify-menu))) (define* (window-menu #&optional (w (get-window))) (display-menu (menu-title "Window") menu-separator (menuitem "&Move" #:image-left "mini-move.xpm" #:action interactive-move) (menuitem "Re&size" #:image-left "mini-resize.xpm" #:action interactive-resize) (menuitem "&Raise" #:image-left "mini-raise.xpm" #:action raise-window) (menuitem "&Lower" #:image-left "mini-lower.xpm" #:action lower-window) (menuitem "&Info" #:action window-info-menu) menu-separator (menuitem (if (iconified-window? w) "Deiconify" "Iconify") #:action toggle-iconify) (menuitem (if (maximized? w) "Un&maximize" "&Maximize") #:image-left "mini-maxtall.xpm" #:action toggle-maximize-vertical) (menuitem (if (sticky-window? w) "Unstick" "Stick") #:image-left "mini-stick.xpm" #:action toggle-stick) (menuitem (if (shaded-window? w) "UnWindow-Shade" "Window-Shade") #:action toggle-window-shade) (menuitem (if (kept-on-top? w) "UnKeep On Top" "Keep On Top") #:action toggle-on-top) menu-separator (menuitem "Delete" #:image-left "mini-cross.xpm" #:action delete-window) (menuitem "Close" #:image-left "mini-bomb.xpm" #:action close-window) (menuitem "Destroy" #:image-left "mini-bomb.xpm" #:action destroy-window))) (define* (window-list-proc #&optional (w (get-window))) (focus-change-warp-pointer w)) (define (quit-verify-menu) (display-menu (apply list (menu-title "Quit: sure?") menu-separator (append (map (lambda (x) (menuitem (string-append (window-resource x) ": " (window-title x)) #:action (lambda () (window-list-proc x)))) (list-windows #:except winlist-skip?)) (list menu-separator (menuitem "Yes, quit" #:action quit) (menuitem "No" #:action noop)))))) ;;; screen movement (define screen-focus-array (let ((size (desk-size))) (make-array #f (car size) (cadr size)))) (define (current-screen) (map / (viewport-position) (display-size))) (define (save-focus window screen) (array-set! screen-focus-array (if (and window (visible? window) (not (sticky-window? window))) window #f) (car screen) (cadr screen))) (define (move-screen x y) (let ((rel-screen-move (map * (display-size) (list x y))) (old-screen (current-screen)) (old-window (current-window-with-focus))) (move-viewport (car rel-screen-move) (cadr rel-screen-move)) (let ((screen (current-screen))) (if (equal? old-screen screen) (beep) (begin (if old-window (unfocus)) (let ((window (or (array-ref screen-focus-array (car screen) (cadr screen)) (current-window-with-pointer)))) (if (and window (not (equal? window old-window)) (visible? window)) (begin (focus-window window) (save-focus old-window old-screen)) (next-window #:only visible? #:except iconified-window?)))))))) (define (windows-off-screen-menu) (display-menu (apply list (menu-title "On other screens:") menu-separator (map (lambda (x) (menuitem (window-title x) #:action (lambda () (window-list-proc x)))) (list-windows #:except visible?))))) (define (window-geometry w) (let ((size (window-size w)) (pos (window-position w))) (string-append (number->string (car size)) "x" (number->string (cadr size)) "+" (number->string (car pos)) "+" (number->string (cadr pos))))) (define (window-info-menu) (let ((focus-win (current-window-with-focus))) (if focus-win (display-menu (menuitem (string-append "Title: " (window-title focus-win)) #f) (menuitem (string-append "Class: " (window-class focus-win)) #f) (menuitem (string-append "Resource: " (window-resource focus-win)) #f) (menuitem (string-append "Geometry: " (window-geometry focus-win)) #f)) (display-menu (menuitem "No window has focus." #f))))) (bind-key 'all "A-Left" (lambda () (move-screen -1 0))) (bind-key 'all "A-Right" (lambda () (move-screen 1 0))) (bind-key 'all "A-Up" (lambda () (move-screen 0 -1))) (bind-key 'all "A-Down" (lambda () (move-screen 0 1))) (define* (do-move-window x y #&optional (w (current-window-with-focus))) (let* ((amount 25) (position (window-viewport-position w)) (oldx (car position)) (oldy (cadr position))) (move-to (+ oldx (* x amount)) (+ oldy (* y amount)) w 'animated))) (bind-key 'all "S-A-Left" (lambda () (do-move-window -1 0))) (bind-key 'all "S-A-Right" (lambda () (do-move-window 1 0))) (bind-key 'all "S-A-Up" (lambda () (do-move-window 0 -1))) (bind-key 'all "S-A-Down" (lambda () (do-move-window 0 1))) (define (move-window-screen x y) (let* ((old-screen (current-screen)) (new-screen (map + old-screen (list x y))) (new-screen-x (car new-screen)) (new-screen-y (cadr new-screen)) (size (desk-size)) (size-x (car size)) (size-y (cadr size))) (if (or (< new-screen-x 0) (> new-screen-x (- size-x 1)) (< new-screen-y 0) (> new-screen-y (- size-y 1))) (beep) (begin (move-window-to-viewport new-screen-x new-screen-y) (move-screen x y))))) (bind-key 'all "C-A-Left" (lambda () (move-window-screen -1 0))) (bind-key 'all "C-A-Right" (lambda () (move-window-screen 1 0))) (bind-key 'all "C-A-Up" (lambda () (move-window-screen 0 -1))) (bind-key 'all "C-A-Down" (lambda () (move-window-screen 0 1))) ;;; wm related bindings ;; (bind-key 'all "A-\`" popup-ops) ;; Bad binding specifier (bind-key 'all "A-i" window-info-menu) (bind-key 'all "A-l" refresh) (bind-key 'all "A-r" toggle-raise) (bind-key 'all "A-S-r" (lambda () (restart "scwm"))) (bind-key 'all "A-q" quit-verify-menu) ;; (bind-key 'all "C-A-S-q" quit) (bind-key 'window "A-s" toggle-window-shade) (bind-key 'all "A-w" windows-off-screen-menu) (bind-key '(window icon) "A-z" toggle-iconify) (bind-key 'all "A-F1" root-menu) (bind-key '(window icon) "A-F2" window-menu) (bind-mouse 'root 1 root-menu) (bind-mouse 'root 2 (lambda () (show-window-list-menu #f #f))) (define (move-or-shade) (case (mouse-event-type) ((double-click) (toggle-window-shade)) (else (move-or-raise)))) (bind-mouse '(title frame-corners frame-sides) 1 move-or-shade) (bind-mouse '(title frame-corners frame-sides) 2 resize-or-raise) (bind-mouse '(title frame-corners frame-sides) 3 window-menu) ;; some stuff for icons (define (move-or-deiconify) (case (mouse-event-type) ((click) (deiconify-window)) ((motion) (interactive-move)))) (bind-mouse 'icon 1 move-or-deiconify) (bind-mouse 'icon 2 deiconify-window) (bind-mouse 'icon 3 window-menu) ;; app bindings (bind-key 'all "A-e" (lambda () (execute "emacs --debug-init -fn fontset-standard"))) (bind-key 'all "A-S-e" (lambda () (execute "emacs -q --no-site-file -fn fontset-standard"))) (bind-key 'all "A-S-l" (lambda () (execute "xlock"))) (bind-key 'all "A-m" (lambda () (execute "mule -q --no-site-file"))) (bind-key 'all "A-n" (lambda () (execute "netscape"))) (bind-key 'all "A-c" (lambda () (execute "communicator"))) (bind-key 'all "A-t" (lambda () (execute "xterm"))) (bind-key 'all "A-x" (lambda () (execute "xemacs -debug-init"))) (bind-key 'all "A-S-x" (lambda () (execute "xemacs --vanilla"))) ;(define (print-info thunk windows) ; (if (not (null? windows)) ; (begin ; (write (car windows)) ; (display #\tab) ; (display (thunk (car windows))) ; (display #\newline) ; (print-info thunk (cdr windows))))) ;; rotate the current window with the keyboard (bind-key 'all "A-Tab" (lambda () (next-window #:only visible? #:except iconified-window?))) (bind-key 'all "A-S-Tab" (lambda () (prev-window #:only visible? #:except iconified-window?))) ;;-------------------------------;; ;; fvwm modules ;; ; (set! *fvwm2-module-path* (append '("/usr/local/X11R6.1/lib/X11/fvwm2") ; *fvwm2-module-path*)) (register-fvwm2-module-config "FvwmPager" "*FvwmPagerBack grey70" "*FvwmPagerFore black" "*FvwmPagerHilight lightyellow" "*FvwmPagerFont none" "*FvwmPagerDeskTopScale 35" "*FvwmPagerGeometry -5+145" "*FvwmPagerSmallFont 5x8") (run-fvwm2-module "FvwmPager" '("0" "0")) (display "reading \".scwmrc\"...done\n") ;;; end of ".scwmrc"