263 lines
7.0 KiB
Scheme
263 lines
7.0 KiB
Scheme
|
|
;; *** utils *********************************************************
|
|
(define-structure utils
|
|
(export mdisplay assq/false flatten
|
|
select* spawn* with-lock
|
|
make-sync-point sync-point-release sync-point-wait
|
|
send-message+wait
|
|
|
|
options:dpy options:colormap
|
|
create-options free-options build-options
|
|
get-option-value get-option set-option! get-options
|
|
((define-options-spec) :syntax) options-spec-union
|
|
get-options-diff spec-defaults
|
|
|
|
string->keys string->key key:keycode key:modifiers
|
|
|
|
reparent-to-root window-path
|
|
window-viewable? window-mapped?
|
|
window-focused?
|
|
window-contains-focus?
|
|
take-focus delete-window
|
|
window-exists?
|
|
move-resize-window*
|
|
root-rectangle window-rectangle clip-rectangle
|
|
draw-shadow-rectangle
|
|
fill-rectangle*
|
|
invalidate-window
|
|
text-center-pos
|
|
window-level
|
|
point-in-rectangle? rectangles-overlap?
|
|
set-wm-state! get-wm-state ((wm-state) :syntax)
|
|
send-configuration
|
|
|
|
maximize-window maximal-size/hints
|
|
size-window desired-size/hints desired-position/hints
|
|
minimal-size/hints
|
|
install-colormaps uninstall-colormaps
|
|
|
|
now at-time-rv after-time-rv
|
|
with-prevent-events)
|
|
(open scheme i/o list-lib define-record-types finite-types enum-sets
|
|
threads locks placeholders rendezvous rendezvous-channels
|
|
signals handle scsh inspect-exception
|
|
rx-syntax field-reader-package
|
|
xlib)
|
|
(files utils))
|
|
|
|
(define-structure dragging
|
|
(export install-dragging-control)
|
|
(open scheme define-record-types threads list-lib
|
|
rendezvous-channels rendezvous
|
|
xlib
|
|
utils)
|
|
(files drag-window))
|
|
|
|
(define-structure titlebar
|
|
(export create-titlebar destroy-titlebar titlebar? titlebar:window
|
|
map-titlebar unmap-titlebar move-resize-titlebar
|
|
set-titlebar-state! set-titlebar-title! set-titlebar-title+state!
|
|
titlebar-options-spec)
|
|
(open scheme define-record-types threads list-lib
|
|
rendezvous-channels rendezvous
|
|
xlib
|
|
utils button)
|
|
(files titlebar))
|
|
|
|
(define-structure prompt
|
|
(export prompt)
|
|
(open scheme list-lib rendezvous-channels
|
|
xlib
|
|
utils)
|
|
(files prompt))
|
|
|
|
(define-structure button
|
|
(export create-button destroy-button
|
|
map-button unmap-button
|
|
move-resize-button
|
|
button-get-state button-set-state!
|
|
button-set-content!
|
|
button-options-spec)
|
|
(open scheme list-lib rendezvous-channels
|
|
rendezvous placeholders
|
|
define-record-types
|
|
xlib
|
|
utils)
|
|
(files button))
|
|
|
|
(define-structure file-name-completion
|
|
(export executables-in-path
|
|
executables-in-path/prefix)
|
|
(open scheme-with-scsh
|
|
srfi-1
|
|
thread-fluids)
|
|
(files file-name-completion))
|
|
|
|
;; *** motif hints ***************************************************
|
|
|
|
(define-structure motif
|
|
(export motif-wm-hints? motif-wm-hints:functions motif-wm-hints:decorations
|
|
motif-wm-hints:input-mode motif-wm-hints:status
|
|
((motif-decorations motif-decoration) :syntax)
|
|
get-motif-wm-hints)
|
|
(open scheme-with-scsh srfi-1
|
|
define-record-types finite-types enum-sets
|
|
xlib)
|
|
(files motif))
|
|
|
|
;; *** key-grab ******************************************************
|
|
|
|
(define-structure key-grab
|
|
(export grab-shortcut)
|
|
(open scheme define-record-types enum-sets weak
|
|
threads list-lib
|
|
rendezvous-channels rendezvous locks
|
|
xlib utils)
|
|
(files key-grab))
|
|
|
|
;; *** manager *******************************************************
|
|
|
|
(define-structure manager
|
|
(export wm? wm:type wm:dpy wm:window wm:colormap wm:options wm:out-channel
|
|
wm:internal-out-channel wm:special-options
|
|
(manager-type :syntax) manager-types manager-type-name
|
|
create-wm destroy-wm
|
|
wm-clients wm-clients-stacking wm-current-client
|
|
wm-manage-window wm-unmanage-window wm-select-client
|
|
wm-configure-window
|
|
wm-iconify-window wm-normalize-window wm-maximize-window
|
|
wm-deinit-client
|
|
|
|
ignore-next-enter-notify!
|
|
|
|
client? client:window client:client-window
|
|
client:data set-client:data!
|
|
client:wm-state set-client:wm-state!
|
|
client:focused?
|
|
client-name find-window-by-name get-all-window-names
|
|
client-replace-window
|
|
client-of-window)
|
|
(open scheme (subset scsh (format)) threads list-lib locks signals
|
|
xlib
|
|
define-record-types
|
|
finite-types
|
|
rendezvous-channels
|
|
rendezvous
|
|
utils key-grab)
|
|
(files manager))
|
|
|
|
;; *** move manager **************************************************
|
|
|
|
(define-structure move-wm
|
|
(export create-move-wm)
|
|
(open scheme list-lib define-record-types signals
|
|
threads rendezvous-channels rendezvous
|
|
xlib button
|
|
manager key-grab
|
|
utils dragging titlebar button
|
|
motif enum-sets)
|
|
(files move-wm
|
|
move-wm-resizer
|
|
move-wm-pager))
|
|
|
|
;; *** split manager *************************************************
|
|
|
|
(define-structure split-wm
|
|
(export create-split-wm)
|
|
(open scheme list-lib define-record-types signals
|
|
threads rendezvous-channels rendezvous placeholders
|
|
xlib
|
|
manager
|
|
utils key-grab)
|
|
(files split-wm))
|
|
|
|
;; *** switch manager ************************************************
|
|
|
|
(define-structure switch-wm
|
|
(export create-switch-wm)
|
|
(open scheme (subset scsh (format))
|
|
list-lib define-record-types signals
|
|
threads rendezvous-channels rendezvous
|
|
xlib
|
|
manager titlebar dragging
|
|
utils key-grab)
|
|
(files switch-wm))
|
|
|
|
;; *** user's config-file utils **************************************
|
|
|
|
(define-interface config-file-interface
|
|
(export root-options
|
|
split-options
|
|
switch-options
|
|
move-options))
|
|
|
|
(define-structure config-file-utils
|
|
(export root-options
|
|
split-options
|
|
switch-options
|
|
move-options
|
|
((define-option define-options) :syntax))
|
|
(open scheme)
|
|
(begin
|
|
(define root-options '())
|
|
(define split-options '())
|
|
(define switch-options '())
|
|
(define move-options '())
|
|
(define-syntax define-option
|
|
(syntax-rules
|
|
()
|
|
((define-option list name value)
|
|
(set! list (cons (cons (quote name) value)
|
|
list)))))
|
|
(define-syntax define-options
|
|
(syntax-rules
|
|
()
|
|
((define-options l (name value) ...)
|
|
(set! l (append (list (cons (quote name) value)
|
|
...)
|
|
l)))))))
|
|
|
|
;; *** main package **************************************************
|
|
|
|
(define-structure scsh-things
|
|
(export ((run &) :syntax) port->sexp-list)
|
|
(open scsh))
|
|
|
|
(define-structure config
|
|
(export backup-layout
|
|
restore-layout
|
|
load-configuration)
|
|
(open scheme list-lib handle
|
|
scsh xlib rt-modules
|
|
utils manager root-manager)
|
|
(files config))
|
|
|
|
(define-structure root-manager
|
|
(export root-wm? create-root-wm
|
|
wait-for-root-wm
|
|
root-wm:dpy root-wm:initial-manager root-wm:options
|
|
get-manager-by-window
|
|
create-new-manager
|
|
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
|
|
rendezvous rendezvous-channels
|
|
utils key-grab
|
|
manager
|
|
move-wm split-wm switch-wm
|
|
prompt file-name-completion)
|
|
(files root-manager
|
|
config-specs))
|
|
|
|
(define-structure main
|
|
(export start orion-wm)
|
|
(open scsh scheme threads handle
|
|
xlib
|
|
manager root-manager config
|
|
utils)
|
|
(files main))
|