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.

diff --git a/lisp/image/wallpaper.el b/lisp/image/wallpaper.el
index bdaa148e2b612a4c892eafd2c544da1869613ddd..31cc2b4eece13d1f9e086fdb218b7b309c93dcb8 100644 (file)
--- 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'.")
 \f
 ;;; 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 80d512c98587b25aee44276eed3caa2bf2e4a718..c3feab0e20653d31a4407c6a5cf60dbbe43d02ca 100644 (file)
--- 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