diff --git a/commander b/commander index 25d15dd..fda4fe4 100755 --- a/commander +++ b/commander @@ -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) " "))) diff --git a/init.scm b/init.scm index b1a7f82..6ed2610 100755 --- a/init.scm +++ b/init.scm @@ -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 diff --git a/keybindings.scm b/keybindings.scm index 82897a3..72dd242 100755 --- a/keybindings.scm +++ b/keybindings.scm @@ -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)) diff --git a/modules/general.scm b/modules/general.scm index fa9e0c8..a641799 100755 --- a/modules/general.scm +++ b/modules/general.scm @@ -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)))) diff --git a/modules/kbd.scm b/modules/kbd.scm index 83ca220..6a6ef24 100755 --- a/modules/kbd.scm +++ b/modules/kbd.scm @@ -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+") diff --git a/modules/workspace-grid.scm b/modules/workspace-grid.scm index 50eae03..54d07ed 100755 --- a/modules/workspace-grid.scm +++ b/modules/workspace-grid.scm @@ -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))) diff --git a/modules/workspace-groups.scm b/modules/workspace-groups.scm index 629dce2..df3855f 100755 --- a/modules/workspace-groups.scm +++ b/modules/workspace-groups.scm @@ -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)) diff --git a/swayipc/connection.scm b/swayipc/connection.scm index ae837db..9c225bc 100755 --- a/swayipc/connection.scm +++ b/swayipc/connection.scm @@ -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)) + ;; is i3-ipc, for compatibility with i3 ;; is a 32-bit integer in native byte order ;; 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 " (let* ((bv (make-bytevector (+ 14 (string-length 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 " (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)) diff --git a/swayipc/dispatcher.scm b/swayipc/dispatcher.scm index 1719e15..7306de4 100644 --- a/swayipc/dispatcher.scm +++ b/swayipc/dispatcher.scm @@ -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 () diff --git a/swayipc/events.scm b/swayipc/events.scm index b9a7e09..69cda18 100755 --- a/swayipc/events.scm +++ b/swayipc/events.scm @@ -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) diff --git a/swayipc/info.scm b/swayipc/info.scm index bc862d5..f56e9b0 100755 --- a/swayipc/info.scm +++ b/swayipc/info.scm @@ -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"