- allocate options for the different manager types only once
- therefor separated individual options (e.g. aspect of split managers) - created central file for the option specifications: config-specs.scm
This commit is contained in:
frese
parent
fae255085c
commit
e7b936149c
|
|
@ -0,0 +1,79 @@
|
|||
;; *** configuration specification ***********************************
|
||||
|
||||
(define-options-spec split-options-spec
|
||||
(orientation symbol 'horizontal) ;; horizontal | vertical
|
||||
(aspect number 1/1)
|
||||
(bar-width int 3)
|
||||
(resize-step int 5)
|
||||
(bar-style symbol 'raised) ;; raised | sunken | flat
|
||||
(bar-colors colors '("#dddddd" "#888888" "#333333"))
|
||||
(select-right keys "M-Right")
|
||||
(select-left keys "M-Left")
|
||||
(select-up keys "M-Up")
|
||||
(select-down keys "M-Down")
|
||||
(focus-policy symbol-list '()) ;; present only for implementation reasons
|
||||
)
|
||||
|
||||
(define-options-spec switch-options-spec
|
||||
(titlebar-colors colors '("#aaaaaa" "#eeeeee" "#777777" "black"))
|
||||
(titlebar-colors-focused colors '("#666699" "#aaaacc" "#333366" "#eeeeee"))
|
||||
(titlebar-colors-active colors '("#9999aa" "#eeeeff" "#777788" "black"))
|
||||
(titlebar-height int 18)
|
||||
(titlebar-style symbol 'raised)
|
||||
(font font "-*-helvetica-medium-r-normal-*-12-*-*-*-*-*-*-*")
|
||||
(select-next keys "M-k n")
|
||||
(select-previous keys "M-k p")
|
||||
(swap-next keys "M-k t")
|
||||
(swap-previous keys "M-k r")
|
||||
(focus-policy symbol-list '(enter)) ;; enter, click
|
||||
)
|
||||
|
||||
(define-options-spec move-options-spec
|
||||
(titlebar-colors colors '("#aaaaaa" "#eeeeee" "#777777" "black"))
|
||||
(titlebar-colors-focused colors '("#666699" "#aaaacc" "#333366" "#eeeeee"))
|
||||
(titlebar-height int 18)
|
||||
(titlebar-style symbol 'flat)
|
||||
(font font "-*-helvetica-medium-r-normal-*-12-*-*-*-*-*-*-*")
|
||||
(border-width int 3)
|
||||
(corner-width int 10)
|
||||
(border-style symbol 'raised) ;; raised | sunken | flat
|
||||
(border-colors colors '("#333333" "#dddddd"))
|
||||
(pager-colors colors ;; bg, button, light, dark, font
|
||||
'("#808080" "#aaaaaa" "#eeeeee" "#777777" "black"))
|
||||
(pager-maximum-button-width int 140)
|
||||
(pager-height int 24)
|
||||
(select-next keys "M-Tab")
|
||||
(select-previous keys "M-S-Tab") ;; or ISO_Left_Tab ?
|
||||
(hide-show-pager keys "M-p")
|
||||
(focus-policy symbol-list '(click)) ;; enter, click
|
||||
)
|
||||
|
||||
(define-options-spec root-options-spec
|
||||
(quit keys "F12")
|
||||
(quit-question string "Really quit orion?")
|
||||
(split-horizontal keys "M-s h")
|
||||
(split-vertical keys "M-s v")
|
||||
(split-horizontal-with-switch-wm keys "M-s s h")
|
||||
(split-vertical-with-switch-wm keys "M-s s v")
|
||||
(split-horizontal-with-move-wm keys "M-s m h")
|
||||
(split-vertical-with-move-wm keys "M-s m v")
|
||||
(create-switch-wm keys "M-k s")
|
||||
(create-move-wm keys "M-k m")
|
||||
(split-question string "What kind of manager do you want in the second frame?\n(S)witch or (M)ove windowmanager:")
|
||||
(execute keys "F3")
|
||||
(execute-question string "Execute:")
|
||||
(attach keys "M-a")
|
||||
(attach-question string "Attach:")
|
||||
(split-options sexp '())
|
||||
(switch-options sexp '())
|
||||
(move-options sexp '())
|
||||
(workspace-options sexp '((titlebar-height . 0)))
|
||||
(nth-workspace keys-list '("M-1" "M-2" "M-3" "M-4"))
|
||||
(create-workspace keys "F9")
|
||||
(create-workspace-question string "What kind of manager do you want in the new workspace?\n(S)witch or (M)ove windowmanager:")
|
||||
(kill-client keys "M-c")
|
||||
(user-bindings binding-list '(("F2" exec "xterm")))
|
||||
(save-layout keys "F11")
|
||||
(select-outer-manager keys "M-Home")
|
||||
)
|
||||
|
||||
|
|
@ -17,23 +17,22 @@
|
|||
(define (create-root-layout root-wm layout)
|
||||
(letrec ((loop (lambda (parent spec)
|
||||
(let ((type (car spec))
|
||||
(options (cadr spec))
|
||||
(special-options (cadr spec))
|
||||
(more (cddr spec)))
|
||||
(let* ((type2 (cond
|
||||
((eq? 'split type) (manager-type split))
|
||||
((eq? 'switch type) (manager-type switch))
|
||||
((eq? 'move type) (manager-type move))))
|
||||
;; else error ?!
|
||||
(def-opt
|
||||
(get-option-value
|
||||
(root-wm:options root-wm)
|
||||
(cond
|
||||
((eq? 'split type) 'default-split-options)
|
||||
((eq? 'switch type) 'default-switch-options)
|
||||
((eq? 'move type) 'default-move-options))))
|
||||
(options
|
||||
((cond
|
||||
((eq? 'split type) root-wm:split-options)
|
||||
((eq? 'switch type) root-wm:switch-options)
|
||||
((eq? 'move type) root-wm:move-options))
|
||||
root-wm))
|
||||
|
||||
(wm (create-new-manager root-wm type2
|
||||
options def-opt
|
||||
options special-options
|
||||
parent)))
|
||||
(for-each (lambda (spec)
|
||||
(loop wm spec))
|
||||
|
|
@ -89,11 +88,11 @@
|
|||
(let ((config-file (reify-structure 'config-file)))
|
||||
(load-structure config-file)
|
||||
(let ((get (lambda (n) (rt-structure-binding config-file n))))
|
||||
(append (list (cons 'default-split-options
|
||||
(append (list (cons 'split-options
|
||||
(get 'split-options))
|
||||
(cons 'default-switch-options
|
||||
(cons 'switch-options
|
||||
(get 'switch-options))
|
||||
(cons 'default-move-options
|
||||
(cons 'move-options
|
||||
(get 'move-options)))
|
||||
(get 'root-options))))))))
|
||||
;; TODO: maybe create a file with default-config-file in it
|
||||
|
|
|
|||
|
|
@ -1,8 +1,3 @@
|
|||
(define-options-spec manager-options-spec
|
||||
(focus-policy symbol-list '(enter)) ;; enter, click
|
||||
(client-cursor cursor xc-X-cursor)
|
||||
)
|
||||
|
||||
(define-record-type wm :wm
|
||||
(make-wm type in-channel out-channel internal-out-channel
|
||||
dpy window colormap options
|
||||
|
|
@ -36,8 +31,8 @@
|
|||
((eq? type (manager-type switch)) "switch-wm")
|
||||
((eq? type (manager-type move)) "move-wm")))
|
||||
|
||||
(define (create-wm dpy parent options default-options children
|
||||
type options-spec out-channel fun)
|
||||
(define (create-wm dpy parent options children
|
||||
type out-channel fun)
|
||||
(let* ((wa (get-window-attributes dpy parent))
|
||||
(main-window
|
||||
(create-simple-window dpy parent 0 0 (window-attribute:width wa)
|
||||
|
|
@ -50,13 +45,7 @@
|
|||
(internal-out-channel (make-channel))
|
||||
(wm (make-wm type in-channel out-channel internal-out-channel
|
||||
dpy main-window colormap
|
||||
(create-options dpy colormap
|
||||
(spec-defaults default-options
|
||||
(options-spec-union
|
||||
options-spec
|
||||
manager-options-spec))
|
||||
options)
|
||||
'() #f)))
|
||||
options '() #f)))
|
||||
|
||||
(set-window-background-pixmap! dpy main-window parent-relative)
|
||||
;; set properties ************************************************
|
||||
|
|
@ -101,7 +90,7 @@
|
|||
(handle-external-message wm exit msg))))
|
||||
(loop))))))
|
||||
(free-colormap dpy colormap)
|
||||
(free-options (wm:options wm) #f)))
|
||||
))
|
||||
|
||||
(for-each (lambda (window)
|
||||
(wm-manage-window wm window))
|
||||
|
|
@ -322,8 +311,8 @@
|
|||
wm-state)))
|
||||
;; transparent by default.
|
||||
(set-window-background-pixmap! dpy client-window parent-relative)
|
||||
(define-cursor dpy client-window
|
||||
(get-option-value (wm:options wm) 'client-cursor))
|
||||
;;(define-cursor dpy client-window xc-X-cursor) TODO
|
||||
|
||||
(if (memq 'click (get-option-value (wm:options wm) 'focus-policy))
|
||||
;; Note: won't work recursively (manager in manager)
|
||||
(grab-button dpy (button button1) (state-set) client-window
|
||||
|
|
|
|||
|
|
@ -1,28 +1,7 @@
|
|||
(define-options-spec move-wm-options-spec
|
||||
(titlebar-colors colors '("#aaaaaa" "#eeeeee" "#777777" "black"))
|
||||
(titlebar-colors-focused colors '("#666699" "#aaaacc" "#333366" "#eeeeee"))
|
||||
(titlebar-height int 18)
|
||||
(titlebar-style symbol 'flat)
|
||||
(font font "-*-helvetica-medium-r-normal-*-12-*-*-*-*-*-*-*")
|
||||
(border-width int 3)
|
||||
(corner-width int 10)
|
||||
(border-style symbol 'raised) ;; raised | sunken | flat
|
||||
(border-colors colors '("#333333" "#dddddd"))
|
||||
(pager-colors colors ;; bg, button, light, dark, font
|
||||
'("#808080" "#aaaaaa" "#eeeeee" "#777777" "black"))
|
||||
(pager-maximum-button-width int 140)
|
||||
(pager-height int 24)
|
||||
(select-next keys "M-Tab")
|
||||
(select-previous keys "M-S-Tab") ;; or ISO_Left_Tab ?
|
||||
(hide-show-pager keys "M-p")
|
||||
)
|
||||
|
||||
(define (create-move-wm out-channel dpy parent options default-options
|
||||
. children)
|
||||
(create-wm dpy parent options (append default-options
|
||||
'((focus-policy . (click))))
|
||||
children
|
||||
(manager-type move) move-wm-options-spec
|
||||
(define (create-move-wm out-channel dpy parent options
|
||||
special-options . children)
|
||||
(create-wm dpy parent options children
|
||||
(manager-type move)
|
||||
out-channel
|
||||
(lambda (wm in-channel)
|
||||
(init-move-wm wm in-channel)
|
||||
|
|
|
|||
|
|
@ -234,7 +234,10 @@
|
|||
root-wm:dpy root-wm:initial-manager root-wm:options
|
||||
get-manager-by-window
|
||||
create-new-manager
|
||||
root-wm-manage-window)
|
||||
root-wm-manage-window
|
||||
root-wm:split-options root-wm:switch-options root-wm:move-options
|
||||
root-options-spec split-options-spec
|
||||
switch-options-spec move-options-spec)
|
||||
(open scheme list-lib scsh-things signals extended-ports
|
||||
define-record-types threads
|
||||
xlib
|
||||
|
|
@ -243,7 +246,8 @@
|
|||
manager
|
||||
move-wm split-wm switch-wm
|
||||
prompt file-name-completion)
|
||||
(files root-manager))
|
||||
(files root-manager
|
||||
config-specs))
|
||||
|
||||
(define-structure main
|
||||
(export start orion-wm)
|
||||
|
|
|
|||
|
|
@ -1,35 +1,7 @@
|
|||
(define-options-spec root-options-spec
|
||||
(quit keys "F12")
|
||||
(quit-question string "Really quit orion?")
|
||||
(split-horizontal keys "M-s h")
|
||||
(split-vertical keys "M-s v")
|
||||
(split-horizontal-with-switch-wm keys "M-s s h")
|
||||
(split-vertical-with-switch-wm keys "M-s s v")
|
||||
(split-horizontal-with-move-wm keys "M-s m h")
|
||||
(split-vertical-with-move-wm keys "M-s m v")
|
||||
(create-switch-wm keys "M-k s")
|
||||
(create-move-wm keys "M-k m")
|
||||
(split-question string "What kind of manager do you want in the second frame?\n(S)witch or (M)ove windowmanager:")
|
||||
(execute keys "F3")
|
||||
(execute-question string "Execute:")
|
||||
(attach keys "M-a")
|
||||
(attach-question string "Attach:")
|
||||
(default-split-options sexp '())
|
||||
(default-switch-options sexp '())
|
||||
(default-move-options sexp '())
|
||||
(workspace-options sexp '())
|
||||
(nth-workspace keys-list '("M-1" "M-2" "M-3" "M-4"))
|
||||
(create-workspace keys "F9")
|
||||
(create-workspace-question string "What kind of manager do you want in the new workspace?\n(S)witch or (M)ove windowmanager:")
|
||||
(kill-client keys "M-c")
|
||||
(user-bindings binding-list '(("F2" exec "xterm")))
|
||||
(save-layout keys "F11")
|
||||
(select-outer-manager keys "M-Home")
|
||||
)
|
||||
|
||||
(define-record-type root-wm :root-wm
|
||||
(make-root-wm dpy managers current-manager initial-manager in-channel
|
||||
options finish cross-ref-hack)
|
||||
options finish cross-ref-hack
|
||||
split-options switch-options move-options)
|
||||
root-wm?
|
||||
(dpy root-wm:dpy)
|
||||
(managers root-wm:managers set-root-wm:managers!)
|
||||
|
|
@ -38,7 +10,10 @@
|
|||
(in-channel root-wm:in-channel)
|
||||
(options root-wm:options)
|
||||
(finish root-wm:finish)
|
||||
(cross-ref-hack root-wm:cross-ref-hack))
|
||||
(cross-ref-hack root-wm:cross-ref-hack)
|
||||
(split-options root-wm:split-options)
|
||||
(switch-options root-wm:switch-options)
|
||||
(move-options root-wm:move-options))
|
||||
|
||||
(define (root-wm-managers root-wm)
|
||||
(filter (lambda (wm)
|
||||
|
|
@ -48,15 +23,31 @@
|
|||
(define (create-root-wm dpy options cross-ref-hack)
|
||||
(let* ((window (default-root-window dpy))
|
||||
(screen (display:default-screen dpy))
|
||||
(options (create-options dpy (screen:default-colormap screen)
|
||||
(colormap (screen:default-colormap screen))
|
||||
(options (create-options dpy colormap
|
||||
root-options-spec options))
|
||||
(split-options (create-options dpy colormap
|
||||
split-options-spec
|
||||
(get-option-value options
|
||||
'split-options)))
|
||||
(switch-options (create-options dpy colormap
|
||||
switch-options-spec
|
||||
(get-option-value options
|
||||
'switch-options)))
|
||||
(move-options (create-options dpy colormap
|
||||
move-options-spec
|
||||
(get-option-value options
|
||||
'move-options)))
|
||||
(children (window-children dpy window))
|
||||
(in-channel (make-channel))
|
||||
;; TODO: workspace-options...
|
||||
(workspace-options (create-options dpy colormap switch-options-spec
|
||||
(get-option-value options 'workspace-options)))
|
||||
(initial-manager (create-workspace-manager in-channel dpy window
|
||||
options))
|
||||
options
|
||||
workspace-options))
|
||||
(root-wm (make-root-wm dpy '() #f initial-manager in-channel options
|
||||
(make-sync-point) cross-ref-hack))
|
||||
(make-sync-point) cross-ref-hack
|
||||
split-options switch-options move-options))
|
||||
)
|
||||
(set-root-wm:current-manager! root-wm initial-manager)
|
||||
(add-manager! root-wm initial-manager)
|
||||
|
|
@ -97,15 +88,15 @@
|
|||
(handle-message root-wm exit msg))))
|
||||
(loop))))
|
||||
(sync-point-release (root-wm:finish root-wm))))
|
||||
(free-options split-options #t)
|
||||
(free-options switch-options #t)
|
||||
(free-options move-options #t)
|
||||
(free-options options #t)))
|
||||
root-wm))
|
||||
|
||||
(define (create-workspace-manager in-channel dpy parent options)
|
||||
(define (create-workspace-manager in-channel dpy parent options switch-options)
|
||||
(let ((wm (create-switch-wm in-channel dpy parent
|
||||
'()
|
||||
(cons (cons 'titlebar-height 0)
|
||||
(get-option-value options
|
||||
'workspace-options))))
|
||||
switch-options '()))
|
||||
(select-keys (get-option-value options 'nth-workspace))
|
||||
(channel (make-channel)))
|
||||
(for-each (lambda (i key)
|
||||
|
|
@ -186,24 +177,21 @@
|
|||
(let* ((current (root-wm:current-manager root-wm))
|
||||
(parent (manager-parent root-wm current)) ;; #f if root
|
||||
(dpy (wm:dpy current))
|
||||
(options (root-wm:options root-wm))
|
||||
(in-channel (root-wm:in-channel root-wm))
|
||||
(splitter
|
||||
(create-split-wm in-channel dpy
|
||||
(window-parent dpy (wm:window current))
|
||||
(list (cons 'orientation orientation))
|
||||
(get-option-value options
|
||||
'default-split-options)))
|
||||
(root-wm:split-options root-wm)))
|
||||
(first current)
|
||||
(creator (if (eq? new-wm 'switch-wm)
|
||||
create-switch-wm
|
||||
create-move-wm))
|
||||
(second (creator in-channel dpy (wm:window splitter)
|
||||
'()
|
||||
(get-option-value options
|
||||
(if (eq? new-wm 'switch-wm)
|
||||
'default-switch-options
|
||||
'default-move-options)))))
|
||||
(if (eq? new-wm 'switch-wm)
|
||||
(root-wm:switch-options root-wm)
|
||||
(root-wm:move-options root-wm))
|
||||
'())))
|
||||
;; we just replace the client:window
|
||||
(if parent
|
||||
(client-replace-window parent (wm:window current)
|
||||
|
|
@ -245,12 +233,10 @@
|
|||
(if (eq? (car msg) 'create-switch-wm)
|
||||
(manager-type switch)
|
||||
(manager-type move))
|
||||
(if (eq? (car msg) 'create-switch-wm)
|
||||
(root-wm:switch-options root-wm)
|
||||
(root-wm:move-options root-wm))
|
||||
'()
|
||||
(get-option-value (root-wm:options root-wm)
|
||||
(if (eq? (car msg)
|
||||
'create-switch-wm)
|
||||
'default-switch-options
|
||||
'default-move-options))
|
||||
current)))
|
||||
|
||||
((create-workspace)
|
||||
|
|
@ -265,11 +251,10 @@
|
|||
(if (eq? type 'switch-wm)
|
||||
(manager-type switch)
|
||||
(manager-type move))
|
||||
(if (eq? type 'switch-wm)
|
||||
(root-wm:switch-options root-wm)
|
||||
(root-wm:move-options root-wm))
|
||||
'()
|
||||
(get-option-value (root-wm:options root-wm)
|
||||
(if (eq? type 'switch-wm)
|
||||
'default-switch-options
|
||||
'default-move-options))
|
||||
(root-wm:initial-manager root-wm)))))
|
||||
|
||||
((kill-client)
|
||||
|
|
@ -508,13 +493,13 @@
|
|||
(let ((wm (manager-of-window root-wm p)))
|
||||
(and wm (eq? wm (root-wm:initial-manager root-wm)))))))
|
||||
|
||||
(define (create-new-manager root-wm type options defaults parent)
|
||||
(define (create-new-manager root-wm type options special-options parent)
|
||||
(let* ((creator (cond
|
||||
((eq? type (manager-type split)) create-split-wm)
|
||||
((eq? type (manager-type switch)) create-switch-wm)
|
||||
((eq? type (manager-type move)) create-move-wm)))
|
||||
(wm (creator (root-wm:in-channel root-wm) (root-wm:dpy root-wm)
|
||||
(wm:window parent) options defaults)))
|
||||
(wm:window parent) options special-options)))
|
||||
(wm-manage-window parent (wm:window wm))
|
||||
(add-manager! root-wm wm)
|
||||
(set-root-wm:current-manager! root-wm wm)
|
||||
|
|
|
|||
|
|
@ -1,15 +1,6 @@
|
|||
(define-options-spec split-wm-options-spec
|
||||
(define-options-spec split-special-options-spec
|
||||
(orientation symbol 'horizontal) ;; horizontal | vertical
|
||||
(aspect number 1/1)
|
||||
(bar-width int 3)
|
||||
(resize-step int 5)
|
||||
(bar-style symbol 'raised) ;; raised | sunken | flat
|
||||
(bar-colors colors '("#dddddd" "#888888" "#333333"))
|
||||
(select-right keys "M-Right")
|
||||
(select-left keys "M-Left")
|
||||
(select-up keys "M-Up")
|
||||
(select-down keys "M-Down")
|
||||
)
|
||||
(aspect number 1/1))
|
||||
|
||||
;; ---------- ----------
|
||||
;; | | | | |
|
||||
|
|
@ -18,24 +9,29 @@
|
|||
;; ---------- ----------
|
||||
|
||||
(define (create-split-wm external-in-channel dpy parent options
|
||||
default-options . children)
|
||||
(create-wm dpy parent options default-options children
|
||||
(manager-type split) split-wm-options-spec
|
||||
special-options . children)
|
||||
(create-wm dpy parent options children
|
||||
(manager-type split)
|
||||
external-in-channel
|
||||
(lambda (wm in-channel)
|
||||
(init-split-wm wm in-channel)
|
||||
(init-split-wm wm in-channel
|
||||
(create-options dpy #f
|
||||
split-special-options-spec
|
||||
special-options))
|
||||
wm)))
|
||||
|
||||
(define-record-type split-data :split-data
|
||||
(make-split-data resizer first-client second-client)
|
||||
(make-split-data resizer first-client second-client options)
|
||||
split-data?
|
||||
(resizer data:resizer)
|
||||
(resizer data:resizer set-data:resizer!)
|
||||
(first-client data:first-client set-data:first-client!)
|
||||
(second-client data:second-client set-data:second-client!))
|
||||
(second-client data:second-client set-data:second-client!)
|
||||
(options data:options))
|
||||
|
||||
(define (init-split-wm wm channel)
|
||||
(let* ((resizer (create-resizer wm))
|
||||
(data (make-split-data resizer #f #f)))
|
||||
(define (init-split-wm wm channel options)
|
||||
(let* ((data (make-split-data #f #f #f options))
|
||||
(resizer (create-resizer wm data)))
|
||||
(set-data:resizer! data resizer)
|
||||
(spawn* (list 'split-wm wm)
|
||||
(lambda (release)
|
||||
(map-window (wm:dpy wm) resizer)
|
||||
|
|
@ -45,7 +41,8 @@
|
|||
(let loop ()
|
||||
(let ((msg (receive channel)))
|
||||
(handle-message wm channel data exit msg)
|
||||
(loop)))))))))
|
||||
(loop)))))
|
||||
(free-options options #t)))))
|
||||
|
||||
(define (handle-message wm channel data exit msg)
|
||||
(let ((dpy (wm:dpy wm)))
|
||||
|
|
@ -84,7 +81,7 @@
|
|||
(map-window dpy (client:window client))
|
||||
(map-window dpy (client:client-window client))
|
||||
|
||||
(let ((opt (if (eq? (get-option-value (wm:options wm)
|
||||
(let ((opt (if (eq? (get-option-value (data:options data)
|
||||
'orientation)
|
||||
'horizontal)
|
||||
(if first? 'select-right 'select-left)
|
||||
|
|
@ -144,11 +141,11 @@
|
|||
|
||||
(else (warn "unhandled split-wm message" wm msg)))))
|
||||
|
||||
(define (calc-rectangles wm)
|
||||
(define (calc-rectangles wm data)
|
||||
(let* ((options (wm:options wm))
|
||||
(bar-width (get-option-value options 'bar-width))
|
||||
(orientation (get-option-value options 'orientation))
|
||||
(aspect (get-option-value options 'aspect))
|
||||
(orientation (get-option-value (data:options data) 'orientation))
|
||||
(aspect (get-option-value (data:options data) 'aspect))
|
||||
(r (clip-rectangle (wm:dpy wm) (wm:window wm))))
|
||||
(if (eq? orientation 'horizontal)
|
||||
(let* ((r1 (make-rectangle 0 0
|
||||
|
|
@ -177,7 +174,7 @@
|
|||
(let ((resizer-window (data:resizer data))
|
||||
(first-client (data:first-client data))
|
||||
(second-client (data:second-client data)))
|
||||
(let* ((rects (calc-rectangles wm))
|
||||
(let* ((rects (calc-rectangles wm data))
|
||||
(dpy (wm:dpy wm)))
|
||||
(move-resize-window* dpy resizer-window (second rects))
|
||||
(if first-client
|
||||
|
|
@ -197,7 +194,7 @@
|
|||
;; Resizer
|
||||
;; *******************************************************************
|
||||
|
||||
(define (create-resizer wm)
|
||||
(define (create-resizer wm data)
|
||||
(let* ((dpy (wm:dpy wm))
|
||||
(main-window (wm:window wm))
|
||||
(options (wm:options wm))
|
||||
|
|
@ -277,11 +274,12 @@
|
|||
(commit-resize
|
||||
(lambda (dx dy)
|
||||
;; check if outside... TODO
|
||||
(let* ((rects (calc-rectangles wm))
|
||||
(let* ((rects (calc-rectangles wm data))
|
||||
(r1 (first rects)) (r2 (third rects))
|
||||
(aspect
|
||||
(if (eq? 'horizontal
|
||||
(get-option-value options 'orientation))
|
||||
(get-option-value (data:options data)
|
||||
'orientation))
|
||||
(if (= 0 (- (rectangle:width r2) dx))
|
||||
0
|
||||
(/ (+ (rectangle:width r1) dx)
|
||||
|
|
@ -292,7 +290,7 @@
|
|||
(- (rectangle:height r2) dy))))))
|
||||
(if (> aspect 0)
|
||||
(begin
|
||||
(set-option! options 'aspect aspect)
|
||||
(set-option! (data:options data) 'aspect aspect)
|
||||
(send (wm:internal-out-channel wm)
|
||||
'(fit-windows))
|
||||
)))))
|
||||
|
|
@ -300,7 +298,8 @@
|
|||
(lambda (start-rect dx dy)
|
||||
(let ((width (rectangle:width start-rect))
|
||||
(height (rectangle:height start-rect)))
|
||||
(if (eq? (get-option-value options 'orientation)
|
||||
(if (eq? (get-option-value (data:options data)
|
||||
'orientation)
|
||||
'horizontal)
|
||||
(make-rectangle (+ (rectangle:x start-rect) dx)
|
||||
(rectangle:y start-rect)
|
||||
|
|
|
|||
|
|
@ -1,20 +1,7 @@
|
|||
(define-options-spec switch-wm-options-spec
|
||||
(titlebar-colors colors '("#aaaaaa" "#eeeeee" "#777777" "black"))
|
||||
(titlebar-colors-focused colors '("#666699" "#aaaacc" "#333366" "#eeeeee"))
|
||||
(titlebar-colors-active colors '("#9999aa" "#eeeeff" "#777788" "black"))
|
||||
(titlebar-height int 18)
|
||||
(titlebar-style symbol 'raised)
|
||||
(font font "-*-helvetica-medium-r-normal-*-12-*-*-*-*-*-*-*")
|
||||
(select-next keys "M-k n")
|
||||
(select-previous keys "M-k p")
|
||||
(swap-next keys "M-k t")
|
||||
(swap-previous keys "M-k r")
|
||||
)
|
||||
|
||||
(define (create-switch-wm out-channel dpy parent options default-options
|
||||
. children)
|
||||
(create-wm dpy parent options default-options children
|
||||
(manager-type switch) switch-wm-options-spec
|
||||
(define (create-switch-wm out-channel dpy parent options
|
||||
special-options . children)
|
||||
(create-wm dpy parent options children
|
||||
(manager-type switch)
|
||||
out-channel
|
||||
(lambda (wm in-channel)
|
||||
(init-switch-wm wm in-channel)
|
||||
|
|
|
|||
Loading…
Reference in New Issue