From b0289e7f6ddebdd2bdefa63e2b4afcb29733b3b7 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Mon, 26 Sep 2022 14:38:25 +0200 Subject: [PATCH] Fix setting the wallpaper in XFCE * lisp/image/wallpaper.el (wallpaper-command-args) (wallpaper-default-set-function): Support new format specifiers %S for screen, %W for workspace, and %M for monitor. (wallpaper--default-setters): Use above new specifiers for XFCE. (wallpaper--format-arg): New defun broken out from... (wallpaper-default-set-function): ...here. (wallpaper--get-height-or-width): Support noninteractive use. * test/lisp/image/wallpaper-tests.el (wallpaper--format-arg/filename) (wallpaper--format-arg/filename-hex) (wallpaper--format-arg/width, wallpaper--format-arg/screen) (wallpaper--format-arg/monitor, wallpaper--format-arg/workspace): New tests. --- lisp/image/wallpaper.el | 96 ++++++++++++++++++++---------- test/lisp/image/wallpaper-tests.el | 29 +++++++++ 2 files changed, 94 insertions(+), 31 deletions(-) diff --git a/lisp/image/wallpaper.el b/lisp/image/wallpaper.el index bdaa148e2b6..31cc2b4eece 100644 --- a/lisp/image/wallpaper.el +++ b/lisp/image/wallpaper.el @@ -153,7 +153,7 @@ and returns non-nil if this setter should be used." ("XFCE" "xfconf-query" '("-c" "xfce4-desktop" - "-p" "/backdrop/screen0/monitoreDP/workspace0/last-image" + "-p" "/backdrop/screen%S/monitor%M/workspace%W/last-image" "-s" "%f") :predicate (lambda () (or (and (getenv "DESKTOP_SESSION") @@ -320,15 +320,20 @@ automatically, so there is usually no need to customize this. However, if you do need to change this, you might also want to customize `wallpaper-command' to match. -In each of the command line arguments, \"%f\" will be replaced -with the full file name, \"%F\" with the full file name -URI-encoded, \"%h\" with the height of the selected frame's -display (as returned by `display-pixel-height'), and \"%w\" with -the width of the selected frame's display (as returned by -`display-pixel-width'). +In each command line argument, these specifiers will be replaced: -If `wallpaper-set' is run from a TTY frame, it will prompt for a -height and width for \"%h\" and \"%w\" instead. + %f full file name + %h height of the selected frame's display (as returned + by `display-pixel-height') + %w the width of the selected frame's display (as returned + by `display-pixel-width'). + %F full file name URI-encoded + %S current X screen (e.g. \"0\") + %W current workspace (e.g., \"0\") + %M name of the monitor (e.g., \"0\" or \"LVDS\") + +If `wallpaper-set' is run from a TTY frame, instead prompt for a +height and width to use for %h and %w. The value of this variable is ignored on MS-Windows and Haiku systems, where a native API is used instead." @@ -350,9 +355,9 @@ This is only used when it can't be detected automatically. See also `wallpaper-default-width'.") (defun wallpaper--get-height-or-width (desc fun default) - (if (display-graphic-p) - (funcall fun) - (read-number (format "Wallpaper %s in pixels: " desc) default))) + (cond ((display-graphic-p) (funcall fun)) + (noninteractive default) + ((read-number (format "Wallpaper %s in pixels: " desc) default)))) (autoload 'ffap-file-at-point "ffap") @@ -373,41 +378,70 @@ See also `wallpaper-default-width'.") ;;; wallpaper-set +(defun wallpaper--format-arg (format file) + "Format a `wallpaper-command-args' argument ARG. +FILE is the image file name." + (format-spec + format + `((?f . ,(expand-file-name file)) + (?F . ,(mapconcat #'url-hexify-string + (file-name-split file) + "/")) + (?h . ,(wallpaper--get-height-or-width + "height" + #'display-pixel-height + wallpaper-default-height)) + (?w . ,(wallpaper--get-height-or-width + "width" + #'display-pixel-width + wallpaper-default-width)) + ;; screen number + (?S . ,(let ((display (frame-parameter (selected-frame) 'display))) + (if (and display + (string-match (rx ":" (+ (in "0-9")) "." + (group (+ (in "0-9"))) eos) + display)) + (match-string 1 display) + "0"))) + ;; monitor name + (?M . ,(let* ((attrs (car (display-monitor-attributes-list))) + (source (cdr (assq 'source attrs))) + (monitor (cdr (assq 'name attrs)))) + (if (and monitor (member source '("XRandr" "XRandr 1.5" "Gdk"))) + monitor + "0"))) + ;; workspace + (?W . ,(or (and (fboundp 'x-window-property) + (display-graphic-p) + (number-to-string + (or (x-window-property "_NET_CURRENT_DESKTOP" nil "CARDINAL" 0 nil t) + (x-window-property "WIN_WORKSPACE" nil "CARDINAL" 0 nil t)))) + "0"))))) + (defun wallpaper-default-set-function (file) "Set the wallpaper to FILE using a command. This is the default function for `wallpaper-set-function'." (unless wallpaper-command (error "Couldn't find a command to set the wallpaper with")) - (let* ((fmt-spec `((?f . ,(expand-file-name file)) - (?F . ,(mapconcat #'url-hexify-string - (file-name-split file) - "/")) - (?h . ,(wallpaper--get-height-or-width - "height" - #'display-pixel-height - wallpaper-default-height)) - (?w . ,(wallpaper--get-height-or-width - "width" - #'display-pixel-width - wallpaper-default-width)))) + (let* ((real-args (mapcar (lambda (arg) (wallpaper--format-arg arg file)) + wallpaper-command-args)) (bufname (format " *wallpaper-%s*" (random))) (process (and wallpaper-command (apply #'start-process "set-wallpaper" bufname - wallpaper-command - (mapcar (lambda (arg) (format-spec arg fmt-spec)) - wallpaper-command-args))))) + wallpaper-command real-args)))) (unless wallpaper-command (error "Couldn't find a suitable command for setting the wallpaper")) - (wallpaper-debug - "Using command %S %S" wallpaper-command - wallpaper-command-args) + (wallpaper-debug "Using command: \"%s %s\"" + wallpaper-command (string-join wallpaper-command-args " ")) + (wallpaper-debug (wallpaper--format-arg + "f=%f w=%w h=%h S=%S M=%M W=%W" file)) (setf (process-sentinel process) (lambda (process status) (unwind-protect (unless (and (eq (process-status process) 'exit) (zerop (process-exit-status process))) - (message "command %S %s: %S" + (message "command \"%s %s\": %S" (string-join (process-command process) " ") (string-replace "\n" "" status) (with-current-buffer (process-buffer process) diff --git a/test/lisp/image/wallpaper-tests.el b/test/lisp/image/wallpaper-tests.el index 80d512c9858..c3feab0e206 100644 --- a/test/lisp/image/wallpaper-tests.el +++ b/test/lisp/image/wallpaper-tests.el @@ -54,4 +54,33 @@ (insert fil) (should (stringp (wallpaper--get-default-file)))))) +(ert-deftest wallpaper--format-arg/filename () + (should (file-name-absolute-p (wallpaper--format-arg "%f" "foo.jpg")))) + +(ert-deftest wallpaper--format-arg/filename-hex () + (should (equal (wallpaper--format-arg "%F" "foo bar åäö.jpg") + "foo%20bar%20%C3%A5%C3%A4%C3%B6.jpg"))) + +(ert-deftest wallpaper--format-arg/width () + (skip-unless noninteractive) + (should (equal (wallpaper--format-arg "%w" "foo.jpg") + (number-to-string wallpaper-default-width)))) + +(ert-deftest wallpaper--format-arg/height () + (skip-unless noninteractive) + (should (equal (wallpaper--format-arg "%h" "foo.jpg") + (number-to-string wallpaper-default-height)))) + +(ert-deftest wallpaper--format-arg/screen () + (skip-unless noninteractive) + (should (equal (wallpaper--format-arg "%S" "foo.jpg") "0"))) + +(ert-deftest wallpaper--format-arg/monitor () + (skip-unless noninteractive) + (should (equal (wallpaper--format-arg "%M" "foo.jpg") "0"))) + +(ert-deftest wallpaper--format-arg/workspace () + (skip-unless noninteractive) + (should (equal (wallpaper--format-arg "%W" "foo.jpg") "0"))) + ;;; wallpaper-tests.el ends here -- 2.39.2