[nongnu] elpa/vm 4fd49c3888 10/20: vm-mime.el: Use `base64-(en|de)code-region` unconditionally

[ELPA Syncer]

branch: elpa/vm
commit 4fd49c3888569b4cdd556f7dd76073aff5b6f653
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>

    vm-mime.el: Use `base64-(en|de)code-region` unconditionally
    
    These were added back in Emacs-20.4.
---
 lisp/vcard.el   |   2 +
 lisp/vm-mime.el | 200 ++++++++------------------------------------------------
 2 files changed, 30 insertions(+), 172 deletions(-)

diff --git a/lisp/vcard.el b/lisp/vcard.el
index 75e84aa279..8c31761bba 100644
--- a/lisp/vcard.el
+++ b/lisp/vcard.el
@@ -473,6 +473,7 @@ US domestic telephone numbers are replaced with 
international format."
 (defmacro vcard-hexstring-to-ascii (s)
   `(format "%c" (string-to-number ,s 16)))
 
+;; FIXME: Use `quoted-printable-decode-region'!
 (defun vcard-region-decode-quoted-printable (&optional beg end)
   (save-excursion
     (save-restriction
@@ -486,6 +487,7 @@ US domestic telephone numbers are replaced with 
international format."
           (let ((s (buffer-substring (1+ (match-beginning 0)) (match-end 0))))
             (replace-match (vcard-hexstring-to-ascii s) t t)))))))
 
