procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Make it easier to customize wallpaper command

Browse source 
* lisp/image/wallpaper.el
(wallpaper--default-commands): New defvar.
(wallpaper--find-command): Use above new defvar.
(wallpaper--find-command-arguments): New defun.
(wallpaper-command): Rename from 'wallpaper-commands' and change
type to string.  Use 'wallpaper--find-command' to set it.
(wallpaper-command-args): New defcustom.  Use
'wallpaper--find-command-arguments' to set it.
(wallpaper--set-wallpaper-command): New defun.  Use as :set property
for 'wallpaper-command'.
(wallpaper-set): Use above new defcustoms to set the wallpaper.
Suggested by Eli Zaretskii <eliz@gnu.org>.
This commit is contained in:
Stefan Kangas 2022-09-14 12:12:46 +02:00
parent 41a3155319
commit 8c3b40254b
2 changed files with 93 additions and 42 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
etc/NEWS
View file

@ -1997,7 +1997,8 @@ desktop background.
On GNU/Linux and other Unix-like systems, it uses an external command
(such as "swaybg", "gm", "display" or "xloadimage"). A suitable
command should be detected automatically in most cases, but can also
be customized manually with the new user option `wallpaper-commands'.
be customized manually with the new user options 'wallpaper-command'
and 'wallpaper-command-args' if needed.
On Haiku, it uses the new function `haiku-set-wallpaper', which does
not rely on any external command.

132
lisp/image/wallpaper.el
View file

@ -35,14 +35,18 @@
;; right, as there is no lack of platforms, window managers, desktop
;; environments and tools. However, it should be detected
;; automatically in most cases. If it doesn't work in your
;; environment, customize the user option `wallpaper-commands'.
;; environment, customize the user options `wallpaper-command' and
;; `wallpaper-command-args'.
;;; Code:
(eval-when-compile (require 'subr-x))
(require 'xdg)
(defcustom wallpaper-commands
;;; Finding the wallpaper command
(defvar wallpaper--default-commands
'(
;; Sway (Wayland)
("swaybg" "-o" "*" "-i" "%f" "-m" "fill")
@ -60,9 +64,11 @@
("xloadimage" "-onroot" "-fullscreen" "%f")
("xsetbg" " %f")
)
"List of executables and arguments for setting the wallpaper.
This is used by `wallpaper-set', which will test the commands
in the order they appear.
"Executable used for setting the wallpaper.
This is used by `wallpaper--find-command' to automatically set
`wallpaper-command', and by `wallpaper--find-command-args' to set
`wallpaper-command-args'. The commands will be tested in the
order in which they appear.
Every item in the list has the following form:
@ -71,29 +77,8 @@ Every item in the list has the following form:
COMMAND is the name of the executable (a string) and ARG1 .. ARGN
is its command line arguments (also strings).
In each of the command line arguments, \"%f\" will be replaced
with the full file name, \"%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').
Note: If you find that you need to use a command that is not in
this list to set the wallpaper in your environment, we would love
to hear about it! Please send an email to bug-gnu-emacs@gnu.org
and tell us the command (and all options) that worked for you.
You can also use \\[report-emacs-bug]."
:type '(repeat (repeat string))
:group 'image
:version "29.1")
(defvar wallpaper-debug nil
"If non-nil, display debug messages.")
(defun wallpaper-debug (&rest args)
(when wallpaper-debug
(apply #'message
(concat "wallpaper-debug: " (car args))
(cdr args))))
In each of the command line arguments, \"%f\", \"%h\" and \"%w\"
will be replaced as described in `wallpaper-command-args'.")
(cl-defmethod wallpaper--check-command ((_type (eql 'gsettings)))
(member "GNOME" (xdg-current-desktop)))
@ -112,12 +97,77 @@ You can also use \\[report-emacs-bug]."
t)
(defun wallpaper--find-command ()
"Return a valid command for this system."
"Return a valid command to set the wallpaper in this environment."
(catch 'found
(dolist (cmd wallpaper-commands)
(dolist (cmd wallpaper--default-commands)
(if (and (wallpaper--check-command (intern (car cmd)))
(executable-find (car cmd)))
(throw 'found cmd)))))
(throw 'found (car cmd))))))
(defvar wallpaper-command) ; silence byte-compiler
(defun wallpaper--find-command-arguments ()
"Return command line arguments matching `wallpaper-command'."
(cdr (assoc wallpaper-command wallpaper--default-commands)))
;;; Customizable variables
(defvar wallpaper-command-args) ; silence byte-compiler
(defun wallpaper--set-wallpaper-command (sym val)
"Set `wallpaper-command', and update `wallpaper-command-args'."
;; Note: `command-args' is used by `wallpaper--find-command-arguments'.
(prog1 (set-default sym val)
(set-default 'wallpaper-command-args
(wallpaper--find-command-arguments))))
(defcustom wallpaper-command (wallpaper--find-command)
"Executable used for setting the wallpaper.
A suitable command for your environment should be detected
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-args' to match.
Note: If you find that you need to use a command in your
environment that is not automatically detected, we would love to
hear about it! Please send an email to bug-gnu-emacs@gnu.org and
tell us the command (and all options) that worked for you. You
can also use \\[report-emacs-bug]."
:type '(choice string
(const :tag "Not set" nil))
:set #'wallpaper--set-wallpaper-command
:group 'image
:version "29.1")
(defcustom wallpaper-command-args (wallpaper--find-command-arguments)
"Command line arguments for `wallpaper-command'.
A suitable command for your environment should be detected
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, \"%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')."
:type '(repeat string)
:group 'image
:version "29.1")
;;; Utility functions
(defvar wallpaper-debug nil
"If non-nil, display debug messages.")
(defun wallpaper-debug (&rest args)
(when wallpaper-debug
(apply #'message
(concat "wallpaper-debug: " (car args))
(cdr args))))
;;; wallpaper-set
(defvar wallpaper-default-width 1080
"Default width used by `wallpaper-set'.
@ -129,13 +179,13 @@ See also `wallpaper-default-height'.")
This is only used when it can't be detected automatically.
See also `wallpaper-default-width'.")
(declare-function haiku-set-wallpaper "term/haiku-win.el")
(defun wallpaper--get-height-or-width (desc fun default)
(if (display-graphic-p)
(funcall fun)
(read-number (format "Wallpaper %s in pixels: " desc) default)))
(declare-function haiku-set-wallpaper "term/haiku-win.el")
(defun wallpaper-set (file)
"Set the desktop background to FILE in a graphical environment.
@ -161,8 +211,7 @@ On Haiku, no external command is needed, so the value of
(cond ((featurep 'haiku)
(haiku-set-wallpaper file))
(t
(let* ((command (wallpaper--find-command))
(fmt-spec `((?f . ,(expand-file-name file))
(let* ((fmt-spec `((?f . ,(expand-file-name file))
(?h . ,(wallpaper--get-height-or-width
"height"
#'display-pixel-height
@ -173,14 +222,15 @@ On Haiku, no external command is needed, so the value of
wallpaper-default-width))))
(bufname (format " *wallpaper-%s*" (random)))
(process
(and command
(and wallpaper-command
(apply #'start-process "set-wallpaper" bufname
(car command)
wallpaper-command
(mapcar (lambda (arg) (format-spec arg fmt-spec))
(cdr command))))))
(unless command
(error "Can't find a suitable command for setting the wallpaper"))
(wallpaper-debug "Using command %s" (car command))
wallpaper-command-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)
(setf (process-sentinel process)
(lambda (process status)
(unwind-protect