code.delx.au - gnu-emacs/blob - share/emacs/site-lisp/w3m/w3m-image.el

   1 ;;; w3m-image.el --- Image conversion routines.
   2
   3 ;; Copyright (C) 2001, 2002, 2003, 2005, 2007, 2008
   4 ;; TSUCHIYA Masatoshi <tsuchiya@namazu.org>
   5
   6 ;; Authors: Yuuichi Teranishi  <teranisi@gohome.org>
   7 ;; Keywords: w3m, WWW, hypermedia
   8
   9 ;; This file is a part of emacs-w3m.
  10
  11 ;; This program is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15
  16 ;; This program is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with this program; see the file COPYING.  If not, write to
  23 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  24 ;; Boston, MA 02110-1301, USA.
  25
  26
  27 ;;; Commentary:
  28
  29 ;; This file contains the stuffs to convert images for emacs-w3m.
  30 ;; For more detail about emacs-w3m, see:
  31 ;;
  32 ;;    http://emacs-w3m.namazu.org/
  33 ;;
  34 ;; Routines in this file require ImageMagick's convert.
  35 ;; For more detail about ImageMagick, see:
  36 ;;
  37 ;;    http://www.imagemagick.org/
  38
  39 ;;; Code:
  40
  41 (eval-when-compile
  42   (require 'cl))
  43
  44 (require 'w3m-util)
  45 (require 'w3m-proc)
  46
  47 (eval-when-compile
  48   (if (not (fboundp 'defcustom))
  49       (require 'pcustom)))
  50
  51 ;; Functions and variables which should be defined in the other module
  52 ;; at run-time.
  53 (eval-when-compile
  54   (defvar w3m-async-exec)
  55   (defvar w3m-current-url)
  56   (defvar w3m-profile-directory)
  57   (defvar w3m-work-buffer-name)
  58   (defvar w3m-work-buffer-list))
  59
  60 (defcustom w3m-imagick-convert-program (if noninteractive
  61                                            nil
  62                                          (w3m-which-command "convert"))
  63   "*Program name of ImageMagick's `convert'."
  64   :group 'w3m
  65   :set (lambda (symbol value)
  66          (custom-set-default symbol (if (and (not noninteractive)
  67                                              value)
  68                                         (if (file-name-absolute-p value)
  69                                             (if (file-executable-p value)
  70                                                 value)
  71                                           (w3m-which-command value)))))
  72   :type 'file)
  73
  74 (defcustom w3m-imagick-identify-program (if noninteractive
  75                                             nil
  76                                           (w3m-which-command "identify"))
  77   "*Program name of ImageMagick's `identify'."
  78   :group 'w3m
  79   :set (lambda (symbol value)
  80          (custom-set-default symbol (if (and (not noninteractive)
  81                                              value)
  82                                         (if (file-name-absolute-p value)
  83                                             (if (file-executable-p value)
  84                                                 value)
  85                                           (w3m-which-command value)))))
  86   :type 'file)
  87
  88 ;;; Image handling functions.
  89 (defcustom w3m-resize-images (and w3m-imagick-convert-program t)
  90   "*If non-nil, resize images to the specified width and height."
  91   :group 'w3m
  92   :set (lambda (symbol value)
  93          (custom-set-default symbol (and w3m-imagick-convert-program value)))
  94   :type 'boolean)
  95
  96 (put 'w3m-imagick-convert-program 'available-p 'unknown)
  97
  98 (defun w3m-imagick-convert-program-available-p ()
  99   "Return non-nil if ImageMagick's `convert' program is available.
 100 If not, `w3m-imagick-convert-program' and `w3m-resize-images' are made
 101 nil forcibly."
 102   (cond ((eq (get 'w3m-imagick-convert-program 'available-p) 'yes)
 103          t)
 104         ((eq (get 'w3m-imagick-convert-program 'available-p) 'no)
 105          nil)
 106         ((and (stringp w3m-imagick-convert-program)
 107               (file-executable-p w3m-imagick-convert-program))
 108          (put 'w3m-imagick-convert-program 'available-p 'yes)
 109          ;; Check whether convert supports png32.
 110          (put 'w3m-imagick-convert-program 'png32
 111               (unless (or (featurep 'xemacs)
 112                           (< emacs-major-version 22))
 113                 (with-temp-buffer
 114                   (set-buffer-multibyte nil)
 115                   (insert "P1 1 1 1")
 116                   (condition-case nil
 117                       (call-process-region (point-min) (point-max)
 118                                            w3m-imagick-convert-program
 119                                            t t nil "pbm:-" "png32:-")
 120                     (error))
 121                   (goto-char (point-min))
 122                   (looking-at "\211PNG\r\n"))))
 123          t)
 124         (t
 125          (when w3m-imagick-convert-program
 126            (message "ImageMagick's `convert' program is not available")
 127            (sit-for 1))
 128          (setq w3m-imagick-convert-program nil
 129                w3m-resize-images nil)
 130          (put 'w3m-imagick-convert-program 'available-p 'no)
 131          nil)))
 132
 133 ;;; Synchronous image conversion.
 134 (defun w3m-imagick-convert-buffer (from-type to-type &rest args)
 135   (when (w3m-imagick-convert-program-available-p)
 136     (let* ((in-file (make-temp-name
 137                      (expand-file-name "w3mel" w3m-profile-directory)))
 138            (buffer-file-coding-system 'binary)
 139            (coding-system-for-read 'binary)
 140            (coding-system-for-write 'binary)
 141            (default-process-coding-system (cons 'binary 'binary))
 142            return)
 143       (write-region (point-min) (point-max) in-file nil 'nomsg)
 144       (erase-buffer)
 145       (setq return
 146             (apply 'call-process
 147                    w3m-imagick-convert-program
 148                    nil t nil
 149                    (append args (list
 150                                  (concat
 151                                   (if from-type
 152                                       (concat from-type ":"))
 153                                   in-file)
 154                                  (if to-type
 155                                      (if (and (string-equal to-type "png")
 156                                               (get 'w3m-imagick-convert-program
 157                                                    'png32))
 158                                          "png32:-"
 159                                        (concat to-type ":-"))
 160                                    "-")))))
 161       (when (file-exists-p in-file) (delete-file in-file))
 162       (if (and (numberp return)
 163                (zerop return))
 164           t
 165         (message "Image conversion failed (code `%s')"
 166                  (if (stringp return)
 167                      (string-as-multibyte return)
 168                    return))
 169         nil))))
 170
 171 (defun w3m-imagick-convert-data (data from-type to-type &rest args)
 172   (with-temp-buffer
 173     (set-buffer-multibyte nil)
 174     (insert data)
 175     (and (apply 'w3m-imagick-convert-buffer from-type to-type args)
 176          (not (zerop (buffer-size)))
 177          (buffer-string))))
 178
 179 ;;; Asynchronous image conversion.
 180 (defun w3m-imagick-start-convert-data (handler
 181                                        data from-type to-type &rest args)
 182   (w3m-process-do-with-temp-buffer
 183       (success (when (w3m-imagick-convert-program-available-p)
 184                  (set-buffer-multibyte nil)
 185                  (insert data)
 186                  (apply 'w3m-imagick-start-convert-buffer
 187                         handler from-type to-type args)))
 188     (if (and success
 189              (not (zerop (buffer-size))))
 190         (buffer-string))))
 191
 192 (defun w3m-imagick-start-convert-buffer (handler from-type to-type &rest args)
 193   (lexical-let ((in-file (make-temp-name
 194                           (expand-file-name "w3mel" w3m-profile-directory)))
 195                 (out-buffer (current-buffer)))
 196     (setq w3m-current-url "non-existent")
 197     (let ((coding-system-for-write 'binary)
 198           (buffer-file-coding-system 'binary)
 199           jka-compr-compression-info-list
 200           format-alist)
 201       (write-region (point-min) (point-max) in-file nil 'nomsg))
 202     (w3m-process-do
 203         (success (with-current-buffer out-buffer
 204                    (erase-buffer)
 205                    (w3m-process-start
 206                     handler
 207                     w3m-imagick-convert-program
 208                     (append args
 209                             (list
 210                              (concat
 211                               (if from-type
 212                                   (concat from-type ":"))
 213                               in-file)
 214                              (if to-type
 215                                  (if (and (string-equal to-type "png")
 216                                           (get 'w3m-imagick-convert-program
 217                                                'png32))
 218                                      "png32:-"
 219                                    (concat to-type ":-"))
 220                                "-"))))))
 221       (when (file-exists-p in-file)
 222         (delete-file in-file))
 223       success)))
 224
 225 (defun w3m-resize-image (data width height handler)
 226   "Resize image DATA to WIDTH and HEIGHT asynchronously.
 227 HANDLER is called after conversion with resized data as an argument."
 228   (w3m-process-do
 229       (result (w3m-imagick-start-convert-data
 230                handler
 231                data nil nil "-geometry"
 232                (concat (number-to-string width)
 233                        "x"
 234                        (number-to-string height)
 235                        "!")))
 236     result))
 237
 238 (defun w3m-resize-image-by-rate (data rate handler)
 239   "Resize image DATA at RATE asynchronously.
 240 HANDLER is called after conversion with resized data as an argument.
 241 Note that this function requires that the `convert' program allows the
 242 `-resize' option."
 243   (w3m-process-do
 244       (result (w3m-imagick-start-convert-data
 245                handler
 246                data nil nil "-resize"
 247                (concat (number-to-string rate) "%")))
 248     result))
 249
 250 (defun w3m-favicon-usable-p ()
 251   "Check whether ImageMagick's `convert' supports a Windoze ico format in
 252 a large number of bits per pixel."
 253   (let ((xpm (condition-case nil
 254                  (w3m-imagick-convert-data
 255                   (string 0 0 1 0 1 0 2 1 0 0 1 0 24 0 52 0
 256                           0 0 22 0 0 0 40 0 0 0 2 0 0 0 2 0
 257                           0 0 1 0 24 0 0 0 0 0 0 0 0 0 0 0
 258                           0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
 259                           0 255 255 255 0 0 0 0 0 0)
 260                   "ico" "xpm")
 261                (error nil))))
 262     (and xpm (string-match "\"2 1 2 1\"" xpm) t)))
 263
 264 (provide 'w3m-image)
 265
 266 ;;; w3m-image.el ends here