master ad88e3e0b5 2/2: Add reasonable default to wallpaper-set

[Stefan Kangas]

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

    Add reasonable default to wallpaper-set
    
    * lisp/image/wallpaper.el
    (wallpaper-default-file-name-regexp): New variable.
    (wallpaper--get-default-file): New function.
    (wallpaper-set): Use above new function to set a default.
    * test/lisp/image/wallpaper-tests.el: New file.
---
 lisp/image/wallpaper.el            | 34 +++++++++++++++++++++-------
 test/lisp/image/wallpaper-tests.el | 46 ++++++++++++++++++++++++++++++++++++++
 2 files changed, 72 insertions(+), 8 deletions(-)

diff --git a/lisp/image/wallpaper.el b/lisp/image/wallpaper.el
index 893161bd1a..e5f2df73f4 100644
--- a/lisp/image/wallpaper.el
+++ b/lisp/image/wallpaper.el
@@ -1,4 +1,4 @@
-;;; wallpaper.el --- Change desktop background from Emacs  -*- 
lexical-binding: t; -*-
+;;; wallpaper.el --- Change the desktop background  -*- lexical-binding: t; -*-
 
 ;; Copyright (C) 2022 Free Software Foundation, Inc.
 
@@ -277,6 +277,19 @@ See also `wallpaper-default-width'.")
       (funcall fun)
     (read-number (format "Wallpaper %s in pixels: " desc) default)))
 
+(autoload 'ffap-file-at-point "ffap")
+
+;; FIXME: This only says which files are supported by Emacs, not by
+;;        the external tool we use to set the wallpaper.
+(defvar wallpaper-default-file-name-regexp (image-file-name-regexp))
+
+(defun wallpaper--get-default-file ()
+  (catch 'found
+    (dolist (file (list buffer-file-name (ffap-file-at-point)))
+      (when (and file (string-match wallpaper-default-file-name-regexp file))
+        (throw 'found (abbreviate-file-name
+                       (expand-file-name file)))))))
+
 (declare-function w32-set-wallpaper "w32fns.c")
 (declare-function haiku-set-wallpaper "term/haiku-win.el")
 
@@ -291,11 +304,15 @@ options `wallpaper-command' and `wallpaper-command-args'.
 
 On MS-Windows and Haiku systems, no external command is needed,
 so the value of `wallpaper-commands' is ignored."
-  (interactive (list (read-file-name "Set desktop background to: "
-                                     default-directory nil t nil
-                                     (lambda (fn)
-                                       (or (file-directory-p fn)
-                                           (string-match 
(image-file-name-regexp) fn))))))
+  (interactive
+   (let ((default (wallpaper--get-default-file)))
+     (list (read-file-name (format-prompt "Set desktop background to" default)
+                           default-directory default
+                           t nil
+                           (lambda (file-name)
+                             (or (file-directory-p file-name)
+                                 (string-match 
wallpaper-default-file-name-regexp
+                                               file-name)))))))
   (when (file-directory-p file)
     (error "Can't set wallpaper to a directory: %s" file))
   (unless (file-exists-p file)
@@ -331,8 +348,9 @@ so the value of `wallpaper-commands' is ignored."
                                      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)
+           (wallpaper-debug
+            "Using command %S %S" wallpaper-command
+            wallpaper-command-args)
            (setf (process-sentinel process)
                  (lambda (process status)
                    (unwind-protect
diff --git a/test/lisp/image/wallpaper-tests.el 
b/test/lisp/image/wallpaper-tests.el
new file mode 100644
index 0000000000..8cd0fe2215
--- /dev/null
+++ b/test/lisp/image/wallpaper-tests.el
@@ -0,0 +1,46 @@
+;;; wallpaper-tests.el --- tests for wallpaper.el  -*- lexical-binding: t -*-
+
+;; Copyright (C) 2022 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert)
+(require 'ert-x)
+(require 'wallpaper)
+
+(ert-deftest wallpaper--get-default-file/empty-gives-nil ()
+  (with-temp-buffer
+    (should-not (wallpaper--get-default-file))))
+
+(ert-deftest wallpaper--get-default-file/visiting-file ()
+  (ert-with-temp-file _
+    :buffer buf
+    :suffix (format ".%s" (car image-file-name-extensions))
+    (with-current-buffer buf
+      (should (wallpaper--get-default-file)))))
+
+(ert-deftest wallpaper--get-default-file/file-at-point ()
+  ;; ffap needs the file to exist
+  (ert-with-temp-file fil
+    :buffer buf
+    :suffix (format ".%s" (car image-file-name-extensions))
+    (with-current-buffer buf
+      (insert fil)
+      (should (stringp (wallpaper--get-default-file))))))
+
+;;; wallpaper-tests.el ends here