thumbs.el and transparency

[Nick Roberts]

Currently thumbs.el stores all thumbnails as jpeg images.  Some image formats
such as xpm allow transparency (do M-x thumbs on emacs/etc/images, for
example).  When converted to jpeg a transparent background is converted to a
black one, so if the foreground is also black you see nothing.

There has been a discussion about formats before and I don't wan't to undo
any of that.  How about the change below which creates thumbnails in the
same format as the image when its xpm xbm or pbm, and uses jpeg otherwise?

Nick


*** thumbs.el   24 Jan 2006 22:18:53 +1300      1.26
--- thumbs.el   25 Jan 2006 13:57:39 +1300      
***************
*** 195,201 ****
  
  (defun thumbs-temp-file ()
    "Return a unique temporary filename for an image."
!   (format "%s%s-%s.jpg"
            (thumbs-temp-dir)
            thumbs-temp-prefix
            (thumbs-gensym "T")))
--- 195,201 ----
  
  (defun thumbs-temp-file ()
    "Return a unique temporary filename for an image."
!   (format "%s%s-%s."
            (thumbs-temp-dir)
            thumbs-temp-prefix
            (thumbs-gensym "T")))
***************
*** 236,249 ****
    (thumbs-cleanup-thumbsdir))
  
  (defun thumbs-call-convert (filein fileout action
!                                  &optional arg output-format action-prefix)
    "Call the convert program.
  FILEIN is the input file,
  FILEOUT is the output file,
  ACTION is the command to send to convert.
  Optional arguments are:
  ARG any arguments to the ACTION command,
- OUTPUT-FORMAT is the file format to output (default is jpeg),
  ACTION-PREFIX is the symbol to place before the ACTION command
                (defaults to '-' but can sometimes be '+')."
    (let ((command (format "%s %s%s %s \"%s\" \"%s:%s\""
--- 236,248 ----
    (thumbs-cleanup-thumbsdir))
  
  (defun thumbs-call-convert (filein fileout action
!                                  &optional arg action-prefix)
    "Call the convert program.
  FILEIN is the input file,
  FILEOUT is the output file,
  ACTION is the command to send to convert.
  Optional arguments are:
  ARG any arguments to the ACTION command,
  ACTION-PREFIX is the symbol to place before the ACTION command
                (defaults to '-' but can sometimes be '+')."
    (let ((command (format "%s %s%s %s \"%s\" \"%s:%s\""
***************
*** 252,258 ****
                         action
                         (or arg "")
                         filein
!                        (or output-format "jpeg")
                         fileout)))
      (call-process shell-file-name nil nil nil "-c" command)))
  
--- 251,257 ----
                         action
                         (or arg "")
                         filein
!                        (symbol-name (thumbs-image-thumb-type filein))
                         fileout)))
      (call-process shell-file-name nil nil nil "-c" command)))
  
