;; desktop background.
;;
;; On GNU/Linux and other Unix-like systems, it uses an external
-;; command to set the desktop background.
+;; command to set the desktop background. This should work seamlessly
+;; on both X and Wayland.
;;
;; Finding an external command to use is obviously a bit tricky to get
;; right, as there is no lack of platforms, window managers, desktop
(args (if (or (listp args-raw) (symbolp args-raw))
args-raw
(string-split args-raw)))
- (predicate (plist-get rest-plist :predicate))))
+ (predicate (plist-get rest-plist :predicate))
+ (init-action (plist-get rest-plist :init-action))
+ (detach (plist-get rest-plist :detach))))
(:copier wallpaper-setter-copy))
- "Structure containing a command to set the wallpaper.
+ "Structure containing a method to set the wallpaper.
NAME is a description of the setter (e.g. the name of the Desktop
Environment).
ARGS is the default list of command line arguments for COMMAND.
PREDICATE is a function that will be called without any arguments
-and returns non-nil if this setter should be used."
+and returns non-nil if this setter should be used.
+
+INIT-ACTION is a function that will be called without any
+arguments before trying to set the wallpaper.
+
+DETACH, if non-nil, means that the wallpaper process should
+continue running even after exiting Emacs."
name
command
args
- (predicate #'always))
+ (predicate #'always)
+ init-action
+ detach)
;;;###autoload
(put 'wallpaper-setter-create 'lisp-indent-function 1)
+(defun wallpaper--init-action-kill (process-name)
+ "Return kill function for `init-action' of a `wallpaper-setter' structure.
+The returned function kills any process named PROCESS-NAME owned
+by the current effective user id."
+ (lambda ()
+ (when-let ((procs
+ (seq-filter (lambda (p) (let-alist p
+ (and (= .euid (user-uid))
+ (equal .comm process-name))))
+ (mapcar (lambda (pid)
+ (cons (cons 'pid pid)
+ (process-attributes pid)))
+ (list-system-processes)))))
+ (dolist (proc procs)
+ (let-alist proc
+ (when (y-or-n-p (format "Kill \"%s\" process with PID %d?" .comm .pid))
+ (signal-process .pid 'TERM)))))))
+
(defmacro wallpaper--default-methods-create (&rest items)
"Helper macro for defining `wallpaper--default-setters'."
(cons 'list
"swaybg" "-o * -i %f -m fill"
:predicate (lambda ()
(and (getenv "WAYLAND_DISPLAY")
- (getenv "SWAYSOCK"))))
+ (getenv "SWAYSOCK")))
+ :init-action (wallpaper--init-action-kill "swaybg")
+ :detach t)
("wbg"
"wbg" "%f"
:predicate (lambda ()
- (getenv "WAYLAND_DISPLAY")))
+ (getenv "WAYLAND_DISPLAY"))
+ :init-action (wallpaper--init-action-kill "wbg")
+ :detach t)
;; X general.
("GraphicsMagick"
(defun wallpaper--find-setter ()
(when (wallpaper--use-default-set-function-p)
- (or wallpaper--current-setter
+ (or (and (wallpaper-setter-p wallpaper--current-setter)
+ wallpaper--current-setter)
(setq wallpaper--current-setter
(catch 'found
(dolist (setter wallpaper--default-setters)
(real-args (mapcar (lambda (arg) (wallpaper--format-arg arg file))
args))
(bufname (format " *wallpaper-%s*" (random)))
- (process
- (and wallpaper-command
- (apply #'start-process "set-wallpaper" bufname
- wallpaper-command real-args))))
- (unless wallpaper-command
- (error "Couldn't find a suitable command for setting the wallpaper"))
+ (setter (and (wallpaper-setter-p wallpaper--current-setter)
+ (equal (wallpaper-setter-command wallpaper--current-setter)
+ wallpaper-command)
+ wallpaper--current-setter))
+ (init-action (and setter (wallpaper-setter-init-action setter)))
+ (detach (and setter (wallpaper-setter-detach setter)))
+ process)
+ (when init-action
+ (funcall init-action))
(wallpaper-debug "Using command: \"%s %s\""
- wallpaper-command (string-join real-args " "))
- (setf (process-sentinel process)
- (lambda (process status)
- (unwind-protect
- (if (and (eq (process-status process) 'exit)
- (zerop (process-exit-status process)))
- (message "Desktop wallpaper changed to %s"
- (abbreviate-file-name file))
- (message "command \"%s %s\": %S"
- (string-join (process-command process) " ")
- (string-replace "\n" "" status)
- (with-current-buffer (process-buffer process)
- (string-clean-whitespace (buffer-string)))))
- (ignore-errors
- (kill-buffer (process-buffer process))))))
+ wallpaper-command (string-join real-args " "))
+ (if detach
+ (apply #'call-process wallpaper-command nil 0 nil real-args)
+ (setq process
+ (apply #'start-process "set-wallpaper" bufname
+ wallpaper-command real-args))
+ (setf (process-sentinel process)
+ (lambda (process status)
+ (unwind-protect
+ (if (and (eq (process-status process) 'exit)
+ (zerop (process-exit-status process)))
+ (message "Desktop wallpaper changed to %s"
+ (abbreviate-file-name file))
+ (message "command \"%s %s\": %S"
+ (string-join (process-command process) " ")
+ (string-replace "\n" "" status)
+ (with-current-buffer (process-buffer process)
+ (string-clean-whitespace (buffer-string)))))
+ (ignore-errors
+ (kill-buffer (process-buffer process)))))))
process))
;;;###autoload
(require 'ert-x)
(require 'wallpaper)
+(ert-deftest wallpaper--find-setter ()
+ (skip-unless (executable-find "touch"))
+ (let (wallpaper--current-setter
+ (wallpaper--default-setters
+ (wallpaper--default-methods-create
+ ("touch" "touch" "/tmp/touched"))))
+ (should (wallpaper--find-setter))))
+
+(ert-deftest wallpaper--find-setter/call-predicate ()
+ (skip-unless (executable-find "touch"))
+ (let* ( wallpaper--current-setter called
+ (wallpaper--default-setters
+ (wallpaper--default-methods-create
+ ("touch" "touch" "/tmp/touched"
+ :predicate (lambda () (setq called t))))))
+ (should-not called)
+ (wallpaper--find-setter)
+ (should called)))
+
+(ert-deftest wallpaper--find-setter/set-current-setter ()
+ (skip-unless (executable-find "touch"))
+ (let (wallpaper--current-setter
+ (wallpaper--default-setters
+ (wallpaper--default-methods-create
+ ("touch" "touch" "/tmp/touched"))))
+ (wallpaper--find-setter)
+ (should wallpaper--current-setter)))
+
+(ert-deftest wallpaper-set/runs-command ()
+ (skip-unless (executable-find "touch"))
+ (ert-with-temp-file fil-jpg
+ :suffix ".jpg"
+ (ert-with-temp-file fil
+ (let* ( wallpaper--current-setter
+ (wallpaper--default-setters
+ (wallpaper--default-methods-create
+ ("touch" "touch" fil)))
+ (wallpaper-command (wallpaper--find-command))
+ (wallpaper-command-args (wallpaper--find-command-args)))
+ (delete-file fil)
+ (let ((process (wallpaper-set fil-jpg)))
+ (while (process-live-p process)
+ (sit-for 0.001))
+ ;; Touch has recreated the file:
+ (should (file-exists-p fil)))))))
+
+(ert-deftest wallpaper-set/runs-command/detach ()
+ (skip-unless (executable-find "touch"))
+ (ert-with-temp-file fil-jpg
+ :suffix ".jpg"
+ (ert-with-temp-file fil
+ (let* ( wallpaper--current-setter
+ (wallpaper--default-setters
+ (wallpaper--default-methods-create
+ ("touch" "touch" fil
+ :detach t)))
+ (wallpaper-command (wallpaper--find-command))
+ (wallpaper-command-args (wallpaper--find-command-args)))
+ (delete-file fil)
+ (wallpaper-set fil-jpg)
+ (while (not (file-exists-p fil))
+ (sit-for 0.001))
+ ;; Touch has recreated the file:
+ (should (file-exists-p fil))))))
+
+(ert-deftest wallpaper-set/calls-init-action ()
+ (skip-unless (executable-find "touch"))
+ (ert-with-temp-file fil-jpg
+ :suffix ".jpg"
+ (ert-with-temp-file fil
+ (let* ( wallpaper--current-setter called
+ (wallpaper--default-setters
+ (wallpaper--default-methods-create
+ ("touch" "touch" fil
+ :init-action (lambda () (setq called t)))))
+ (wallpaper-command (wallpaper--find-command))
+ (wallpaper-command-args (wallpaper--find-command-args)))
+ (should (functionp (wallpaper-setter-init-action wallpaper--current-setter)))
+ (wallpaper-set fil-jpg)
+ (should called)))))
+
+(ert-deftest wallpaper-set/calls-wallpaper-set-function ()
+ (skip-unless (executable-find "touch"))
+ (ert-with-temp-file fil-jpg
+ :suffix ".jpg"
+ (let* ( wallpaper--current-setter called
+ (wallpaper--default-setters
+ (wallpaper--default-methods-create
+ ("touch" "touch" "foo")))
+ (wallpaper-set-function
+ (lambda (file) (setq called file))))
+ (wallpaper--find-setter)
+ (wallpaper-set fil-jpg)
+ (should (equal called fil-jpg)))))
+
(ert-deftest wallpaper--find-command/return-string ()
(should (or (not (wallpaper--find-command))
(stringp (wallpaper--find-command)))))