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.
This commit is contained in:
Stefan Kangas 2022-09-26 14:38:25 +02:00
parent 35d5ad713e
commit b0289e7f6d
2 changed files with 94 additions and 31 deletions

View file

@ -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)

View file

@ -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