Fix.

[elisp/gnus.git-] / lisp / gnus-fun.el

diff --git a/lisp/gnus-fun.el b/lisp/gnus-fun.el
index 7d5f5ee..fa2b54f 100644 (file)
--- a/lisp/gnus-fun.el
+++ b/lisp/gnus-fun.el
@@ -43,14 +43,14 @@
 (defun gnus-shell-command-to-string (command)
   "Like `shell-command-to-string' except not mingling ERROR."
   (with-output-to-string
-    (call-process shell-file-name nil (list standard-output nil) 
+    (call-process shell-file-name nil (list standard-output nil)
                  nil shell-command-switch command)))
 
 (defun gnus-shell-command-on-region (start end command)
   "A simplified `shell-command-on-region'.
 Output to the current buffer, replace text, and don't mingle error."
-  (call-process-region start end shell-file-name t 
-                      (list (current-buffer) nil) 
+  (call-process-region start end shell-file-name t
+                      (list (current-buffer) nil)
                       nil shell-command-switch command))
 
 ;;;###autoload
@@ -75,7 +75,8 @@ Output to the current buffer, replace text, and don't mingle error."
             (shell-quote-argument file)))))
 
 (defun gnus-convert-image-to-gray-x-face (file depth)
-  (let* ((mapfile (make-temp-name (expand-file-name "gnus." mm-tmp-directory)))
+  (let* ((mapfile (mm-make-temp-file (expand-file-name "gnus."
+                                                      mm-tmp-directory)))
         (levels (expt 2 depth))
         (step (/ 255 (1- levels)))
         color-alist bits bits-list mask pixel x-faces)
@@ -119,35 +120,39 @@ Output to the current buffer, replace text, and don't mingle error."
   (let* ((depth (length faces))
         (scale (/ 255 (1- (expt 2 depth))))
         (ok-p t)
-        bit-list bit-lists pixels pixel)
-    (dolist (face faces)
-      (setq bit-list nil)
-      (with-temp-buffer
+        (coding-system-for-read 'binary)
+        (coding-system-for-write 'binary)
+        (input-coding-system 'binary)
+        (output-coding-system 'binary)
+        default-enable-multibyte-characters
+        start bit-array bit-arrays pixel)
+    (with-temp-buffer
+      (dolist (face faces)
+       (erase-buffer)
        (insert (uncompface face))
        (gnus-shell-command-on-region
         (point-min) (point-max)
         "pnmnoraw")
        (goto-char (point-min))
        (forward-line 2)
+       (setq start (point))
+       (insert "[")
        (while (not (eobp))
-         (cond
-          ((eq (following-char) ?0)
-           (push 0 bit-list))
-          ((eq (following-char) ?1)
-           (push 1 bit-list)))
-         (forward-char 1)))
-      (unless (= (length bit-list) (* 48 48))
-       (setq ok-p nil))
-      (push bit-list bit-lists))
-    (when ok-p
-      (dotimes (i (* 48 48))
-       (setq pixel 0)
-       (dotimes (plane depth)
-         (setq pixel (+ (* pixel 2) (nth i (nth plane bit-lists)))))
-       (push pixel pixels))
-      (with-temp-buffer
+         (forward-char 1)
+         (insert " "))
+       (insert "]")
+       (goto-char start)
+       (setq bit-array (read (current-buffer)))
+       (unless (= (length bit-array) (* 48 48))
+         (setq ok-p nil))
+       (push bit-array bit-arrays))
+      (when ok-p
+       (erase-buffer)
        (insert "P2\n48 48\n255\n")
-       (dolist (pixel pixels)
+       (dotimes (i (* 48 48))
+         (setq pixel 0)
+         (dotimes (plane depth)
+           (setq pixel (+ (* pixel 2) (aref (nth plane bit-arrays) i))))
          (insert (number-to-string (* scale pixel)) " "))
        (gnus-shell-command-on-region
         (point-min) (point-max)