+;; FIXME: Use `base64-decode-region'!
 (defun vcard-region-decode-base64 (&optional beg end)
   (save-restriction
     (narrow-to-region (or beg (point-min)) (or end (point-max)))
diff --git a/lisp/vm-mime.el b/lisp/vm-mime.el
index 1aeba1070a..5b5c9791f9 100644
--- a/lisp/vm-mime.el
+++ b/lisp/vm-mime.el
@@ -578,88 +578,11 @@ out includes base-64, quoted-printable, uuencode and CRLF 
conversion."
   (or (markerp end) (setq end (vm-marker end)))
   (and (> (- end start) 10000)
        (vm-emit-mime-decoding-message "Decoding base64..."))
-  (let ((work-buffer nil)
-       (done nil)
-       (counter 0)
-       (bits 0)
-       (lim 0) inputpos
-       (non-data-chars (concat "^=" vm-mime-base64-alphabet)))
-    (unwind-protect
-       (save-excursion
-         (cond
-          ((and (featurep 'base64)
-                (fboundp 'base64-decode-region)
-                ;; W3 reportedly has a Lisp version of this, and
-                ;; there's no point running it.
-                (subrp (symbol-function 'base64-decode-region))
-                ;; The FSF Emacs version of this is unforgiving
-                ;; of errors, which is not in the spirit of the
-                ;; MIME spec, so avoid using it. - Kyle Jones
-                ;; Let us try it out now.  USR, 2012-10-19
-                ;; (not (not (featurep 'xemacs)))
-                )
-           (condition-case data
-               (base64-decode-region start end)
-             (error (vm-mime-error "%S" data)))
-           (and crlf (vm-mime-crlf-to-lf-region start end)))
-          (t
-           (setq work-buffer (vm-make-work-buffer))
-           (if vm-mime-base64-decoder-program
-               (let* ((binary-process-output t) ; any text already has CRLFs
-                      ;; use binary coding system in FSF Emacs/MULE
-                      (coding-system-for-read (vm-binary-coding-system))
-                      (coding-system-for-write (vm-binary-coding-system))
-                      (status (apply 'vm-run-command-on-region
-                                     start end work-buffer
-                                     vm-mime-base64-decoder-program
-                                     vm-mime-base64-decoder-switches)))
-                 (if (not (eq status t))
-                     (vm-mime-error "base64-decode failed: %s" (cdr status))))
-             (goto-char start)
-             (skip-chars-forward non-data-chars end)
-             (while (not done)
-               (setq inputpos (point))
-               (cond
-                ((> (skip-chars-forward vm-mime-base64-alphabet end) 0)
-                 (setq lim (point))
-                 (while (< inputpos lim)
-                   (setq bits (+ bits
-                                 (aref vm-mime-base64-alphabet-decoding-vector
-                                       (char-after inputpos))))
-                   (vm-increment counter)
-                   (vm-increment inputpos)
-                   (cond ((= counter 4)
-                          (vm-insert-char (lsh bits -16) 1 nil work-buffer)
-                          (vm-insert-char (logand (lsh bits -8) 255) 1 nil
-                                          work-buffer)
-                          (vm-insert-char (logand bits 255) 1 nil work-buffer)
-                          (setq bits 0 counter 0))
-                         (t (setq bits (lsh bits 6)))))))
-               (cond
-                ((= (point) end)
-                 (if (not (zerop counter))
-                     (vm-mime-error "at least %d bits missing at end of base64 
encoding"
-                                    (* (- 4 counter) 6)))
-                 (setq done t))
-                ((= (char-after (point)) 61) ; 61 is ASCII equals
-                 (setq done t)
-                 (cond ((= counter 1)
-                        (vm-mime-error "at least 2 bits missing at end of 
base64 encoding"))
-                       ((= counter 2)
-                        (vm-insert-char (lsh bits -10) 1 nil work-buffer))
-                       ((= counter 3)
-                        (vm-insert-char (lsh bits -16) 1 nil work-buffer)
-                        (vm-insert-char (logand (lsh bits -8) 255)
-                                        1 nil work-buffer))
-                       ((= counter 0) t)))
-                (t (skip-chars-forward non-data-chars end)))))
-           (and crlf
-                (with-current-buffer work-buffer
-                  (vm-mime-crlf-to-lf-region (point-min) (point-max))))
-           (goto-char start)
-           (insert-buffer-substring work-buffer)
-           (delete-region (point) end))))
-      (and work-buffer (kill-buffer work-buffer))))
+  (save-excursion
+    (condition-case data
+       (base64-decode-region start end)
+      (error (vm-mime-error "%S" data)))
+    (and crlf (vm-mime-crlf-to-lf-region start end)))
   (and (> (- end start) 10000)
        (vm-emit-mime-decoding-message "Decoding base64... done")))
 
@@ -667,96 +590,28 @@ out includes base-64, quoted-printable, uuencode and CRLF 
conversion."
   (or (markerp end) (setq end (vm-marker end)))
   (and (> (- end start) 200)
        (vm-inform 7 "Encoding base64..."))
-  (let ((work-buffer nil)
-       (buffer-undo-list t)
-       (counter 0)
-       (cols 0)
-       (bits 0)
-       (alphabet vm-mime-base64-alphabet)
-       inputpos)
-    (unwind-protect
-       (save-excursion
-         (and crlf (vm-mime-lf-to-crlf-region start end))
-         (cond
-          ((and (featurep 'base64)
-                (fboundp 'base64-encode-region)
-                ;; W3 reportedly has a Lisp version of this, and
-                ;; there's no point running it.
-                (subrp (symbol-function 'base64-encode-region)))
-           (condition-case data
-               (base64-encode-region start end B-encoding)
-             (wrong-number-of-arguments
-              ;; call with two args and then strip out the
-              ;; newlines if we're doing B encoding.
-              (condition-case data
-                  (base64-encode-region start end)
-                (error (vm-mime-error "%S" data)))
-              (if B-encoding
-                  (save-excursion
-                    (goto-char start)
-                    (while (search-forward "\n" end t)
-                      (delete-char -1)))))
-             (error (vm-mime-error "%S" data))))
-          (t
-           (setq work-buffer (vm-make-work-buffer))
-           (if vm-mime-base64-encoder-program
-               (let ((status (apply 'vm-run-command-on-region
-                                    start end work-buffer
-                                    vm-mime-base64-encoder-program
-                                    vm-mime-base64-encoder-switches)))
-                 (if (not (eq status t))
-                     (vm-mime-error "base64-encode failed: %s" (cdr status)))
-                 (if B-encoding
-                     (with-current-buffer work-buffer
-                       ;; if we're B encoding, strip out the line breaks
-                       (goto-char (point-min))
-                       (while (search-forward "\n" nil t)
-                         (delete-char -1)))))
-             (setq inputpos start)
-             (while (< inputpos end)
-               (setq bits (+ bits (char-after inputpos)))
-               (vm-increment counter)
-               (cond ((= counter 3)
-                      (vm-insert-char (aref alphabet (lsh bits -18)) 1 nil
-                                      work-buffer)
-                      (vm-insert-char (aref alphabet (logand (lsh bits -12) 
63))
-                                      1 nil work-buffer)
-                      (vm-insert-char (aref alphabet (logand (lsh bits -6) 63))
-                                      1 nil work-buffer)
-                      (vm-insert-char (aref alphabet (logand bits 63)) 1 nil
-                                      work-buffer)
-                      (setq cols (+ cols 4))
-                      (cond ((= cols 72)
-                             (setq cols 0)
-                             (if (not B-encoding)
-                                 (vm-insert-char ?\n 1 nil work-buffer))))
-                      (setq bits 0 counter 0))
-                     (t (setq bits (lsh bits 8))))
-               (vm-increment inputpos))
-             ;; write out any remaining bits with appropriate padding
-             (if (= counter 0)
-                 nil
-               (setq bits (lsh bits (- 16 (* 8 counter))))
-               (vm-insert-char (aref alphabet (lsh bits -18)) 1 nil
-                               work-buffer)
-               (vm-insert-char (aref alphabet (logand (lsh bits -12) 63))
-                               1 nil work-buffer)
-               (if (= counter 1)
-                   (vm-insert-char ?= 2 nil work-buffer)
-                 (vm-insert-char (aref alphabet (logand (lsh bits -6) 63))
-                                 1 nil work-buffer)
-                 (vm-insert-char ?= 1 nil work-buffer)))
-             (if (> cols 0)
-                 (vm-insert-char ?\n 1 nil work-buffer)))
-           (or (markerp end) (setq end (vm-marker end)))
-           (goto-char start)
-           (insert-buffer-substring work-buffer)
-           (delete-region (point) end)))
-         (and (> (- end start) 200)
-              (vm-inform 7 "Encoding base64... done"))
-         (- end start))
-      (and work-buffer (kill-buffer work-buffer)))))
-
+  (let ((buffer-undo-list t)) ;; FIXME: Really?
+    (save-excursion
+      (and crlf (vm-mime-lf-to-crlf-region start end))
+      (condition-case data
+         (base64-encode-region start end B-encoding)
+       (wrong-number-of-arguments
+        ;; call with two args and then strip out the
+        ;; newlines if we're doing B encoding.
+        (condition-case data
+            (base64-encode-region start end)
+          (error (vm-mime-error "%S" data)))
+        (if B-encoding
+            (save-excursion
+              (goto-char start)
+              (while (search-forward "\n" end t)
+                (delete-char -1)))))
+       (error (vm-mime-error "%S" data)))
+      (and (> (- end start) 200)
+          (vm-inform 7 "Encoding base64... done"))
+      (- end start))))
+
+;; FIXME: Use `quoted-printable-decode-region'!
 (defun vm-mime-qp-decode-region (start end)
   (and (> (- end start) 10000)
        (vm-emit-mime-decoding-message "Decoding quoted-printable..."))
@@ -840,6 +695,7 @@ out includes base-64, quoted-printable, uuencode and CRLF 
conversion."
   (and (> (- end start) 10000)
        (vm-emit-mime-decoding-message "Decoding quoted-printable... done")))
 
+;; FIXME: Use `quoted-printable-encode-region'!
 (defun vm-mime-qp-encode-region (start end &optional Q-encoding quote-from)
   (and (> (- end start) 200)
        (vm-inform 7 "Encoding quoted-printable..."))