Function: image-dired-create-thumb-1

image-dired-create-thumb-1 is a byte-compiled function defined in image-dired-external.el.gz.

Signature

(image-dired-create-thumb-1 ORIGINAL-FILE THUMBNAIL-FILE)

Documentation

For ORIGINAL-FILE, create thumbnail image named THUMBNAIL-FILE.

Source Code

;; Defined in /usr/src/emacs/lisp/image/image-dired-external.el.gz
(defun image-dired-create-thumb-1 (original-file thumbnail-file)
  "For ORIGINAL-FILE, create thumbnail image named THUMBNAIL-FILE."
  (let* ((size (number-to-string (image-dired--thumb-size)))
         (modif-time (format-time-string
                      "%s" (file-attribute-modification-time
                            (file-attributes original-file))))
         (thumbnail-nq8-file (replace-regexp-in-string ".png\\'" "-nq8.png"
                                                       thumbnail-file))
         (spec `((?s . ,size) (?w . ,size) (?h . ,size)
                 (?m . ,modif-time)
                 (?f . ,original-file)
                 (?u . ,(image-dired--file-URI original-file))
                 (?q . ,thumbnail-nq8-file)
                 (?t . ,thumbnail-file)))
         (thumbnail-dir (file-name-directory thumbnail-file))
         process)
    (when (not (file-exists-p thumbnail-dir))
      (with-file-modes #o700
        (make-directory thumbnail-dir t))
      (message "Thumbnail directory created: %s" thumbnail-dir))

    ;; Thumbnail file creation processes begin here and are marshaled
    ;; in a queue by `image-dired-create-thumb'.
    (let ((cmd image-dired-cmd-create-thumbnail-program)
          (args (mapcar
                 (lambda (arg) (format-spec arg spec))
                 (if (memq image-dired-thumbnail-storage
                           image-dired--thumbnail-standard-sizes)
                     image-dired-cmd-create-standard-thumbnail-options
                   image-dired-cmd-create-thumbnail-options))))
      (image-dired-debug "Running %s %s" cmd (string-join args " "))
      (setq process
            (apply #'start-process "image-dired-create-thumbnail" nil
                   cmd args)))

    (setf (process-sentinel process)
          (lambda (process status)
            ;; Trigger next in queue once a thumbnail has been created
            (cl-decf image-dired-queue-active-jobs)
            (image-dired-thumb-queue-run)
            (when (= image-dired-queue-active-jobs 0)
              (image-dired-debug
               (format-time-string
                "Generated thumbnails in %s.%3N seconds"
                (time-subtract nil
                               image-dired--generate-thumbs-start))))
            (if (not (and (eq (process-status process) 'exit)
                          (zerop (process-exit-status process))))
                (message "Thumb could not be created for %s: %s"
                         (abbreviate-file-name original-file)
                         (string-replace "\n" "" status))
              (set-file-modes thumbnail-file #o600)
              (clear-image-cache thumbnail-file)
              ;; PNG thumbnail has been created since we are
              ;; following the XDG thumbnail spec, so try to optimize
              (when (memq image-dired-thumbnail-storage
                          image-dired--thumbnail-standard-sizes)
                (cond
                 ((and image-dired-cmd-pngnq-program
                       (executable-find image-dired-cmd-pngnq-program))
                  (image-dired-pngnq-thumb spec))
                 ((and image-dired-cmd-pngcrush-program
                       (executable-find image-dired-cmd-pngcrush-program))
                  (image-dired-pngcrush-thumb spec))
                 ((and image-dired-cmd-optipng-program
                       (executable-find image-dired-cmd-optipng-program))
                  (image-dired-optipng-thumb spec)))))))
    process))