189 lines
4.7 KiB
Scheme
189 lines
4.7 KiB
Scheme
|
|
;; *** utils *********************************************************
|
|
(define-structure utils
|
|
(export mdisplay assq/false flatten
|
|
select* spawn* with-lock
|
|
make-sync-point sync-point-release sync-point-wait
|
|
|
|
create-options free-options
|
|
get-option-value get-option set-option! get-options
|
|
((define-options-spec) :syntax) options-spec-union
|
|
get-options-diff
|
|
|
|
string->keys string->key key:keycode key:modifiers
|
|
|
|
reparent-to-root window-path
|
|
window-viewable?
|
|
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?
|
|
set-wm-state! get-wm-state ((wm-state) :syntax)
|
|
send-configuration
|
|
|
|
maximize-window maximal-size/hints
|
|
size-window desired-size/hints desired-position/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
|
|
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!)
|
|
(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)
|
|
(open scheme list-lib rendezvous-channels
|
|
define-record-types
|
|
xlib
|
|
utils)
|
|
(files button))
|
|
|
|
;; *** 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
|
|
(manager-type :syntax) manager-types manager-type-name
|
|
create-wm destroy-wm
|
|
wm-clients wm-current-client
|
|
|
|
wm-manage-window wm-unmanage-window wm-select-client
|
|
wm-configure-window
|
|
|
|
client? client:window client:client-window
|
|
client:data set-client:data!
|
|
client-name find-window-by-name get-all-window-names
|
|
client-replace-window
|
|
client-of-window)
|
|
(open scheme threads list-lib locks
|
|
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
|
|
threads rendezvous-channels rendezvous
|
|
xlib
|
|
manager key-grab
|
|
utils dragging titlebar)
|
|
(files move-wm
|
|
move-wm-resizer))
|
|
|
|
;; *** split manager *************************************************
|
|
|
|
(define-structure split-wm
|
|
(export create-split-wm split-wm?)
|
|
(open scheme list-lib define-record-types
|
|
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 list-lib define-record-types
|
|
threads rendezvous-channels rendezvous
|
|
xlib
|
|
manager titlebar dragging
|
|
utils key-grab)
|
|
(files switch-wm))
|
|
|
|
;; *** main package **************************************************
|
|
|
|
(define-structure scsh-things
|
|
(export ((run) :syntax))
|
|
(open scsh))
|
|
|
|
(define-structure config
|
|
(export backup-layout
|
|
restore-layout
|
|
load-configuration)
|
|
(open scheme list-lib
|
|
scsh xlib
|
|
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)
|
|
(open scheme list-lib scsh-things
|
|
define-record-types threads
|
|
xlib
|
|
rendezvous rendezvous-channels
|
|
utils key-grab
|
|
manager
|
|
move-wm split-wm switch-wm
|
|
prompt)
|
|
(files root-manager))
|
|
|
|
(define-structure main
|
|
(export start)
|
|
(open scsh scheme threads handle
|
|
xlib
|
|
manager root-manager config
|
|
utils)
|
|
(files main))
|