Function: wallpaper-default-set-function

wallpaper-default-set-function is a byte-compiled function defined in wallpaper.el.gz.

Signature

(wallpaper-default-set-function FILE)

Documentation

Set the wallpaper to FILE using a command.

This is the default function for wallpaper-set-function.

Source Code

;; Defined in /usr/src/emacs/lisp/image/wallpaper.el.gz
(defun wallpaper-default-set-function (file)
  "Set the wallpaper to FILE using a command.
This is the default function for `wallpaper-set-function'."
  (unless wallpaper-command
    (error "Couldn't find a command to set the wallpaper with"))
  (let* ((args (if (functionp wallpaper-command-args)
                   (funcall wallpaper-command-args)
                 wallpaper-command-args))
         (real-args (mapcar (lambda (arg) (wallpaper--format-arg arg file))
                            args))
         (bufname (format " *wallpaper-%s*" (random)))
         (setter (and (wallpaper-setter-p wallpaper--current-setter)
                      (equal (wallpaper-setter-command wallpaper--current-setter)
                             wallpaper-command)
                      wallpaper--current-setter))
         (init-action (and setter (wallpaper-setter-init-action setter)))
         (detach (and setter (wallpaper-setter-detach setter)))
         process)
    (when init-action
      (funcall init-action))
    (wallpaper-debug "Using command: \"%s %s\""
                     wallpaper-command (string-join real-args " "))
    (if detach
        (apply #'call-process wallpaper-command nil 0 nil real-args)
      (setq process
            (apply #'start-process "set-wallpaper" bufname
                   wallpaper-command real-args))
      (setf (process-sentinel process)
            (lambda (process status)
              (unwind-protect
                  (if (and (eq (process-status process) 'exit)
                           (zerop (process-exit-status process)))
                      (message "Desktop wallpaper changed to %s"
                               (abbreviate-file-name file))
                    (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))