From 32b7aaa9f1e1fa12ea1db92594a872503f0de498 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Tue, 13 Sep 2022 16:57:01 +0200 Subject: [PATCH] Add new library wallpaper.el * lisp/image/wallpaper.el: New file. --- etc/NEWS | 6 ++ lisp/image/wallpaper.el | 146 ++++++++++++++++++++++++++++++++++++++++ 2 files changed, 152 insertions(+) create mode 100644 lisp/image/wallpaper.el diff --git a/etc/NEWS b/etc/NEWS index 5416aa80660..db3fcf19e59 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1989,6 +1989,12 @@ and is bound to "s p" in Image mode. *** Users can now add special image conversion functions. This is done via 'image-converter-add-handler'. +--- +*** New library wallpaper.el. +This library contains the command `wallpaper-set', which uses an +external command to set the desktop background. The new user option +`wallpaper-commands' controls which command is being used. + ** Image-Dired +++ diff --git a/lisp/image/wallpaper.el b/lisp/image/wallpaper.el new file mode 100644 index 00000000000..d997cb48d77 --- /dev/null +++ b/lisp/image/wallpaper.el @@ -0,0 +1,146 @@ +;;; wallpaper.el --- Set wallpaper using external command -*- lexical-binding: t; -*- + +;; Copyright (C) 2022 Free Software Foundation, Inc. + +;; Author: Stefan Kangas +;; Keywords: images + +;; 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 . + +;;; Commentary: + +;; This library provides the command `wallpaper-set', which uses an +;; external command to set the desktop background. This is obviously +;; a bit tricky to get right, as there is no lack of platforms, window +;; managers, desktop environments and tools. +;; +;; If this doesn't work in your environment, customize the user option +;; `wallpaper-commands'. + +;;; Code: + +(defcustom wallpaper-commands + '( + ;; Sway (Wayland) + ("swaybg" "-o" "*" "-i" "%f" "-m" "fill") + ;; Gnome + ("gsettings" "set" "org.gnome.desktop.background" "picture-uri" "file://%f") + ;; Other / General X + ("gm" "display" "-size" "%wx%h" "-window" "root" "%f") + ("display" "-resize" "%wx%h" "-window" "root" "%f") + ("feh" "--bg-max" "%f") + ("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. + +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\" 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)))) + +(cl-defmethod wallpaper--check-command ((_type (eql 'gsettings))) + (equal (getenv "XDG_CURRENT_DESKTOP") "GNOME")) + +(cl-defmethod wallpaper--check-command ((_type (eql 'swaybg))) + (and (getenv "WAYLAND_DISPLAY") + (getenv "SWAYSOCK"))) + +(cl-defmethod wallpaper--check-command (_type) + t) + +(defun wallpaper--find-command () + "Return a valid command for this system." + (catch 'found + (dolist (cmd wallpaper-commands) + (if (and (wallpaper--check-command (intern (car cmd))) + (executable-find (car cmd))) + (throw 'found cmd))))) + +(defun wallpaper-set (file) + "Set the desktop background to FILE in a graphical environment." + (interactive (list (and + (display-graphic-p) + (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))))))) + (when (file-directory-p file) + (error "Can't set wallpaper to a directory: %s" file)) + (unless (file-exists-p file) + (error "No such file: %s" file)) + (unless (file-readable-p file) + (error "File is not readable: %s" file)) + (when (display-graphic-p) + (let* ((command (wallpaper--find-command)) + (fmt-spec `((?f . ,(expand-file-name file)) + (?h . ,(display-pixel-height)) + (?w . ,(display-pixel-width)))) + (bufname (format " *wallpaper-%s*" (random))) + (process + (and command + (apply #'start-process "set-wallpaper" bufname + (car 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)) + (setf (process-sentinel process) + (lambda (process status) + (unwind-protect + (unless (and (eq (process-status process) 'exit) + (zerop (process-exit-status process))) + (message "command %S %s: %S" (string-join (process-command process) " ") + (string-replace "\n" "" status) + (with-current-buffer (process-buffer process) + (string-clean-whitespace (buffer-string))))) + (ignore-errors + (kill-buffer (process-buffer process)))))) + process))) + +(provide 'wallpaper) + +;;; wallpaper.el ends here -- 2.39.2