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

drop the commander and use sway binding event for keybidnings

Browse source
This commit is contained in:
Almarhoon Ibraheem 2024-06-22 19:49:34 +03:00
parent 11b12dbd9f
commit 8c04be22a9
8 changed files with 131 additions and 150 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
README.org
View file

@ -57,7 +57,6 @@ You can assign keybindings that execute Guile code! Obviously, running shell com
;; this uses sway-bindsym behind the scenes, but provides a much
;; user friendly interface to create complex keybindings structure
;; it also allows you to execute guile expressions on trigger.
;; requires configuring commander-path, refer to the FIXME note in keybindings.scm for more details.
;; refer to modules/general.scm for more about how this is done.
;; define leader keymap
@ -137,7 +136,6 @@ Clone this repository to your =~/.config/sway=
| init.scm | Main entry point for configuring Sway using Guile. |
| behavior.scm | Loaded by =init.scm=; modifies parameters and behavior of Sway. |
| keybindings.scm | Loaded by =init.scm=; adds custom keybindings to Sway. |
| commander | Guile script to send commands to =swayipc= (facilitates keybinding functionality). |
| config | Sway configuration file; typically used to invoke =init.scm=. |
| sjson | A patched version of =guile-json=; planned to be a separate dependency in the future (not embedded). |
|------------------------------+-----------------------------------------------------------------------------------------------------------|

37
commander
View file

@ -1,37 +0,0 @@
#!/usr/bin/guile \
-e main -s
!#
;; #!/usr/bin/guile --fresh-auto-compile
;; ensure that the swayipc module is available under the same directory as the init file
;; otherwise, the module should be referenced from packaging system or via custom load path
(add-to-load-path
(dirname (or (current-filename)
(string-append (getenv "HOME") "/.config/sway/init.scm"))))
(use-modules (swayipc connection)
(ice-9 popen)
(sjson builder)
(ice-9 binary-ports)
(rnrs bytevectors)
(rnrs io ports)
(oop goops)
(srfi srfi-18)
(srfi srfi-9)
(srfi srfi-1))
(define COMMANDS-CLIENT-SOCKET (socket AF_UNIX SOCK_STREAM 0))
(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)
(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)
(send-command (string-join (cdr args) " ")))

7
init.scm
View file

