[StumpWM] Dedicated threads for potentially blocking commands

Sometimes StumpWM hangs because of blocking commands. Instead of
making StumpWM completely hang, only its dedicated thread will.
This commit is contained in:
Lucien Cartier-Tilet 2022-05-15 00:39:15 +02:00
parent f92904cdb0
commit 143161387a
Signed by: phundrak
GPG Key ID: BD7789E705CB8DCA

View File

@ -262,7 +262,7 @@ brought to it. This is done like so:
#+begin_src lisp #+begin_src lisp
(defcommand firefox () () (defcommand firefox () ()
"Run or raise Firefox." "Run or raise Firefox."
(run-or-raise "firefox" '(:class "Firefox") t nil)) (sb-thread:make-thread (lambda () (run-or-raise "firefox" '(:class "Firefox") t nil))))
#+end_src #+end_src
Next, this command will not only close the current window, but it will Next, this command will not only close the current window, but it will
@ -293,9 +293,11 @@ a program.
#+begin_src lisp #+begin_src lisp
(defcommand term (&optional program) () (defcommand term (&optional program) ()
"Invoke a terminal, possibly with a @arg{program}." "Invoke a terminal, possibly with a @arg{program}."
(sb-thread:make-thread
(lambda ()
(run-shell-command (if program (run-shell-command (if program
(format nil "kitty ~A" program) (format nil "kitty ~A" program)
"kitty"))) "kitty")))))
#+end_src #+end_src
And done! Next! And done! Next!
@ -560,8 +562,10 @@ set this variable so we can sort of reload the mode-line.
#+begin_src lisp #+begin_src lisp
(defcommand reload-modeline () () (defcommand reload-modeline () ()
"Reload modeline." "Reload modeline."
(sb-thread:make-thread
(lambda ()
(setf *screen-mode-line-format* (setf *screen-mode-line-format*
(cdr (generate-modeline *mode-line-formatter-list*)))) (cdr (generate-modeline *mode-line-formatter-list*))))))
#+end_src #+end_src
And actually, lets reload the modeline immediately. And actually, lets reload the modeline immediately.
@ -1685,14 +1689,16 @@ we can easily define how to turn on bluetooth.
#+begin_src lisp #+begin_src lisp
(defcommand bluetooth-turn-on () () (defcommand bluetooth-turn-on () ()
"Turn on bluetooth." "Turn on bluetooth."
(bluetooth-message-command "power" "on")) (sb-thread:make-thread
(lambda () (bluetooth-message-command "power" "on"))))
#+end_src #+end_src
And how to power it off. And how to power it off.
#+begin_src lisp #+begin_src lisp
(defcommand bluetooth-turn-off () () (defcommand bluetooth-turn-off () ()
"Turn off bluetooth." "Turn off bluetooth."
(bluetooth-message-command "power" "off")) (sb-thread:make-thread
(lambda () (bluetooth-message-command "power" "off"))))
#+end_src #+end_src
*** Bluetooth Devices *** Bluetooth Devices
@ -1756,13 +1762,15 @@ collected bluetooth device and the user only has to select it. It will
then attempt to connect to it. then attempt to connect to it.
#+begin_src lisp #+begin_src lisp
(defcommand bluetooth-connect () () (defcommand bluetooth-connect () ()
(sb-thread:make-thread
(lambda ()
(let* ((devices (bluetooth-get-devices)) (let* ((devices (bluetooth-get-devices))
(choice (cdr (stumpwm:select-from-menu (choice (cdr (stumpwm:select-from-menu
(stumpwm:current-screen) (stumpwm:current-screen)
(mapcar (lambda (device) (mapcar (lambda (device)
`(,(bluetooth-device-full-name device) . ,device)) `(,(bluetooth-device-full-name device) . ,device))
devices))))) devices)))))
(bluetooth-connect-device choice))) (bluetooth-connect-device choice)))))
#+end_src #+end_src
*** Keybinds *** Keybinds
@ -1848,11 +1856,11 @@ run all the time, just when I need it.
#+begin_src lisp #+begin_src lisp
(stumpwm:defcommand sly-start-server () () (stumpwm:defcommand sly-start-server () ()
"Start a slynk server for sly." "Start a slynk server for sly."
(slynk:create-server :dont-close t)) (sb-thread:make-thread (lambda () (slynk:create-server :dont-close t))))
(stumpwm:defcommand sly-stop-server () () (stumpwm:defcommand sly-stop-server () ()
"Stop current slynk server for sly." "Stop current slynk server for sly."
(slynk:stop-server 4005)) (sb-thread:make-thread (lambda () (slynk:stop-server 4005))))
#+end_src #+end_src
** ~swm-ssh~ ** ~swm-ssh~