From 35d5ad713ee05f5cd922f66462df41deed95f7e8 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 18 Sep 2022 11:48:24 +0200 Subject: [PATCH] Rewrite wallpaper.el to use a cl-defstruct * lisp/image/wallpaper.el (wallpaper--default-commands): Delete variable. (wallpaper-setter): New cl-defstruct. (wallpaper--default-methods-create): New macro. (wallpaper--default-setters): (wallpaper--current-setter): New variables. (wallpaper--find-setter): New defun to pick a wallpaper-setter. (wallpaper--find-command, wallpaper--find-command-args): Use 'wallpaper--find-setter'. (wallpaper-command): Doc fix. * test/lisp/image/wallpaper-tests.el (wallpaper--find-command/return-string) (wallpaper--find-command-args/return-list) (wallpaper--image-file-regexp/return-string): New tests. --- lisp/image/wallpaper.el | 317 +++++++++++++++++------------ test/lisp/image/wallpaper-tests.el | 11 + 2 files changed, 201 insertions(+), 127 deletions(-) diff --git a/lisp/image/wallpaper.el b/lisp/image/wallpaper.el index 886c7d691b9..bdaa148e2b6 100644 --- a/lisp/image/wallpaper.el +++ b/lisp/image/wallpaper.el @@ -44,12 +44,27 @@ ;; 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) @@ -67,123 +82,186 @@ the image file to set the wallpaper to.") ;;; 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))) ;;; Customizable variables @@ -192,10 +270,10 @@ will be replaced as described in `wallpaper-command-args'.") (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. @@ -208,12 +286,6 @@ automatically updated to match. If you need to change this to an 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 @@ -241,7 +313,7 @@ systems, where a native API is used instead." :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. @@ -267,15 +339,6 @@ systems, where a native API is used instead." ;;; 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. diff --git a/test/lisp/image/wallpaper-tests.el b/test/lisp/image/wallpaper-tests.el index 8cd0fe2215e..80d512c9858 100644 --- a/test/lisp/image/wallpaper-tests.el +++ b/test/lisp/image/wallpaper-tests.el @@ -23,6 +23,17 @@ (require 'ert-x) (require 'wallpaper) +(ert-deftest wallpaper--find-command/return-string () + (should (and (wallpaper--find-command) + (stringp (wallpaper--find-command))))) + +(ert-deftest wallpaper--find-command-args/return-list () + (should (and (wallpaper--find-command-args) + (listp (wallpaper--find-command-args))))) + +(ert-deftest wallpaper--image-file-regexp/return-string () + (should (stringp (wallpaper--image-file-regexp)))) + (ert-deftest wallpaper--get-default-file/empty-gives-nil () (with-temp-buffer (should-not (wallpaper--get-default-file)))) -- 2.39.2