Miroirs/guile-swayer
1
0
Fork 0
mirror of https://github.com/ebeem/guile-swayer.git synced 2024-11-16 07:47:32 +01:00
Code Issues Projects Releases Packages Wiki Activity Actions

improve documentation

Browse source
This commit is contained in:
Almarhoon Ibraheem 2024-06-18 19:05:39 +03:00
parent 0472319c6c
commit 53ab77b3a9
11 changed files with 358 additions and 181 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
commander
View file

@ -21,19 +21,17 @@
(srfi srfi-1))
(define COMMANDS-CLIENT-SOCKET (socket AF_UNIX SOCK_STREAM 0))
(display (string-append "connecting to " SOCKET-COMMANDS-LISTENER-PATH "\n"))
(format #t "connecting to ~a\n" SOCKET-COMMANDS-LISTENER-PATH)
(connect COMMANDS-CLIENT-SOCKET
(make-socket-address AF_UNIX SOCKET-COMMANDS-LISTENER-PATH))
(display "connected\n")
(define (send-command command)
(display (string-append "sending command: " command "\n"))
(format #t "sending command: ~a\n" command)
(display (write-msg COMMANDS-CLIENT-SOCKET
RUN-COMMMAND-MSG-ID
(scm->json-string command)))
(display "sent\n"))
(define (main args)
(display (string-join (cdr args) " "))
(newline)
(send-command (string-join (cdr args) " ")))

12
init.scm
View file

@ -23,8 +23,8 @@
;; subscribe to all events
(sway-subscribe-all)
(set! OUTPUTS '("HDMI-A-2" "DP-1" "DP-2"))
(set! GROUPS
(define OUTPUTS '("HDMI-A-2" "DP-1" "DP-2"))
(define GROUPS
'(("11-browser" "21-browser" "31-browser")
("12-development" "22-development" "32-development")
("13-databases" "23-databases" "33-databases")
@ -35,12 +35,14 @@
("18-development" "28-development" "38-development")
("19-media" "29-media" "39-media")))
(workspace-groups-configure #:groups GROUPS #:outputs OUTPUTS)
(workspace-groups-init)
(set! ROWS 3)
(set! COLUMNS 3)
(set! WORKSPACES (apply map list GROUPS))
(define ROWS 3)
(define COLUMNS 3)
(define WORKSPACES (apply map list GROUPS))
(workspace-grid-configure #:rows ROWS #:columns COLUMNS #:workspaces WORKSPACES)
(workspace-grid-init)
;; TODO: load which key module

25
keybindings.scm
View file

@ -6,7 +6,7 @@
(define (exec command)
"execute given shell command"
(display (string-append "running " command "\n"))
(format #t "running: ~a\n" command)
(thread-start! (make-thread (lambda () (system command)))))
(define (custom-sway-keybinding-translator key)
@ -17,11 +17,16 @@
(define (keybindings-init)
(kbd-init)
(configure-sway-keybinding-translator custom-sway-keybinding-translator)
(configure-sway-commander-path "~/.config/sway/commander")
(define kbd-translator custom-sway-keybinding-translator)
;; FIXME: fix the path of commander here!
;; if this step is not performed, keybindings won't work.
(define commander-path "~/.config/sway/commander")
(general-configure #:keybinding-translator kbd-translator
#:commander-path commander-path)
;; define root keybindings
(sway-define-keys
(general-define-keys
;; media-keys
`("XF86AudioLowerVolume" (exec "pactl set-sink-volume @DEFAULT_SINK@ -5%"))
`("XF86AudioRaiseVolume" (exec "pactl set-sink-volume @DEFAULT_SINK@ +5%"))
@ -73,13 +78,13 @@
`("C-s-Space" (exec "rofi -show drun")))
;; define leader keymap
(sway-define-keys
(general-define-keys
#:prefix "s-Space" #:wk "Leader"
`("o" (exec "rofi -show drun"))
`("C-g" (sway-mode "default") #:wk "abort")
;; rofi keymap
`(sway-define-keys
`(general-define-keys
#:prefix "r" #:wk "Rofi"
("p" (exec "~/.config/rofi/bin/password-manager"))
("m" (exec "rofi-mount"))
@ -93,14 +98,14 @@
("S" (exec "~/.config/rofi/bin/sound-output")))
;; screenshot keymap
`(sway-define-keys
`(general-define-keys
#:prefix "s" #:wk "Screenshot"
("d" (exec "export XDG_CURRENT_DESKTOP=sway && flameshot gui"))
("s" (exec "export XDG_CURRENT_DESKTOP=sway && flameshot screen"))
("f" (exec "export XDG_CURRENT_DESKTOP=sway && flameshot full"))
("m" (exec "export XDG_CURRENT_DESKTOP=sway && flameshot gui --last-region"))
(sway-define-keys
(general-define-keys
#:prefix "d" #:wk "DelayScreenshot"
("d" (exec "export XDG_CURRENT_DESKTOP=sway && flameshot gui -d 2500"))
("s" (exec "export XDG_CURRENT_DESKTOP=sway && flameshot screen -d 2500"))
@ -108,12 +113,12 @@
("l" (exec "export XDG_CURRENT_DESKTOP=sway && flameshot gui -d 2500 --last-region"))))
;; session keymap
`(sway-define-keys
`(general-define-keys
#:prefix "q" #:wk "Session"
("q" (sway-exit))
("r" (sway-reload)))
`(sway-define-keys
`(general-define-keys
#:prefix "w" #:wk "Window"
("v" (sway-layout SWAY-LAYOUT-SPLITV))
("h" (sway-layout SWAY-LAYOUT-SPLITH))

193
modules/general.scm
View file

@ -4,132 +4,189 @@
#:use-module (swayipc connection)
#:use-module (srfi srfi-18)
#:use-module (ice-9 hash-table)
#:export (sway-keybinding-translator
sway-commander-path
configure-sway-commander-path
configure-sway-keybinding-translator
sway-define-keys
sway-define-key
sway-keybindings
sway-submaps))
#:export (general-keybinding-translator
general-commander-path
general-configure
general-define-keys
general-define-key
general-keybindings
general-submaps))
;; Local copy of keybindings configured by general, it's recommended to
;; only use general to assign keybindings, otherwise this hashtable won't
;; by synced with actual keybindings available in sway
(define sway-keybindings (make-hash-table))
(define general-keybindings (make-hash-table))
;; Local copy of submaps configured by general, it's recommended to
;; only use general to assign submaps, otherwise this hashtable won't
;; by synced with actual submaps available in sway"
(define sway-submaps (make-hash-table))
(hash-set! sway-submaps "" "default")
;; by synced with actual submaps available in sway
(define general-submaps (make-hash-table))
(define (sway-keybinding-translator key)
"Translates keybindings, passing kbd function will enable emacs
like key chords. The default implementation doesn't modify passed keybindings"
;; add default submap, this is the default submap in sway
(hash-set! general-submaps "" "default")
(define (general-keybinding-translator key)
"Translate a given key, passing a function can enable easier keybindings
like emacs key chords (refer to module modules/kbd.scm). The default implementation
doesn't modify passed keybindings"
key)
(define sway-commander-path
;; The path of commander executable, it's used to send back scheme expressions
;; via unix socket.
(define general-commander-path
(if current-filename
(dirname (dirname current-filename))
(string-append (dirname (dirname current-filename)) "/commander")
"commander"))
(define (configure-sway-keybinding-translator proc)
(set! sway-keybinding-translator proc))
(define (configure-sway-commander-path path)
(set! sway-commander-path path))
(define* (general-configure #:key keybinding-translator commander-path)
"Configure keybinding-translator (refer to general-keybinding-translator) and
commander-path (refer to 'general-commander-path).
Parameters:
- keybinding-translator: a function that takes a key and returns the translated version.
- commander-path: a path to the commander executable to be used to send keybindings commands."
(when keybinding-translator
(set! general-keybinding-translator keybinding-translator))
(when commander-path
(set! general-commander-path commander-path)))
(define (exp->string exp)
"Convert a given expression exp to a string."
(call-with-output-string (lambda (p)
(write exp p))))
(define* (define-submap chord key wk submap parent-submap)
(display (string-append "define submap " chord "\n"))
(hash-set! sway-submaps chord submap)
(define-keybindings chord key
`(sway-mode ,submap)
wk parent-submap)
(define-keybindings (string-append chord " Esc")
"Escape" `(sway-mode "default")
"Escape" submap))
(define* (define-submap chord wk submap parent-submap)
"Define a submap, this will be translated to sway by defining a keybinding
to switch to the provided submap, and add a default ESC keybinding to return
to the default submap.
Parameters:
- chord: chord string to trigger the keybinding. e.g. (s-SPC f f).
- wk: which-key's description.
- submap: the name of the submap.
- parent-submap: parent submap, default if submap is a child of the default submap."
(let* ((chord-ls (map general-keybinding-translator
(string-split chord #\Space)))
(key (car (last-pair chord-ls))))
(format #t "define submap ~a\n" chord)
(hash-set! general-submaps chord submap)
(define-keybindings chord
`(sway-mode ,submap)
wk parent-submap)
(define-keybindings (string-append chord " Esc")
`(sway-mode "default")
"Escape" submap)))
(define (last-key key)
(car (reverse (string-split key #\+))))
(define (last-key chord)
"Return last key from a given chord."
(car (reverse (string-split chord #\+))))
(define (sway-command exp-str)
(string-append "exec '" sway-commander-path " "
(define (general-command exp-str)
"Execute a general command (scheme expression)"
(string-append "exec '" general-commander-path " "
(exp->string exp-str) "'"))
(define* (define-keybindings chord key exp wk submap)
(hash-set! sway-keybindings chord '(key exp wk submap))
(let* ((type (if (string->number (last-key key)) "bindcode" "bindsym"))
(command (string-append type " " key " " (sway-command (exp->string exp))))
(esc (string-append type " " key " " (sway-command (exp->string `(and ,exp (sway-mode "default")))))))
(define* (define-keybindings chord exp wk submap)
"Define a sway keybinding.
Parameters:
- chord: chord string to trigger the keybinding. e.g. (s-SPC f f).
- exp: expression to execute when the chord is triggered.
- wk: which-key's description.
- submap: the name of the submap."
(let* ((chord-ls (map general-keybinding-translator
(string-split chord #\Space)))
(key (car (last-pair chord-ls)))
(type (if (string->number (last-key key)) "bindcode" "bindsym"))
(command (string-append type " " key " " (general-command (exp->string exp))))
(esc (string-append type " " key " " (general-command (exp->string `(and ,exp (sway-mode "default")))))))
(hash-set! general-keybindings chord '(key exp wk submap))
(if (equal? submap "default")
(dispatch-command command)
(begin
(sway-mode-subcommand submap command)
(unless (equal? "sway-mode" (symbol->string (car exp)))
(display "escape after executing\n")
(display esc)
(sway-mode-subcommand submap esc))))))
(define (find-submap chord)
"Return the submap for the provided chord.
If the submap isn't found, #f is returned."
(or
(hash-get-handle sway-submaps
(hash-get-handle general-submaps
(string-join
(list-head chord (- (length chord) 1)) " "))
(error 'find-submap "chord was not found in submaps, a submap has to be defined for it" chord)))
#f))
(define* (sway-define-key chord #:optional exp #:key wk submap)
"assign a key to a given expression"
(define* (general-define-key chord #:optional exp #:key wk submap)
"Assign a given chord to a given expression.
Parameters:
- chord: chord string to trigger the keybinding. e.g. (s-SPC f f).
- exp: expression to execute when the chord is triggered.
- wk: which-key's description.
- submap: the name of the submap."
(let* ((chord-ls
(map sway-keybinding-translator
(map general-keybinding-translator
(string-split chord #\Space)))
(chord (string-join chord-ls " "))
(key (car (last-pair chord-ls)))
(chord (string-join chord-ls " "))
(key-code (string->number key))
(description (or wk (or submap (symbol->string (car exp))))))
(description (or wk (or submap (symbol->string (car exp)))))
(tsubmap (cdr (find-submap chord-ls))))
;; if target submap isn't found, throw an error
;; the submap must always be defined before defining a keybinding
(unless tsubmap
(error 'find-submap "chord was not found in submaps, a submap has to be defined for it" chord))
(if submap
(define-submap chord key wk submap
;; if submap key is provided, then define a submap (ignore exp)
(define-submap chord wk submap
(cdr (find-submap chord-ls)))
(define-keybindings chord key exp wk
;; otherwise, define a keybinding with exp
(define-keybindings chord exp wk
(cdr (find-submap chord-ls))))))
(define* (sway-define-keys #:key parent-prefix prefix wk . args )
(define* (general-define-keys #:key parent-prefix prefix wk . args )
"Assign given list of chords and expressions to a submap.
Parameters:
- prefix: a prefix that's applied to all the keybindings passed. e.g. (s-Spc).
- parent-prefix: a prefix of the parent (passed internally, you should probably use prefix instead).
- wk: which-key's description of the submap.
- args: list of keybindings to assign to the prefix, these will be passed to general-define-key.
For example:
(general-define-keys
#:prefix \"s-Space\" #:wk \"Leader\"
`(\"o\" (exec \"rofi -show drun\"))
`(\"C-g\" (sway-mode \"default\") #:wk \"abort\")
`(general-define-keys
#:prefix \"r\" #:wk \"Rofi\"
(\"p\" (exec \"~/.config/rofi/bin/password-manager\"))))"
(when parent-prefix
(set! prefix (string-append parent-prefix " " prefix)))
(when prefix
(display (string-append "define prefix submap: " prefix ", wk " wk "\n"))
(sway-define-key prefix #:submap wk))
(format #t "define prefix submap: ~a, wk ~a\n" prefix wk)
(general-define-key prefix #:submap wk))
(map (lambda (arg)
(when (list? arg)
(display "ARG: ")
(display arg)
(newline)
(display (and
(symbol? (car arg))
(equal? "sway-define-keys" (symbol->string (car arg)))))
(newline)
(if (and
(symbol? (car arg))
(equal? "sway-define-keys" (symbol->string (car arg))))
(apply sway-define-keys (append `(#:parent-prefix ,prefix) (cdr arg)))
(apply sway-define-key
(equal? "general-define-keys" (symbol->string (car arg))))
(apply general-define-keys (append `(#:parent-prefix ,prefix) (cdr arg)))
(apply general-define-key
(cons (string-append
(if prefix (string-append prefix " ") "")
(car arg)) (cdr arg))))))
args))
(define (custom-exception-handler exc command-id payload)
(display "An error occurred: ")
(display (exp->string exc))
(newline)
(display (string-append "command: " (number->string command-id) ", payload: " payload)))
"Exception handler for evaluating expressions from commander."
(format #t "An error occurd while executing the expression: ~a\n" (exp->string exc))
(format #t "command: ~a, payload: ~a\n" command-id payload))
;; add a hook to listen to received commands (usually from commander)
(add-hook! command-received-hook
(lambda (command-id payload)
(eval-string (json-string->scm payload))))

54
modules/kbd.scm
View file

@ -8,10 +8,17 @@
keysym-clean
kbd))
;; Hashmap that's used to translate key symbols
;; Use define-keysym to add and translations
(define keysym-translations (make-hash-table))
;; Hashmap that's used to translate modifier symbols
;; Use define-modsym to add and translations
(define modsym-translations (make-hash-table))
(define (replace-char str old-char new-char)
"Replace all occurances of a character (old-char) with the
charcter (new-char)."
(string-map
(lambda (ch)
(if (char=? ch old-char)
@ -20,6 +27,10 @@
str))
(define (keysym-clean key)
"Clean the keysym, it replaces all underscores (_) with dashes (-)
and lowercase all characters. This is done to make it easier to translate
symbols, for example: Spc and SPC should both be translated to the same
symbol. Note: symbols shouldn't include letter like a or b."
(if (<= (string-length (string-trim-both key)) 1)
key
(string-trim-both
@ -27,19 +38,40 @@
(replace-char key #\_ #\-)))))
(define (define-keysym key translation)
"Define a mapping from a modifier to a code."
"Define a mapping from a symbol to a sway compatible symbol in keys
Parameters:
- key: the key to look for in the keybinding.
- translation: the symbol to convert the key to.
Example:
(define-keysym \"SPC\" \"space\")
With the above definition, kbd will translate the keys below.
\"s-spc\" => \"s-space\"
\"s-Spc\" => \"s-space\"
\"s-SPC\" => \"s-space\"
For more information why case is ignored, refer or modify keysym-clean."
(hash-set! keysym-translations (keysym-clean key) translation))
(define (define-modsym key translation)
"Define a mapping from a key to a code."
"Define a mapping from a symbol to a sway compatible symbol in modifier keys
Parameters:
- key: the key to look for in the keybinding.
- translation: the symbol to convert the key to.
Example:
(define-modsym \"s-\" \"mod4+\")
With the above definition, kbd will translate the keys below.
\"s-spc\" => \"mod4+space\"
Note: unlike define-keysym, keysym-clean is not used."
(hash-set! modsym-translations key translation))
(define (string-starts-with? str prefix)
(let ((prefix-length (string-length prefix)))
(and (>= (string-length str) prefix-length)
(string=? (substring str 0 prefix-length) prefix))))
(define* (replace-modifiers key #:optional (translation ""))
"Replace modifier keys in the given key with translations
defined in modsym-translations."
(cond
((< (string-length key) 2) (list translation key))
((hash-get-handle modsym-translations (substring key 0 2))
@ -51,6 +83,8 @@
(else (list translation key))))
(define* (replace-key-symbols key)
"Replace keys in the given key with translations
defined in keysym-translations."
(let* ((lkey (keysym-clean key))
(translation (hash-get-handle keysym-translations lkey)))
(if (pair? translation)
@ -58,6 +92,8 @@
key)))
(define (sway-key key)
"Replace the provided key/chord with translations defined in both
modsym-translations and keysym-translations."
(let* ((modifier (replace-modifiers key))
(rkey (replace-key-symbols (list-ref modifier 1))))
(string-append (list-ref modifier 0)
@ -66,12 +102,14 @@
rkey))))
(define (kbd seq)
"return sway compatible keybinding symbols from emacs like key sequence"
"Return sway compatible keybinding symbols from emacs like key sequence."
(string-join
(map sway-key
(string-split seq #\Space)) " "))
(define (kbd-init)
"Definie initial translations"
;; key modifiers
(define-modsym "C-" "Control+")
(define-modsym "S-" "Shift+")

82
modules/workspace-grid.scm
View file

@ -1,13 +1,9 @@
;; use example:
;; (set! WORKSPACES
;; (("10" "11" "12" "13" "14" "15" "16" "17" "18" "19")
;; ("20" "21" "22" "23" "24" "25" "26" "27" "28" "29")
;; ("30" "31" "32" "33" "34" "35" "36" "37" "38" "39"))
;; (set! ROWS 3)
;; (set! COLUMNS 3)
;; (workspace-grid-configure #:rows 2 #:columns
;; '(("ws-o1-1" "ws-o1-2" "ws-o1-3" "ws-o1-3")
;; ("ws-o2-1" "ws-o2-2" "ws-o2-3" "ws-o2-3")
;; ("ws-o3-1" "ws-o3-2" "ws-o3-3" "ws-o3-3")))
;; (workspace-grid-init)
(define-module (modules workspace-grid)
@ -34,8 +30,6 @@
;; The order in which the outputs are organized, it's important that
;; the order of outputs match the order of workspaces in `WORKSPACE`
;; example:
;; (set! WORKSPACES '(("ws-o1-1" "ws-o1-2" "ws-o1-3") ("ws-o2-1" "ws-o2-2" "ws-o2-3"))
(define WORKSPACES '())
;; number of rows in the grid
@ -44,40 +38,56 @@
(define COLUMNS 1)
(define* (workspace-grid-configure #:key rows columns workspaces)
"Configure workspace grid.
Parameters:
- rows: number of rows in the grid.
- columns: number of columns in the grid
- workspaces: list of list of workspaces. should match the amount of outputs.
Example: configuring a 2x2 workspace grid for 3 monitors.
This means 3x2x2= 12 workspaces should be provided.
(workspace-grid-configure #:rows 2 #:columns
'((\"ws-o1-1\" \"ws-o1-2\" \"ws-o1-3\" \"ws-o1-3\")
(\"ws-o2-1\" \"ws-o2-2\" \"ws-o2-3\" \"ws-o2-3\")
(\"ws-o3-1\" \"ws-o3-2\" \"ws-o3-3\" \"ws-o3-3\")))"
(when rows (set! ROWS rows))
(when columns (set! COLUMNS columns))
(when workspaces (set! WORKSPACES workspaces)))
(define* (get-active-workspace-name #:optional (workspaces (sway-get-workspaces)))
"get name of active workspace"
"Return name of active workspace."
(cond
((null? workspaces) #f)
((equal? (sway-workspace-focused (car workspaces)) #t)
(sway-workspace-name (car workspaces)))
(else (get-active-workspace-name (cdr workspaces)))))
(define* (get-output-index workspace #:optional (workspaces WORKSPACES) (index 0))
"get output index of target workspace"
(define* (get-output-index workspace-name #:optional (workspaces WORKSPACES) (index 0))
"Return output index of target workspace name (workspace-name)"
(cond
((null? workspaces) #f)
((member workspace (car workspaces)) index)
(else (get-output-index workspace (cdr workspaces) (+ index 1)))))
((member workspace-name (car workspaces)) index)
(else (get-output-index workspace-name (cdr workspaces) (+ index 1)))))
(define* (get-workspace-index workspace #:optional
(define* (get-workspace-index workspace-name #:optional
(workspaces
(list-ref WORKSPACES (get-output-index workspace))))
"get index of target workspace"
(let* ((memberls (member workspace workspaces)))
(list-ref WORKSPACES (get-output-index workspace-name))))
"Return index of target workspace name (workspace-name)."
(let* ((memberls (member workspace-name workspaces)))
(if memberls (- (length workspaces) (length memberls)))))
(define (get-active-workspace-index)
"get index of active/focused workspace"
"Return index of active/focused workspace."
(let* ((workspace (get-active-workspace-name)))
(get-workspace-index workspace)))
;; available directions, up, right, down, left
(define* (get-workspace-direction direction #:optional (index -1))
"get the index the next workspace after applying the direction"
"Return the index the target workspace after applying the given direction.
Parameters:
- direction: can be one of \"up\", \"right\", \"down\", \"left\".
- index: the index of the workspace to get the direction from (current by default)."
(let* ((index (if (< index 0) (get-active-workspace-index) index))
(current-row (floor (/ index COLUMNS)))
(current-column (modulo index COLUMNS))
@ -95,66 +105,76 @@
(define* (get-workspace-name #:optional
(workspace (get-active-workspace-index))
(output (get-output-index (get-active-workspace-name))))
"Get workspace name from a given workspace index.
Parameters:
- workspace: workspace index as in configuraiton (by default, current active workspace index).
- output: output index as in configuraiton (by default, current active output index).
Note: returned name is based on configured variable WORKSPACES."
(list-ref (list-ref WORKSPACES output) workspace))
;; exposed command for easier access
(define (switch-workspace-up)
"Focus workspace up in grid."
(sway-switch-workspace
(get-workspace-name
(get-workspace-direction "up"))))
(define (switch-workspace-right)
"Focus workspace right in grid."
(sway-switch-workspace
(get-workspace-name
(get-workspace-direction "right"))))
(define (switch-workspace-down)
"Focus workspace down in grid."
(sway-switch-workspace
(get-workspace-name
(get-workspace-direction "down"))))
(define (switch-workspace-left)
"Focus workspace left in grid."
(sway-switch-workspace
(get-workspace-name
(get-workspace-direction "left"))))
(define (move-container-to-workspace-up)
"Move current container to workspace up in grid and focus it."
(sway-move-container-to-workspace
(get-workspace-name
(get-workspace-direction "up")))
(switch-workspace-up))
(define (move-container-to-workspace-right)
"Move current container to workspace right in grid and focus it."
(sway-move-container-to-workspace
(get-workspace-name
(get-workspace-direction "right")))
(switch-workspace-right))
(define (move-container-to-workspace-down)
"Move current container to workspace down in grid and focus it."
(sway-move-container-to-workspace
(get-workspace-name
(get-workspace-direction "down")))
(switch-workspace-down))
(define (move-container-to-workspace-left)
"Move current container to workspace left in grid and focus it."
(sway-move-container-to-workspace
(get-workspace-name
(get-workspace-direction "left")))
(switch-workspace-left))
(define (valid-grid? rows columns workspaces)
"validate the grid structure"
"Validate the grid structure by ensuring the number of workspaces
matches the number of rowsxcolumns."
(and (> (length workspaces) 0)
(equal? (* rows columns) (length (car workspaces)))))
(define (workspace-grid-init)
(display "starting workspace-grid\n")
(display WORKSPACES)
(newline)
"Initialize the workspace grid."
(format #t "starting workspace-grid\n~a\n" WORKSPACES)
(if (valid-grid? ROWS COLUMNS WORKSPACES)
(display (string-append "successfully started workspace "
(number->string ROWS) "x"
(number->string COLUMNS) "\n"))
(display (string-append "workspace grid failed to start the grid configs "
(number->string ROWS) "x"
(number->string COLUMNS) "\n"))))
(format #t "successfully started workspace ~ax~a\n" ROWS COLUMNS)
(format #t "workspace grid failed to start the grid configs ~ax~a\n" ROWS COLUMNS)))

65
modules/workspace-groups.scm
View file

@ -1,18 +1,9 @@
;; use example:
;; (set! OUTPUTS '("HDMI-A-2" "DP-1" "DP-2"))
;; (set! GROUPS
;; '(("10" "20" "30")
;; ("11" "21" "31")
;; ("12" "22" "32")
;; ("13" "23" "33")
;; ("14" "24" "34")
;; ("15" "25" "35")
;; ("16" "26" "36")
;; ("17" "27" "37")
;; ("18" "28" "38")
;; ("19" "29" "39")))
;; (workspace-groups-configure
;; #:outputs '("DP-1" "DP-2")
;; #:groups '(("dp-1-browsing" "dp-2-browsing")
;; ("dp-1-programming" "dp-2-programming")))
;; (workspace-groups-init)
(define-module (modules workspace-groups)
@ -28,26 +19,39 @@
;; The order in which the outputs are organized, it's important that
;; the order of outputs match the order of workspaces in `WORKSPACE-GROUPS`
;; example:
;; (set! OUTPUTS '("HDMI-A-2" "DP-1" "DP-2"))
(define OUTPUTS '())
;; The workspace groups, each is a list of workspace names
;; if a workspace of this list is activated, the rest of the workspaces
;; will be activated as well.
;; example:
;; (set! GROUPS
;; '(("10" "20" "30")
;; ("19" "29" "39")))
(define GROUPS '())
(define* (workspace-groups-configure #:key outputs groups)
"Configure workspace groups.
Parameters:
- outputs: list of outputs for the groups (they must match the order in groups).
- groups: list of list of workspaces to sync.
Example: configuring workspaces \"dp-1-browsing\" \"dp-2-browsing\" to span together
also configuring \"dp-1-programming\" \"dp-2-programming\" to span together.
This means when ever the workspace \"dp-1-browsing\" is focused, the workspace
\"dp-2-browsing\" will silently be focused as well (switched to, but not focused).
(workspace-groups-configure
#:outputs '(\"DP-1\" \"DP-2\")
#:groups '((\"dp-1-browsing\" \"dp-2-browsing\")
(\"dp-1-programming\" \"dp-2-programming\")))"
(when outputs (set! OUTPUTS outputs))
(when groups (set! GROUPS groups)))
;; keep track of last switched group, prevents switching to
;; group that's already focused.
(define last-switched-group '())
(define (is-workspace-focused workspace output outputs)
(define* (is-workspace-focused workspace output
#:optional (outputs (sway-get-outputs)))
"Return whether a workspace is focused in an output."
(cond
((null? outputs) #f)
((equal? output (sway-output-name (car outputs)))
@ -55,16 +59,20 @@
(else (is-workspace-focused workspace output (cdr outputs)))))
(define (switch-to-workspace-group group initiator)
"Switch to a workspace group, causing all workspaces in that group to be focused.
Parameters:
- group: the group of workspaces (workspace name list).
- initiator: the name of the workspace to be focused after switching to the group.
Note: the last focused workspace is initiator. It will be the actually focused workspace."
(unless (equal? last-switched-group group)
(let* ((initiator-output "")
(outputs (sway-get-outputs)))
(let* ((initiator-output ""))
(set! last-switched-group group)
(newline)
(for-each
(lambda (workspace output)
(if (equal? workspace initiator)
(set! initiator-output output)
(unless (is-workspace-focused workspace output outputs)
(unless (is-workspace-focused workspace output)
(sway-switch-workspace workspace))))
group OUTPUTS)
@ -72,6 +80,8 @@
(sway-switch-workspace initiator))))
(define (focused-workspace workspaces)
"Return focused workspace name from a list of sway workspace.
#f is returned if the workspace isn't found in the list."
(cond
((null? workspaces) #f)
((equal? #t (sway-workspace-focused (car workspaces)))
@ -79,6 +89,8 @@
(else (focused-workspace (cdr workspaces)))))
(define (workspace-changed workspace-event)
"Triggered when sway workspace has changed. This function retrives
and focused all other workspaces in the group."
(let* ((current-tree (sway-workspace-event-current workspace-event))
(workspace (sway-tree-name current-tree))
(focused-workspace (focused-workspace (sway-get-workspaces))))
@ -95,6 +107,12 @@
GROUPS))))
(define (pin-workspaces-to-output groups outputs)
"Pin the groups provided to the outputs. This is called while initializing
to ensure that whenever a workspace is focused, it goes to the outputs it's assigned to.
Parameters:
- outputs: list of outputs for the groups (they must match the order in groups).
- groups: list of list of workspaces to sync."
(for-each
(lambda (group)
(for-each
@ -104,6 +122,7 @@
groups))
(define (workspace-groups-init)
"Initialize the workspace groups."
;; pin workspaces to output
(pin-workspaces-to-output GROUPS OUTPUTS)
(add-hook! sway-workspace-hook workspace-changed))

90
swayipc/connection.scm
View file

@ -86,31 +86,54 @@
(define BAR-STATE-UPDATE-EVENT-REPLY 2147483656)
(define INPUT-EVENT-REPLY 2147483657)
;; listener thread reference
(define LISTENER-THREAD #:f)
;; commands listener thread reference
(define COMMANDS-LISTENER-THREAD #:f)
(define MSG-MAGIC "i3-ipc")
(define MSG-MAGIC-BV (string->utf8 MSG-MAGIC))
;; TODO: maybe also get from sway and i3 binaries
;; the path of sway ipc socket
(define SOCKET-PATH
(and (getenv "SWAYSOCK")
(getenv "I3SOCK")))
;; the path of the swayipc command ipc socket
(define SOCKET-COMMANDS-LISTENER-PATH
(string-append (dirname SOCKET-PATH) "/sway-commands-ipc.sock"))
(define COMMAND-SOCKET (socket AF_UNIX SOCK_STREAM 0))
(connect COMMAND-SOCKET (make-socket-address AF_UNIX SOCKET-PATH))
(define LISTENER-SOCKET (socket AF_UNIX SOCK_STREAM 0))
(connect LISTENER-SOCKET (make-socket-address AF_UNIX SOCKET-PATH))
;; swayipc command ipc socket, this is used to send and
;; receive keybindings commands to and from swayipc.
(define COMMANDS-LISTENER-SOCKET (socket AF_UNIX SOCK_STREAM 0))
;; sway command socket, this is used to send commands and queries
;; to sway via IPC.
(define COMMAND-SOCKET (socket AF_UNIX SOCK_STREAM 0))
;; sway listen socket, this is used to listen to subscribed events
;; from sway via IPC.
(define LISTENER-SOCKET (socket AF_UNIX SOCK_STREAM 0))
(connect COMMAND-SOCKET (make-socket-address AF_UNIX SOCKET-PATH))
(connect LISTENER-SOCKET (make-socket-address AF_UNIX SOCKET-PATH))
;; Hashtable of mutexes for synchronization, keeps each socket separate.
;; This is important to lock sockets while reading/writing.
;; Without it, sway kept sending invalid messages in case so many
;; commands/events are triggered.
(define mutex-table (make-hash-table))
;; <magic-string> is i3-ipc, for compatibility with i3
;; <payload-length> is a 32-bit integer in native byte order
;; <payload-type> is a 32-bit integer in native byte order
(define (encode-msg command-id payload)
"Return a bytevector representing a message based on i3/sway IPC protocol.
Parameters:
- command-id: a number representing the id of the command to send.
- payload: a json string to send along with the command.
Note: returned format is <magic-string> <payload-length> <payload-type> <payload>"
(let* ((bv (make-bytevector (+ 14 (string-length payload)))))
;; <magic-string> <payload-length> <payload-type> <payload>
(bytevector-copy! (string->utf8 "i3-ipc") 0 bv 0 6)
(bytevector-u32-set! bv 6 (string-length payload) (native-endianness))
(bytevector-u32-set! bv 10 command-id (native-endianness))
@ -121,12 +144,22 @@
bv))
(define (write-msg sock command-id payload)
"Encode then send a message based on i3/sway IPC protocol to i3/sway IPC.
Parameters:
- sock: the socket to write the message to.
- command-id: a number representing the id of the command to send.
- payload: a json string to send along with the command."
(put-bytevector sock (encode-msg command-id payload)))
;; Mutex for synchronization
(define mutex-table (make-hash-table))
(define (read-msg sock)
"Return a list in the format of '(command-id payload).
It reads and then decode the read message into command-id payload.
Parameters:
- sock: the socket to read the message from.
Note: read format is <magic-string> <payload-length> <payload-type> <payload>"
(let* ((mutex (if (hash-get-handle mutex-table (fileno sock))
(cdr (hash-get-handle mutex-table (fileno sock)))
(hash-set! mutex-table (fileno sock) (make-mutex)))))
@ -138,7 +171,23 @@
(mutex-unlock! mutex)
(list command-id (or payload "")))))
;; data received: emitted on new data received via ipc.
;; Parameters:
;; - arg1: command-id.
;; - arg2: payload.
(define data-received-hook
(make-hook 2))
;; data received: emitted on new command received via ipc.
;; Parameters:
;; - arg1: command-id.
;; - arg2: payload.
(define command-received-hook
(make-hook 2))
(define (read-from-socket sock)
"Read the message from the given socket.
Once a message is recieved, the data-received-hook will be triggered."
(let loop ()
(let ((data (read-msg sock)))
(run-hook data-received-hook
@ -146,23 +195,9 @@
(list-ref data 1))
(loop))))
(define data-received-hook
;; data received: emitted on new data received via ipc.
;; Parameters:
;; - arg1: command-id.
;; - arg2: payload.
(make-hook 2))
(define command-received-hook
;; data received: emitted on new command received via ipc.
;; Parameters:
;; - arg1: command-id.
;; - arg2: payload.
(make-hook 2))
(define (handle-client client)
"Client handler, used to read messages from the connected client.
Once a message is recieved, the command-received-hook will be triggered."
(let ((port (car client)))
(let ((data (read-msg port)))
(run-hook command-received-hook
@ -173,9 +208,12 @@
(close-port port)))
(define (custom-exception-handler exc)
"Exception handler."
(display "An error occurred while handling client connection\n"))
(define (start-server-socket sock)
"Start a server socket in the given socket.
This will listne to incoming connections and handle clients in handle-client."
(listen sock 15)
(let loop ()
(let ((client (accept sock)))
@ -183,13 +221,16 @@
(loop))))
(define (start-event-listener)
"Start the event listener socket."
(read-from-socket LISTENER-SOCKET))
(define (start-event-listener-thread)
"Start the event listener socket in a thread."
(set! LISTENER-THREAD (make-thread start-event-listener))
(thread-start! LISTENER-THREAD))
(define (start-commands-listener)
"Start the commands listener socket."
(when (file-exists? SOCKET-COMMANDS-LISTENER-PATH)
(delete-file SOCKET-COMMANDS-LISTENER-PATH))
@ -197,5 +238,6 @@
(start-server-socket COMMANDS-LISTENER-SOCKET))
(define (start-commands-listener-thread)
"Start the commands listener socket in a thread."
(set! COMMANDS-LISTENER-THREAD (make-thread start-commands-listener))
(thread-start! COMMANDS-LISTENER-THREAD))

4
swayipc/dispatcher.scm
View file

@ -273,9 +273,7 @@ Parameters:
Response:
An array of objects corresponding to each command that was parsed. Each
object has the property success."
(display "dispatching: ")
(display (string-join commands "\n"))
(newline)
(format #t "dispatching: ~a\n" (string-join commands "\n"))
(catch-all
(lambda ()

2
swayipc/events.scm
View file

@ -79,7 +79,7 @@
(define (custom-exception-handler exc command-id payload)
(display "An error occurred while receiving event data\n")
(display (string-append "command: " (number->string command-id) ", payload: " payload)))
(format #t "command: ~a, payload ~a\n" command-id payload))
(add-hook! data-received-hook
(lambda (command-id payload)

6
swayipc/info.scm
View file

@ -20,10 +20,8 @@
sway-get-seats))
(define (custom-exception-handler exc command-id payload)
(display "An error occurred: ")
(display (exp->string exc))
(newline)
(display (string-append "command: " (number->string command-id) ", payload: " payload)))
(format #t "An error occurred: ~a \n" (exp->string exc))
(format #t "command: ~a, payload: ~a\n" command-id payload))
(define (sway-send-query message-id payload)
"returns the ipc response from sway after sending the message-id and payload"