emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

master 35d5ad713e 1/3: Rewrite wallpaper.el to use a cl-defstruct


From: Stefan Kangas
Subject: master 35d5ad713e 1/3: Rewrite wallpaper.el to use a cl-defstruct
Date: Mon, 26 Sep 2022 11:43:08 -0400 (EDT)

branch: master
commit 35d5ad713ee05f5cd922f66462df41deed95f7e8
Author: Stefan Kangas <stefankangas@gmail.com>
Commit: Stefan Kangas <stefankangas@gmail.com>

    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 886c7d691b..bdaa148e2b 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 8cd0fe2215..80d512c985 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))))



reply via email to

[Prev in Thread] Current Thread [Next in Thread]