@ -9,6 +9,7 @@
(srfi srfi-18)
(modules workspace-groups)
(modules workspace-grid)
(modules auto-reload)
(swayipc connection)
(swayipc records)
(swayipc info)
@ -46,9 +47,11 @@
(workspace-grid-configure #:rows ROWS #:columns COLUMNS #:workspaces WORKSPACES)
(workspace-grid-init)
(auto-reload-configure #:directories
`(,(string-append (getenv "HOME") "/.config/sway/")))
(auto-reload-init)
;; TODO: load which key module
(start-commands-listener-thread)
(start-event-listener-thread)
(thread-join! LISTENER-THREAD)
(thread-join! COMMANDS-LISTENER-THREAD)

50
keybindings.scm
View file

@ -1,5 +1,7 @@
(use-modules (modules kbd)
(modules general)
(swayipc info)
(swayipc records)
(ice-9 popen)
(srfi srfi-18)
(ice-9 textual-ports))
@ -14,16 +16,19 @@
like key chords. The default implementation doesn't modify passed keybindings"
(kbd key))
;; get focused workspace from a list of workspaces
(define* (focused-output-name #:optional (workspaces (sway-get-workspaces)))
(cond
((null? workspaces) #f)
((equal? #t (sway-workspace-focused (car workspaces)))
(sway-workspace-output (car workspaces)))
(else (focused-output-name (cdr workspaces)))))
(define (keybindings-init)
(kbd-init)
(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)
(general-configure #:keybinding-translator custom-sway-keybinding-translator)
(general-init)
;; define root keybindings
(general-define-keys
@ -98,19 +103,34 @@
("S" (exec "~/.config/rofi/bin/sound-output")))
;; screenshot keymap
;; flameshot is not performing well under wayland & multiple monitors
;; `(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"))
;; (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"))
;; ("f" (exec "export XDG_CURRENT_DESKTOP=sway && flameshot full -d 2500"))
;; ("l" (exec "export XDG_CURRENT_DESKTOP=sway && flameshot gui -d 2500 --last-region"))))
`(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"))
("g" (exec "slurp | grim -g - - | wl-copy"))
("s" (exec (string-append "grim -o \"" (focused-output-name) "\" - | wl-copy")))
("f" (exec "grim - | wl-copy"))
("m" (exec "grim -g - - | wl-copy"))
(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"))
("f" (exec "export XDG_CURRENT_DESKTOP=sway && flameshot full -d 2500"))
("l" (exec "export XDG_CURRENT_DESKTOP=sway && flameshot gui -d 2500 --last-region"))))
("g" (exec "sleep 2 && slurp | grim -g - - | wl-copy"))
("s" (exec (string-append "sleep 2 && grim -o \"" (focused-output-name) "\" - | wl-copy")))
("f" (exec "sleep 2 && grim - | wl-copy"))
("m" (exec "sleep 2 && grim -g - - | wl-copy"))))
;; session keymap
`(general-define-keys

113
modules/general.scm
View file

@ -1,16 +1,23 @@
(define-module (modules general)
#:use-module (sjson parser)
#:use-module (swayipc dispatcher)
#:use-module (swayipc connection)
#:use-module (swayipc events)
#:use-module (swayipc records)
#:use-module (srfi srfi-18)
#:use-module (ice-9 hash-table)
#:use-module (ice-9 string-fun)
#:export (general-keybinding-translator
general-commander-path
general-configure
general-init
general-define-keys
general-define-key
general-keybindings
general-submaps))
general-submaps
command-received-hook))
(define general-command-prefix "echo /general ")
(define general-command-signature
(string-append "exec " general-command-prefix))
;; Local copy of keybindings configured by general, it's recommended to
;; only use general to assign keybindings, otherwise this hashtable won't
@ -25,29 +32,51 @@
;; add default submap, this is the default submap in sway
(hash-set! general-submaps "" "default")
;; data received: emitted on new command received via bindings.
;; Parameters:
;; - arg1: commandd.
(define command-received-hook
(make-hook 1))
(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)
;; The path of commander executable, it's used to send back scheme expressions
;; via unix socket.
(define general-commander-path
(if current-filename
(string-append (dirname (dirname current-filename)) "/commander")
"commander"))
(define* (general-configure #:key keybinding-translator commander-path)
"Configure keybinding-translator (refer to general-keybinding-translator) and
commander-path (refer to 'general-commander-path).
(define* (general-configure #:key keybinding-translator)
"Configure keybinding-translator (refer to general-keybinding-translator)
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."
- keybinding-translator: a function that takes a key and returns the translated version."
(when keybinding-translator
(set! general-keybinding-translator keybinding-translator))
(when commander-path
(set! general-commander-path commander-path)))
(set! general-keybinding-translator keybinding-translator)))
(define (binding-changed binding-event)
(let* ((command (sway-binding-event-binding-command
(sway-binding-event-binding binding-event)))
(prefix (if (> (string-length command)
(string-length general-command-signature))
(substring command 0 (string-length general-command-signature))
""))
(general-command (equal? prefix general-command-signature)))
(when general-command
(run-hook command-received-hook
(hex->string
(substring command (string-length general-command-signature)))))))
(define (general-init)
;; add sway bindings event hook
(add-hook! sway-binding-hook binding-changed)
;; add a hook to listen to received commands
(add-hook! command-received-hook
(lambda (command)
(format #t "executing command ~a\n" command)
(with-exception-handler
(lambda (exc)
(custom-exception-handler exc command))
(lambda () (eval-string command))
#:unwind? #t))))
(define (exp->string exp)
"Convert a given expression exp to a string."
@ -69,7 +98,7 @@ Parameters:
(format #t "define submap ~a\n" chord)
(hash-set! general-submaps chord submap)
(define-keybindings chord
`(sway-mode ,submap)
(list `sway-mode submap)
wk parent-submap)
(define-keybindings (string-append chord " Esc")
`(sway-mode "default")
@ -81,8 +110,8 @@ Parameters:
(define (general-command exp-str)
"Execute a general command (scheme expression)"
(string-append "exec '" general-commander-path " "
(exp->string exp-str) "'"))
(string-append general-command-signature
(string->hex exp-str)))
(define* (define-keybindings chord exp wk submap)
"Define a sway keybinding.
@ -91,6 +120,7 @@ Parameters:
- exp: expression to execute when the chord is triggered.
- wk: which-key's description.
- submap: the name of the submap."
(format #t "define-keybindings ~a with expression `~a`\n" chord exp)
(let* ((chord-ls (map general-keybinding-translator
(string-split chord #\Space)))
(key (car (last-pair chord-ls)))
@ -182,16 +212,39 @@ For example:
args))
(define (custom-exception-handler exc command-id payload)
"Exception handler for evaluating expressions from commander."
"Exception handler for evaluating expressions."
(format #t "An error occurd while executing the received
general command: command: ~a, payload: ~a\n" command-id payload)
(format #t "exception: ~a\n" exc))
;; add a hook to listen to received commands (usually from commander)
(add-hook! command-received-hook
(lambda (command-id payload)
(with-exception-handler
(lambda (exc)
(custom-exception-handler exc command-id payload))
(lambda () (eval-string (json-string->scm payload)))
#:unwind? #t)))
;; FIXME: there must be some guile built-in function to
;; base64 encode or convert to hex
(define (char->hex char)
"Convert a character to hex."
(let ((hex (number->string (char->integer char) 16)))
(if (< (string-length hex) 2)
(string-append "0" hex)
hex)))
(define (hex->char hex-pair)
"Convert a hex to character."
(integer->char (string->number hex-pair 16)))
(define (string->hex str)
"Convert a string to hex."
(let loop ((chars (string->list str))
(result '()))
(if (null? chars)
(string-concatenate (reverse result))
(loop (cdr chars) (cons (char->hex (car chars)) result)))))
(define (hex->string hex-str)
"Convert a hex to string."
(let loop ((chars (string->list hex-str))
(result '()))
(if (null? chars)
(list->string (reverse result))
(let ((char1 (car chars))
(char2 (cadr chars)))
(loop (cddr chars)
(cons (hex->char (string char1 char2)) result))))))

65
swayipc/connection.scm
View file

@ -45,14 +45,6 @@
start-event-listener-thread
start-event-listener
data-received-hook
command-received-hook
SOCKET-COMMANDS-LISTENER-PATH
COMMANDS-LISTENER-SOCKET
COMMANDS-LISTENER-THREAD
start-commands-listener-thread
start-commands-listener
write-msg
read-msg
encode-msg))
@ -103,19 +95,15 @@
(define SOCKET-COMMANDS-LISTENER-PATH
(string-append (dirname SOCKET-PATH) "/sway-commands-ipc.sock"))
;; 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 listen socket, this is used to listen to subscribed events
;; from sway via IPC.
(define LISTENER-SOCKET (socket AF_UNIX SOCK_STREAM 0))
(connect LISTENER-SOCKET (make-socket-address AF_UNIX SOCKET-PATH))
;; 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.
@ -178,13 +166,6 @@ Note: read format is <magic-string> <payload-length> <payload-type> <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."
@ -195,31 +176,6 @@ Once a message is recieved, the data-received-hook will be triggered."
(list-ref data 1))
(loop))))
(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
(list-ref data 0)
(list-ref data 1)))
;; Close the connection
(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)))
(handle-client client)
(loop))))
(define (start-event-listener)
"Start the event listener socket."
(read-from-socket LISTENER-SOCKET))
@ -228,16 +184,3 @@ This will listne to incoming connections and handle clients in handle-client."
"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))
(bind COMMANDS-LISTENER-SOCKET (make-socket-address AF_UNIX SOCKET-COMMANDS-LISTENER-PATH))
(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))

3
swayipc/events.scm
View file

@ -20,6 +20,7 @@
sway-output-hook
sway-mode-hook
sway-window-hook
sway-binding-hook
sway-bar-config-hook
sway-shutdown-hook
sway-tick-hook
@ -79,7 +80,7 @@
(define (custom-exception-handler exc command-id payload)
(display "An error occurred while receiving event data\n")
(format #t "command: ~a, payload ~a\n" command-id payload))
(format #t "~a\ncommand: ~a, payload ~a\n" exc command-id payload))
(add-hook! data-received-hook
(lambda (command-id payload)

4
swayipc/info.scm
View file

@ -20,14 +20,14 @@
sway-get-seats))
(define (custom-exception-handler exc command-id payload)
(format #t "An error occurred: ~a \n" (exp->string exc))
(format #t "An error occurred: ~a \n" 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"
(with-exception-handler
(lambda (exc)
(custom-exception-handler exc command-id payload))
(custom-exception-handler exc message-id payload))
(lambda () (begin
(write-msg COMMAND-SOCKET
message-id