***************
*** 269,284 ****
  smaller according to whether INCREMENT is 1 or -1."
    (let* ((buffer-read-only nil)
         (old thumbs-current-tmp-filename)
         (x (or size
!               (thumbs-new-image-size thumbs-current-image-size increment)))
!        (tmp (thumbs-temp-file)))
      (erase-buffer)
      (thumbs-call-convert (or old thumbs-current-image-filename)
                         tmp "sample"
                         (concat (number-to-string (car x)) "x"
                                 (number-to-string (cdr x))))
      (save-excursion
!       (thumbs-insert-image tmp 'jpeg 0))
      (setq thumbs-current-tmp-filename tmp)))
  
  (defun thumbs-resize-image (width height)
--- 268,284 ----
  smaller according to whether INCREMENT is 1 or -1."
    (let* ((buffer-read-only nil)
         (old thumbs-current-tmp-filename)
+        (type (thumbs-image-thumb-type thumbs-current-image-filename))
+        (tmp (concat (thumbs-temp-file) (symbol-name type)))
         (x (or size
!               (thumbs-new-image-size thumbs-current-image-size increment))))
      (erase-buffer)
      (thumbs-call-convert (or old thumbs-current-image-filename)
                         tmp "sample"
                         (concat (number-to-string (car x)) "x"
                                 (number-to-string (cdr x))))
      (save-excursion
!       (thumbs-insert-image tmp type 0))
      (setq thumbs-current-tmp-filename tmp)))
  
  (defun thumbs-resize-image (width height)
***************
*** 300,306 ****
    "Return a thumbnail name for the image IMG."
    (convert-standard-filename
     (let ((filename (expand-file-name img)))
!      (format "%s%08x-%s.jpg"
               (thumbs-thumbsdir)
               (sxhash filename)
               (subst-char-in-string
--- 300,306 ----
    "Return a thumbnail name for the image IMG."
    (convert-standard-filename
     (let ((filename (expand-file-name img)))
!      (format (concat "%s%08x-%s." (symbol-name (thumbs-image-thumb-type img)))
               (thumbs-thumbsdir)
               (sxhash filename)
               (subst-char-in-string
***************
*** 333,338 ****
--- 333,344 ----
        ((string-match ".*\\.png\\'" img) 'png)
        ((string-match ".*\\.tiff?\\'" img) 'tiff)))
  
+ (defun thumbs-image-thumb-type (img)
+   (let ((type (thumbs-image-type img)))
+     (if (and (image-type-available-p type) (memq type '(xpm xbm pbm)))
+       type
+       'jpeg)))
+ 
  (defun thumbs-file-size (img)
    (let ((i (image-size (find-image `((:type ,(thumbs-image-type img) :file 
,img))) t)))
      (concat (number-to-string (round (car i)))
***************
*** 363,369 ****
    "Insert the thumbnail for IMG at point.
  If MARKED is non-nil, the image is marked."
    (thumbs-insert-image
!    (thumbs-make-thumb img) 'jpeg thumbs-relief marked)
    (add-text-properties (1- (point)) (point)
                     `(thumb-image-file ,img
                       help-echo ,(file-name-nondirectory img))))
--- 369,375 ----
    "Insert the thumbnail for IMG at point.
  If MARKED is non-nil, the image is marked."
    (thumbs-insert-image
!    (thumbs-make-thumb img) (thumbs-image-thumb-type img) thumbs-relief marked)
    (add-text-properties (1- (point)) (point)
                     `(thumb-image-file ,img
                       help-echo ,(file-name-nondirectory img))))
***************
*** 623,630 ****
      (push elt thumbs-marked-list)
      (let ((inhibit-read-only t))
        (delete-char 1)
!       (save-excursion
!       (thumbs-insert-thumb elt t))))
    (when (eolp) (forward-char)))
  
  (defun thumbs-unmark ()
--- 629,635 ----
      (push elt thumbs-marked-list)
      (let ((inhibit-read-only t))
        (delete-char 1)
!       (thumbs-insert-thumb elt t)))
    (when (eolp) (forward-char)))
  
  (defun thumbs-unmark ()
***************
*** 636,646 ****
      (setq thumbs-marked-list (delete elt thumbs-marked-list))
      (let ((inhibit-read-only t))
        (delete-char 1)
!       (save-excursion
!       (thumbs-insert-thumb elt nil))))
    (when (eolp) (forward-char)))
  
- 
  ;; cleaning of old temp files
  (mapc 'delete-file
        (directory-files (thumbs-temp-dir) t thumbs-temp-prefix))
--- 641,649 ----
      (setq thumbs-marked-list (delete elt thumbs-marked-list))
      (let ((inhibit-read-only t))
        (delete-char 1)
!       (thumbs-insert-thumb elt nil)))
    (when (eolp) (forward-char)))
  
  ;; cleaning of old temp files
  (mapc 'delete-file
        (directory-files (thumbs-temp-dir) t thumbs-temp-prefix))
***************
*** 653,666 ****
    (interactive "sAction: \nsValue: ")
    (let* ((buffer-read-only nil)
         (old thumbs-current-tmp-filename)
!        (tmp (thumbs-temp-file)))
      (erase-buffer)
      (thumbs-call-convert (or old thumbs-current-image-filename)
                         tmp
                         action
                         (or arg ""))
      (save-excursion
!       (thumbs-insert-image tmp 'jpeg 0))
      (setq thumbs-current-tmp-filename tmp)))
  
  (defun thumbs-emboss-image (emboss)
--- 656,670 ----
    (interactive "sAction: \nsValue: ")
    (let* ((buffer-read-only nil)
         (old thumbs-current-tmp-filename)
!        (type (thumbs-image-thumb-type thumbs-current-image-filename))
!        (tmp (concat (thumbs-temp-file) (symbol-name type))))
      (erase-buffer)
      (thumbs-call-convert (or old thumbs-current-image-filename)
                         tmp
                         action
                         (or arg ""))
      (save-excursion
!       (thumbs-insert-image tmp type 0))
      (setq thumbs-current-tmp-filename tmp)))
  
  (defun thumbs-emboss-image (emboss)