Generic_Window_Manager/data/dvrooms.gwm

681 lines
18 KiB
Plaintext

; group windows into dvrooms
;
;;File: dvrooms.gwm
;;Author: duanev@mcc.com (Duane Voth)
;;Revision: 1.5 -- Nov 18 1990
;
; History: 1.0 -- Oct 18 1989 original
; 1.1 -- Oct 26 1989 windows are placed back on the screen (in
; iconic form) when a dvroom manager dies
; 1.2 -- Nov 21 1989 use gwm-quiet
; 1.3 -- Nov 22 1989 create rmgrs from wool (colas)
; 1.4 -- May 11 1990 use GWM_ROOM property to remeber room windows
; 1.5 -- Nov 18 1990 Philippe Kaplan (phk)
; act as icon boxes:
; do (setq dvroom.icon-box t) before load
; exit bug fixed around line 190
;
; dvrooms.gwm must be loaded in the .profile.gwm before any set-window,
; set-icon-window, set-placement, or set-icon-placement calls. it should
; also follow loading of icon-groups.gwm if used. (this probably isn't
; necessary but it seems to be programatically correct)
;
; to use rooms, the following can be added to your .profile.gwm:
;
; (defun screen-startup ()
; (setq count-of-windows-on-screen (length (list-of-windows)))
; (new-dvroom-manager "home")
; (new-dvroom-manager "lisp")
; (new-dvroom-manager "wysiwyg")
; (dvroom-reattach)
; (if (= 0 count-of-windows-on-screen)
; (! "/bin/sh" "-c" "$HOME/.xrc")))
;
; (setq to-be-done-after-setup (+ to-be-done-after-setup '((screen-startup))))
;
; be sure also to attach add-to-dvroom and remove-from-dvroom to some unused
; mouse button / keyboard modifier combinations. Example:
;
; (: standard-behavior
; (state-make
; ....
; (on (buttonpress 1 with-control) (add-to-room))
; (on (buttonpress 3 with-control) (remove-from-room))
; ))
;
;;=============================================================================
;; 1.5
;;=============================================================================
; New version of "dvrooms.gwm". Small changes produce big results:
;
; - You may open any number of rooms, instead of only one.
; - you can attach a window to several rooms.
;
; Be carefull:
;
; - The notion of current-dvroom becomes "the last room openned" (add-to-room
; and remove-from-room use current-dvroom).
;
; Since it changes the concept of rooms, we'd better speak about "icon boxes".
; Note that you can again remove and add any window to/from any room, so
; this is clever than icon-group.gwm.
;
; To enable this feature, put:
; (setq dvroom.icon-box t)
; before
; (load "dvrooms")
;
; Put in your .profile.gwm some lines like:
;
; (defun epoch-decos ()
; '(if (member "Minibuffer" window-name)
; (no-frame)
; (progn
; (if (and (boundp 'dvroom-managers) (find-dvroom-by-name "epoch"))
; (add-to-dvroom-group (find-dvroom-by-name "epoch") (wob))
; (set-x-property "GWM_ROOM" "epoch"))
; (simple-win))))
;
; (set-window Emacs epoch-decos)
;
; (set-icon-placement Gwm rows.top-left.placement) ; set rooms placements
; (set-placement Gwm rows.top-left.placement)
;
; So every new epoch screen belongs to "epoch"'s room.
;;=============================================================================
;; code
;;=============================================================================
; global dvroom variables
(declare-screen-dependent
dvroom.font
dvroom.background
dvroom.foreground
)
(setq dvroom-managers ()) ; list of windows for dvroom managers
(setq current-dvroom ()) ; index into dvroom-managers of the current dvroom
; user-settable resources
(for screen (list-of-screens)
(defaults-to
dvroom.font (font-make "8x13")
dvroom.background white
dvroom.foreground black
))
(defaults-to
dvroom.borderwidth borderwidth
dvroom.auto-add () ; new windows added to current room?
dvroom.icon-box () ; act as icon boxes
dvroom.x 0
dvroom.y 0
dvroom.name "Room #"
dvroom.rootmenupos 5 ; where to place root menu items
dvroom.menupos 2 ; where to place menu menu items
edit-keys.return "Return"
edit-keys.backspace "BackSpace"
edit-keys.delete "Delete"
)
(defaults-to dvroom.name.number 0)
; save current iconify-window function
(if (not (boundp 'pre-dvrooms-iconify-window))
(setq pre-dvrooms-iconify-window iconify-window))
; add w to the list of windows managed by a dvroom-manager
(defun add-to-dvroom-group (dvroom-manager w)
(if (not (member w (nth 'rgroup dvroom-manager)))
(progn
(with (wob w) (setq window-wm-state-icon
(with (wob dvroom-manager) window-icon)))
(replace-nth 'rgroup dvroom-manager (+ (nth 'rgroup dvroom-manager) (list w))))))
; remove w from the list of windows managed by a dvroom-manager
;; be careful, the window might not exist anymore, if we get called on closing
;; of an application!
(defun remove-from-dvroom-group (dvroom-manager w)
(if (window-is-valid w)
(with (wob w) (setq window-wm-state-icon 0))
)
(with (slot (member w (nth 'rgroup dvroom-manager)))
(if slot (delete-nth slot (nth 'rgroup dvroom-manager)))))
; a version of print that honors gwm-quiet
(defun qprint args
(if (= gwm-quiet 0) (eval (+ '(print) args))))
; open all windows in a dvroom
; assumes "window" is the dvroom manager being opened
(defun open-dvroom ()
(for window (nth 'rgroup window-window)
; map the window if it was mapped, else map the icon
(if (nth 'rgroup-state window)
(map-window window)
(map-window window-icon))))
; close all windows in a dvroom
; assumes "window" is the dvroom manager being closed
(defun close-dvroom ()
(for window (nth 'rgroup window)
; save window state - is it a window or an icon
(replace-nth 'rgroup-state window window-is-mapped)
; remove both windows and icons from the screen
(if window-is-mapped (unmap-window window))
(if (window-icon?)
(with (window window-icon)
(if window-is-mapped (unmap-window window))))))
; redefine iconify-window so we can do dvroom specific stuff
(defun iconify-window ()
(if (= window-name "rmgr")
; (de)iconifing a dvroom manager
(if (= window-status 'window)
; iconifing (closing) a dvroom manager
(progn
(close-dvroom)
(if (not dvroom.icon-box)
(setq current-dvroom ()))
(pre-dvrooms-iconify-window)
)
; deiconifing (opening) a dvroom manager
(with (rmgr-index (member window-window dvroom-managers))
; close previous dvroom manager
(if (and current-dvroom (not dvroom.icon-box))
(with (window (nth current-dvroom dvroom-managers))
(if (= window-status 'window)
(iconify-window) ; recurse to close dvroom
)
)
)
(if rmgr-index
; existing dvroom manager
(open-dvroom)
; register a new dvroom manager
(progn
; save window-window as the manager may be iconic and
; we need a consistent value in the dvroom-mgr list
(setq dvroom-managers
(+ dvroom-managers (list window-window)))
(setq rmgr-index (member window-window dvroom-managers))
)
)
(setq current-dvroom rmgr-index)
(pre-dvrooms-iconify-window)
)
)
; (de)iconifing other windows
(progn
(pre-dvrooms-iconify-window)
)
)
)
(defun dvroom-icon-name (dvroom)
(with (window dvroom) window-icon-name))
(defun find-dvroom-by-name (name)
(tag room-found
(for dvroom dvroom-managers
(if (= name (dvroom-icon-name dvroom))
(exit room-found dvroom)))))
;; register a new dvroom manager -or- readd a window to a room
;; (should be called when new windows become known to gwm (ie. via
;; gwm global opening))
;; assumes "window" is the new dvroom manager or window
(defun add-dvroom-manager ()
(if (= window-name "rmgr")
(if (not (member window-window dvroom-managers))
(progn (qprint "new dvroom manager " window-icon-name "\n")
;; save window-window as the manager may be iconic and
;; we need a consistent value in the dvroom-mgr list
(setq dvroom-managers (+ dvroom-managers (list window-window)))))
;; else it's not a manager. see if this window previously belonged to
;; a room and add a new manager if the named manager does not exist
(with (room-name (get-x-property "GWM_ROOM"))
(if (< 0 (length room-name))
(if (not (find-dvroom-by-name room-name))
(new-dvroom-manager room-name))))
()
;; if dvroom.auto-add is true, then add to current dvroom if one exists
(if (and dvroom.auto-add (= (type current-dvroom) 'number))
(add-to-dvroom))
)
)
; add add-dvroom-manager to progn of funcs to eval when opening a new window
; assumes dvroom.gwm is before the set-* calls in .profile.gwm
(setq opening (+ opening '((add-dvroom-manager))))
; reattach windows that have a GWM_ROOM property to the room managers
(defun dvroom-reattach window-list
(for window (if window-list window-list (list-of-windows))
(with (room-name (get-x-property "GWM_ROOM"))
(if (< 0 (length room-name))
(for dvroom dvroom-managers
(if (= room-name (dvroom-icon-name dvroom))
(progn
(add-to-dvroom-group dvroom window)
(if (not (= dvroom current-dvroom))
(progn
; remove both window and icon from the screen
(if window-is-mapped (unmap-window window))
(if (window-icon?)
(with (window window-icon)
(if window-is-mapped (unmap-window window))))))
(qprint "adding <" window-name "> to dvroom "
(dvroom-icon-name dvroom) "\n"))))))))
; add a window to a dvroom
; assumes "window" is the application window to add
(defun add-to-dvroom ()
(with (window window-window)
(if (and (= (type current-dvroom) 'number)
(not (= window-name "rmgr")))
(with (dvroom-manager (nth current-dvroom dvroom-managers))
(if (not (member window (nth 'rgroup dvroom-manager)))
(progn (add-to-dvroom-group dvroom-manager window)
(set-x-property "GWM_ROOM"
(with (wob dvroom-manager) window-icon-name))
; give the user *some* kind of feed back
(qprint "adding <" window-name "> to dvroom "
(dvroom-icon-name dvroom-manager) "\n")))))))
; remove a window from a dvroom
; assumes "window" is the application window to remove
(defun remove-from-dvroom ()
(with (window window-window)
(if (= (type current-dvroom) 'number)
(with (dvroom-manager (nth current-dvroom dvroom-managers))
(if (member window (nth 'rgroup dvroom-manager))
(progn
(set-x-property "GWM_ROOM" "")
; give the user *some* kind of feed back
(qprint "removing <" window-name "> from dvroom "
(dvroom-icon-name dvroom-manager) "\n"))
(qprint "not a dvroom member\n"))
(remove-from-dvroom-group dvroom-manager window)))))
; if a normal window, remove it from any dvroom manager, but if a dvroom
; manager and not current, make all of the dvrooms windows visible.
; (this function needs to be called when an application exits (ie. via gwm
; global closing) so that gwm won't try to operate on non-existant windows)
; assumes "window" is the application window that is exiting
(defun flush-dvroom-lists ()
(for dvroom-manager dvroom-managers
(remove-from-dvroom-group dvroom-manager window-window))
(with (index (member window-window dvroom-managers))
; if a dvroom manager
(if index
(progn
(if (= current-dvroom index)
(setq current-dvroom ())
(progn
(open-dvroom)
(if (> current-dvroom index)
(setq current-dvroom (- current-dvroom 1)))))
(delete-nth index dvroom-managers)))))
; add flush-dvroom-lists to progn of funcs to eval when closing an old window
; assumes dvroom.gwm is loaded before the set-* calls in .profile.gwm
(setq closing (+ closing '((flush-dvroom-lists))))
; colas: create dvroom managers as placed menus
(defun new-dvroom-manager args
(if (not (find-dvroom-by-name (# 0 args)))
(with (fsm window-fsm
background dvroom.background foreground dvroom.foreground
borderwidth dvroom.borderwidth
direction vertical
label-horizontal-margin 4 label-vertical-margin 2
menu-min-width 30 menu-max-width 1000
name (if args (# 0 args) (new-dvroom-manager-name))
)
(setq wob
(with (icon-name name starts-iconic t)
(place-menu
'rmgr
(menu-make
(bar-make
(with (fsm dvroom.fsm
property (+ (list
'title name
'background dvroom.background
'foreground dvroom.foreground
'borderwidth dvroom.borderwidth
'font dvroom.font
) property))
(plug-make
(label-make name dvroom.font)))))
dvroom.x dvroom.y)))
(## 'title wob name)
(add-dvroom-manager))))
; generates a new dvroom name
(defun new-dvroom-manager-name ()
(setq dvroom.name.number (+ 1 dvroom.name.number))
(+ dvroom.name (itoa dvroom.name.number)))
; editable plug fsm
(setq dvroom.fsm
(fsm-make
(: dvroom.edit-fsm.normal
(state-make
(on (double-button any any)
(progn
(set-focus wob)
(wob-background (# 'foreground wob))
(with (
foreground (# 'background wob)
background (# 'foreground wob)
)
(wob-tile
(active-label-make
(# 'title wob) (# 'font wob)))))
dvroom.edit-fsm.editable)
(on (button any (together with-alt with-control))
(progn
(set-focus wob)
(wob-background (# 'foreground wob))
(with (
foreground (# 'background wob)
background (# 'foreground wob)
)
(wob-tile
(active-label-make
(# 'title wob) (# 'font wob)))))
dvroom.edit-fsm.editable)
icon-behavior
standard-behavior
))
(: dvroom.edit-fsm.editable
(state-make
(on (keypress (key-make edit-keys.return) any)
(dvroom.edit-fsm.de-edit)
dvroom.edit-fsm.normal)
(on (double-button any any)
(dvroom.edit-fsm.de-edit)
dvroom.edit-fsm.normal)
(on (keypress edit-keys.backspace any)
(progn
(## 'title wob
(if (: s (match "\\(.*\\)."
(# 'title wob) 1))
s
(setq s "")))
(with (
foreground (# 'background wob)
background (# 'foreground wob)
)
(wob-tile (active-label-make s (# 'font wob))))
))
(on (keypress edit-keys.delete any)
(progn
(## 'title wob (: s ""))
(with (
foreground (# 'background wob)
background (# 'foreground wob)
)
(wob-tile (active-label-make s (# 'font wob))))
))
(on (keypress any any)
(progn
(## 'title wob
(: s (+ (# 'title wob) (last-key))))
(with (
foreground (# 'background wob)
background (# 'foreground wob)
)
(wob-tile (active-label-make s (# 'font wob))))
))
(on focus-out
(dvroom.edit-fsm.de-edit)
dvroom.edit-fsm.normal)
icon-behavior
standard-behavior
))
))
))
(if (not (boundp 'update-icon))
(defun update-icon (update-icon.title)
(if (window-icon?)
(send-user-event 'get-title (window-icon)))))
(de dvroom.edit-fsm.de-edit ()
(wob-background (# 'background wob))
(with (background (# 'background wob)
foreground (# 'foreground wob)
)
(wob-tile (label-make (# 'title wob) (# 'font wob)))
(update-icon (# 'title wob)))
)
;
; find dvroom window belongs to
;
(defun find-window-in-any-dvroom (win)
(tag found-in-manager
(for dvr dvroom-managers
(with (slot (member win (nth 'rgroup dvr)))
(if slot (exit found-in-manager dvr))
)
)
)
)
;
; detach window from all room managers
;
(defun remove-window-from-all-dvroom (win)
(with (dvr (find-window-in-any-dvroom win))
(if dvr (remove-from-dvroom-group dvr win))
)
)
;
; automatic room attachment based upon name
;
(defun auto-window-attach (w)
(with (w-name (with (window w) (window-name)))
(with (d-name (match "\\(.*\\)::" w-name 1))
(if (< 0 (length d-name))
(with (dvr (find-dvroom-by-name d-name))
(if dvr
;;
;; by now, we've found a dvroom with the desired name
;; just in case, try to detach this window from it's dvroom
;; and attach it to the target dvroom
;;
(progn
(qprint "Auto-Add " w-name " to " d-name "\n" )
(remove-window-from-all-dvroom w)
(add-to-dvroom-group dvr w)
(set-x-property "GWM_ROOM" d-name)
)
)
)
)
)
)
)
;
; automatic room attachment for all windows
;
(defun magic-dvroom-attach ()
(for win (list-of-windows 'window)
(auto-window-attach win)
)
)
;
; unmap all windows/icon that belong to a room
;
(defun dvroom-remapping ()
(for win (list-of-windows 'window)
(with (dvr (find-window-in-any-dvroom win))
(if dvr
(with (window win)
(if window-is-mapped (unmap-window win))
(if (window-icon?)
(with (window window-icon)
(if window-is-mapped (unmap-window window-icon))
)
)
)
)
)
)
)
;
; Next dvroom number
;
(defun increment-dvroom ()
(with (room-leng (length dvroom-managers))
(if (> room-leng 0)
(if current-dvroom
(with (room (+ current-dvroom 1))
(if (= room (length dvroom-managers))
0
room
)
)
0
)
()
)
)
)
;
; Previous dvroom number
;
(defun decrement-dvroom ()
(with (room-leng (length dvroom-managers))
(if (> room-leng 0)
(if current-dvroom
(with (room (- current-dvroom 1))
(if (< room 0)
(- room-leng 1)
room
)
)
(- room-leng 1)
)
()
)
)
)
;
; Close current Room
;
(defun close-current-dvroom ()
(if current-dvroom
(with (window (# current-dvroom dvroom-managers))
(progn
(close-dvroom)
(setq current-dvroom ())
(pre-dvrooms-iconify-window)
)
)
)
)
;
; Open dvroom by number
;
(defun open-room-number (room)
(if room
(progn
(close-current-dvroom)
(with (window (# room dvroom-managers))
(progn
(open-dvroom)
(setq current-dvroom room)
(with (window window-icon)
(pre-dvrooms-iconify-window)
)
)
)
)
)
)
;
; Open next room
;
(defun roll-rooms-up ()
(open-room-number (increment-dvroom))
)
;
; Open previous room
;
(defun roll-rooms-down ()
(open-room-number (decrement-dvroom))
)
;; adds the "add to room" and "remove from room" menu items in the
;; window menu, "New dvroom" in the root menu
(if (not (boundp 'dvroom.menu-added)) (progn
(setq dvroom.menu-added t)
(if (eq window-pop-items icon-pop-items)
(setq window-pop-equals-icon-pop t)
(setq window-pop-equals-icon-pop ()))
(insert-at '(item-make "New dvroom" (new-dvroom-manager))
root-pop-items
dvroom.rootmenupos)
(insert-at '(multi-item-make
"Room: "
()
("Add" (add-to-dvroom))
("Remove" (remove-from-dvroom)))
window-pop-items
dvroom.menupos)
(if window-pop-equals-icon-pop
(setq icon-pop-items window-pop-items))
))