;; disable the option "Change picture" in the "Desktop & Screensaver"
;; preferences for this to work (this was seen with macOS 10.13).
;; You might also have to tweak some permissions.
+;;
+;; Note: If you find that you need to use a command in your
+;; environment that was 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 `M-x report-emacs-bug'.
;;; Code:
(eval-when-compile (require 'subr-x))
(require 'xdg)
+(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))))
+
(defvar wallpaper-set-function
(cond ((fboundp 'w32-set-wallpaper)
#'w32-set-wallpaper)
\f
;;; Finding the wallpaper command
-(defvar wallpaper--default-commands
- ;; When updating this, also update the custom :type for `wallpaper-command'.
- '(
- ;; Gnome
- ("gsettings" "set" "org.gnome.desktop.background" "picture-uri" "file://%F")
- ;; KDE Plasma
- ("plasma-apply-wallpaperimage" "%f")
- ;; XFCE
- ("xfconf-query" "-c" "xfce4-desktop" "-p"
- "/backdrop/screen0/monitoreDP/workspace0/last-image" "-s" "%f")
- ;; LXDE
- ("pcmanfm" "--set-wallpaper=%f")
- ;; LXQt
- ("pcmanfm-qt" "--set-wallpaper=%f") ; "--wallpaper-mode=MODE"
- ;; ;; Mate
- ;; ("gsettings" "set" "org.mate.background" "picture-filename" "%f")
- ;; ;; Cinnamon
- ;; ("gsettings" "set" "org.cinnamon.desktop.background" "picture-uri" "file://%F")
- ;; ;; Deepin
- ;; ("gsettings" "set" "com.deepin.wrap.gnome.desktop.background" "picture-uri" "file://%F")
- ;; Sway (Wayland)
- ("swaybg" "-o" "*" "-i" "%f" "-m" "fill")
- ;; Wayland General
- ("wbg" "%f")
- ;; macOS
- ("osascript" "-e" "tell application \"Finder\" to set desktop picture to POSIX file \"%f\"")
- ;; Other / General X
- ("gm" "display" "-size" "%wx%h" "-window" "root" "%f")
- ("display" "-resize" "%wx%h" "-window" "root" "%f")
- ("feh" "--bg-max" "%f")
- ("fbsetbg" "-a" "%f")
- ("xwallpaper" "--zoom" "%f")
- ("hsetroot" "-full" "%f")
- ("xloadimage" "-onroot" "-fullscreen" "%f")
- ("xsetbg" " %f")
- )
- "List of executables and options 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:
-
- (COMMAND ARG1 .. ARGN)
-
-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\", \"%h\" and \"%w\"
-will be replaced as described in `wallpaper-command-args'.")
-
-(cl-defmethod wallpaper--check-command ((_type (eql 'gsettings)))
- (or (and (getenv "DESKTOP_SESSION")
- (member (downcase (getenv "DESKTOP_SESSION"))
- '("gnome" "gnome" "gnome-wayland" "gnome-xorg"
- "unity" "ubuntu" "pantheon" "budgie-desktop"
- "pop")))
- (member "GNOME" (xdg-current-desktop))
- (member "Budgie" (xdg-current-desktop))
- (member "GNOME-Classic" (xdg-current-desktop))))
-
-(cl-defmethod wallpaper--check-command ((_type (eql 'plasma-apply-wallpaperimage)))
- (member "KDE" (xdg-current-desktop)))
-
-(cl-defmethod wallpaper--check-command ((_type (eql 'xfconf-query)))
- (or (and (getenv "DESKTOP_SESSION")
- (member (downcase (getenv "DESKTOP_SESSION"))
- '("xubuntu" "ubuntustudio")))
- (member "XFCE" (xdg-current-desktop))))
-
-(cl-defmethod wallpaper--check-command ((_type (eql 'pcmanf)))
- (member "LXDE" (xdg-current-desktop)))
+(cl-defstruct (wallpaper-setter
+ ;; Rename the default constructor from `make-wallpaper-cmd'.
+ (:constructor
+ wallpaper-setter-create
+ ( name command args-raw
+ &rest rest-plist
+ &aux
+ (args (if (listp args-raw)
+ args-raw
+ (string-split args-raw)))
+ (predicate (plist-get rest-plist :predicate))))
+ (:copier wallpaper-setter-copy))
+ "Structure containing a command to set the wallpaper.
+
+NAME is a description of the setter (e.g. the name of the Desktop
+Environment).
+
+COMMAND is the executable to run to set the wallpaper.
+
+ARGS is the default list of command line arguments for COMMAND.
+
+PREDICATE is a function that will be called without any arguments
+and returns non-nil if this setter should be used."
+ name
+ command
+ args
+ (predicate #'always))
-(cl-defmethod wallpaper--check-command ((_type (eql 'pcmanf-qt)))
- (or (member (and (getenv "DESKTOP_SESSION")
- (downcase (getenv "DESKTOP_SESSION")))
- '("lubuntu" "lxqt"))
- (member "LXQt" (xdg-current-desktop))))
-
-;; (cl-defmethod wallpaper--check-command ((_type (eql 'gsettings)))
-;; (or (and (getenv "DESKTOP_SESSION")
-;; (equal "mate" (downcase (getenv "DESKTOP_SESSION"))))
-;; (member "MATE" (xdg-current-desktop))))
-
-;; (cl-defmethod wallpaper--check-command ((_type (eql 'gsettings)))
-;; (or (equal "cinnamon" (and (getenv "DESKTOP_SESSION")
-;; (downcase (getenv "DESKTOP_SESSION"))))
-;; (member "X-Cinnamon" (xdg-current-desktop))))
-
-;; (cl-defmethod wallpaper--check-command ((_type (eql 'gsettings)))
-;; (member "Deepin" (xdg-current-desktop)))
+;;;###autoload
+(put 'wallpaper-setter-create 'lisp-indent-function 1)
+
+(defmacro wallpaper--default-methods-create (&rest items)
+ "Helper macro for defining `wallpaper--default-setters'."
+ (cons 'list
+ (mapcar
+ (lambda (item)
+ `(wallpaper-setter-create ,@item))
+ items)))
+
+(defvar wallpaper--default-setters
+ (wallpaper--default-methods-create
+
+ ;; macOS.
+ ;; NB. Should come first to override everything else.
+ ("macOS"
+ "osascript"
+ '("-e" "tell application \"Finder\" to set desktop picture to POSIX file \"%f\"")
+ :predicate (lambda ()
+ (eq system-type 'darwin)))
+
+ ;; Desktop environments.
+ ("Gnome"
+ "gsettings"
+ "set org.gnome.desktop.background picture-uri file://%F"
+ :predicate (lambda ()
+ (or (and (getenv "DESKTOP_SESSION")
+ (member (downcase (getenv "DESKTOP_SESSION"))
+ '("gnome" "gnome" "gnome-wayland" "gnome-xorg"
+ "unity" "ubuntu" "pantheon" "budgie-desktop"
+ "pop")))
+ (member "GNOME" (xdg-current-desktop))
+ (member "Budgie" (xdg-current-desktop))
+ (member "GNOME-Classic" (xdg-current-desktop)))))
+
+ ("KDE Plasma"
+ "plasma-apply-wallpaperimage" "%f"
+ :predicate (lambda ()
+ (member "KDE" (xdg-current-desktop))))
+
+ ("XFCE"
+ "xfconf-query" '("-c" "xfce4-desktop"
+ "-p" "/backdrop/screen0/monitoreDP/workspace0/last-image"
+ "-s" "%f")
+ :predicate (lambda ()
+ (or (and (getenv "DESKTOP_SESSION")
+ (member (downcase (getenv "DESKTOP_SESSION"))
+ '("xubuntu" "ubuntustudio")))
+ (member "XFCE" (xdg-current-desktop)))))
+
+ ("LXDE"
+ "pcmanfm" "--set-wallpaper=%f"
+ :predicate (lambda ()
+ (member "LXDE" (xdg-current-desktop))))
+
+ ("LXQt"
+ "pcmanfm-qt" "--set-wallpaper=%f" ; "--wallpaper-mode=MODE"
+ :predicate (lambda ()
+ (or (member (and (getenv "DESKTOP_SESSION")
+ (downcase (getenv "DESKTOP_SESSION")))
+ '("lubuntu" "lxqt"))
+ (member "LXQt" (xdg-current-desktop)))))
+
+ ("Mate"
+ "gsettings" "set org.mate.background picture-filename %f"
+ :predicate (lambda ()
+ (or (and (getenv "DESKTOP_SESSION")
+ (equal "mate" (downcase (getenv "DESKTOP_SESSION"))))
+ (member "MATE" (xdg-current-desktop)))))
+
+ ("Cinnamon"
+ "gsettings" "set org.cinnamon.desktop.background picture-uri file://%F"
+ :predicate (lambda ()
+ (or (equal "cinnamon" (and (getenv "DESKTOP_SESSION")
+ (downcase (getenv "DESKTOP_SESSION"))))
+ (member "X-Cinnamon" (xdg-current-desktop)))))
+
+ ("Deepin"
+ "gsettings" "set com.deepin.wrap.gnome.desktop.background picture-uri file://%F"
+ :predicate (lambda ()
+ (member "Deepin" (xdg-current-desktop))))
+
+ ;; Wayland general.
+ ("Sway (Wayland)"
+ "swaybg" "-o * -i %f -m fill"
+ :predicate (lambda ()
+ (and (getenv "WAYLAND_DISPLAY")
+ (getenv "SWAYSOCK"))))
+
+ ("wbg"
+ "wbg" "%f"
+ :predicate (lambda ()
+ (getenv "WAYLAND_DISPLAY")))
+
+ ;; X general.
+ ("GraphicsMagick"
+ "gm" "display -size %wx%h -window root %f")
+
+ ("ImageMagick"
+ "display" "-resize %wx%h -window root %f")
+
+ ("feh"
+ "feh" "--bg-max %f")
+
+ ("fbsetbg"
+ "fbsetbg" "-a %f")
+
+ ("xwallpaper"
+ "xwallpaper" "--zoom %f")
+
+ ("hsetroot"
+ "hsetroot" "-full %f")
+
+ ("xloadimage"
+ "xloadimage" "-onroot -fullscreen %f")
+
+ ("xsetbg"
+ "xsetbg" "%f")
+ )
+ "List of setters used for setting the wallpaper.
+Every item in the list is a structure of type
+`wallpaper-setter' (which see).
-(cl-defmethod wallpaper--check-command ((_type (eql 'swaybg)))
- (and (getenv "WAYLAND_DISPLAY")
- (getenv "SWAYSOCK")))
+This is used by `wallpaper--find-command' to automatically set
+`wallpaper-command', and by `wallpaper--find-command-args' to set
+`wallpaper-command-args'. The setters will be tested in the
+order in which they appear.")
-(cl-defmethod wallpaper--check-command ((_type (eql 'wbg)))
- (getenv "WAYLAND_DISPLAY"))
+(defvar wallpaper--current-setter nil)
-(cl-defmethod wallpaper--check-command (_type)
- t)
+(defun wallpaper--find-setter ()
+ (when (wallpaper--use-default-set-function-p)
+ (or wallpaper--current-setter
+ (setq wallpaper--current-setter
+ (catch 'found
+ (dolist (setter wallpaper--default-setters)
+ (wallpaper-debug "Testing setter %s" (wallpaper-setter-name setter))
+ (when (and (executable-find (wallpaper-setter-command setter))
+ (if-let ((pred (wallpaper-setter-predicate setter)))
+ (funcall pred)
+ t))
+ (wallpaper-debug "Found setter %s" (wallpaper-setter-name setter))
+ (throw 'found setter))))))))
(defun wallpaper--find-command ()
"Return a valid command to set the wallpaper in this environment."
- (when (wallpaper--use-default-set-function-p)
- (catch 'found
- (dolist (cmd wallpaper--default-commands)
- (if (and (wallpaper--check-command (intern (car cmd)))
- (executable-find (car cmd)))
- (throw 'found (car cmd)))))))
-
-(defvar wallpaper-command) ; silence byte-compiler
-(defun wallpaper--find-command-arguments ()
+ (wallpaper-setter-command (wallpaper--find-setter)))
+
+(defun wallpaper--find-command-args ()
"Return command line arguments matching `wallpaper-command'."
- (when (wallpaper--use-default-set-function-p)
- (cdr (assoc wallpaper-command wallpaper--default-commands))))
+ (wallpaper-setter-args (wallpaper--find-setter)))
\f
;;; Customizable variables
(defun wallpaper--set-wallpaper-command (sym val)
"Set `wallpaper-command', and update `wallpaper-command-args'.
Used to set `wallpaper-command'."
- ;; Note: `wallpaper-command' is used by `wallpaper--find-command-arguments'.
+ ;; Note: `wallpaper-command' is used by `wallpaper--find-command-args'.
(prog1 (set-default sym val)
(set-default 'wallpaper-command-args
- (wallpaper--find-command-arguments))))
+ (wallpaper--find-command-args))))
(defcustom wallpaper-command (wallpaper--find-command)
"Executable used by `wallpaper-set' for setting the wallpaper.
unsupported command, you will want to manually 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].
-
The value of this variable is ignored on MS-Windows and Haiku
systems, where a native API is used instead."
:type
:group 'image
:version "29.1")
-(defcustom wallpaper-command-args (wallpaper--find-command-arguments)
+(defcustom wallpaper-command-args (wallpaper--find-command-args)
"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.
\f
;;; 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))))
-
(defvar wallpaper-default-width 1080
"Default width used by `wallpaper-set'.
This is only used when it can't be detected automatically.
projects / emacs.git / commitdiff