From: Stefan Kangas Date: Wed, 14 Sep 2022 10:12:46 +0000 (+0200) Subject: Make it easier to customize wallpaper command X-Git-Tag: emacs-29.0.90~1856^2~525 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=8c3b40254bfa29c843eb4ff967c5e6f7c717bb07;p=emacs.git Make it easier to customize wallpaper command * 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 . --- diff --git a/etc/NEWS b/etc/NEWS index 7505a37c06d..5276a49d5cd 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -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. diff --git a/lisp/image/wallpaper.el b/lisp/image/wallpaper.el index 172164fdf91..e25ce448c10 100644 --- a/lisp/image/wallpaper.el +++ b/lisp/image/wallpaper.el @@ -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