From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Nick Roberts Newsgroups: gmane.emacs.devel Subject: thumbs.el and transparency Date: Wed, 25 Jan 2006 14:08:20 +1300 Message-ID: <17366.53124.274532.548329@kahikatea.snap.net.nz> NNTP-Posting-Host: main.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=us-ascii Content-Transfer-Encoding: 7bit X-Trace: sea.gmane.org 1138152351 5157 80.91.229.2 (25 Jan 2006 01:25:51 GMT) X-Complaints-To: usenet@sea.gmane.org NNTP-Posting-Date: Wed, 25 Jan 2006 01:25:51 +0000 (UTC) Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Wed Jan 25 02:25:49 2006 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([199.232.76.165]) by ciao.gmane.org with esmtp (Exim 4.43) id 1F1ZPs-0006yw-0W for ged-emacs-devel@m.gmane.org; Wed, 25 Jan 2006 02:25:44 +0100 Original-Received: from localhost ([127.0.0.1] helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1F1ZJp-0000og-LU for ged-emacs-devel@m.gmane.org; Tue, 24 Jan 2006 20:19:29 -0500 Original-Received: from mailman by lists.gnu.org with tmda-scanned (Exim 4.43) id 1F1ZIX-0000SZ-6m for emacs-devel@gnu.org; Tue, 24 Jan 2006 20:18:09 -0500 Original-Received: from exim by lists.gnu.org with spam-scanned (Exim 4.43) id 1F1ZDd-0005aL-Jy for emacs-devel@gnu.org; Tue, 24 Jan 2006 20:13:06 -0500 Original-Received: from [199.232.76.173] (helo=monty-python.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1F1ZCe-00052q-Rt for emacs-devel@gnu.org; Tue, 24 Jan 2006 20:12:05 -0500 Original-Received: from [202.37.101.8] (helo=viper.snap.net.nz) by monty-python.gnu.org with esmtp (Exim 4.52) id 1F1Z9x-0006FU-7u for emacs-devel@gnu.org; Tue, 24 Jan 2006 20:09:17 -0500 Original-Received: from kahikatea.snap.net.nz (p229-tnt1.snap.net.nz [202.124.110.229]) by viper.snap.net.nz (Postfix) with ESMTP id 6C3DB740795 for ; Wed, 25 Jan 2006 14:09:08 +1300 (NZDT) Original-Received: by kahikatea.snap.net.nz (Postfix, from userid 500) id A12138884; Wed, 25 Jan 2006 14:08:20 +1300 (NZDT) Original-To: emacs-devel@gnu.org X-Mailer: VM 7.19 under Emacs 22.0.50.50 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.5 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:49504 Archived-At: 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)