;; Don't decode
(insert-buffer-substring src-buf p end)
)
- ((memq field-name eword-decode-structured-field-list)
+ ((memq field eword-decode-structured-field-list)
;; Decode as structured field
(let ((body (save-excursion
(set-buffer src-buf)
(base64-num-to-char (ash (logand a 3) 4))) "==")
))))
-(defun base64-decode-1 (pack)
- (let ((a (base64-char-to-num (car pack)))
- (b (base64-char-to-num (nth 1 pack)))
- (c (nth 2 pack))
- (d (nth 3 pack)))
- (concat (char-to-string (logior (ash a 2) (ash b -4)))
- (if (and c (setq c (base64-char-to-num c)))
- (concat (char-to-string
- (logior (ash (logand b 15) 4) (ash c -2)))
- (if (and d (setq d (base64-char-to-num d)))
- (char-to-string (logior (ash (logand c 3) 6) d))
- ))))))
+(defun base64-decode-unit (a b &optional c d)
+ (condition-case err
+ (concat
+ (char-to-string (logior (ash (base64-char-to-num a) 2)
+ (ash (setq b (base64-char-to-num b)) -4)))
+ (if (and c (setq c (base64-char-to-num c)))
+ (concat (char-to-string
+ (logior (ash (logand b 15) 4) (ash c -2)))
+ (if (and d (setq d (base64-char-to-num d)))
+ (char-to-string (logior (ash (logand c 3) 6) d))
+ ))))
+ (error (message (nth 1 err))
+ "")))
;;; @@ base64 encoder/decoder for string
))
)))
-(defun base64-decode-string (string)
- "Decode STRING which is encoded in base64, and return the result."
- (mapconcat (function base64-decode-1)
- (pack-sequence string 4)
- ""))
+(defun base64-internal-decode-string (string)
+ (let ((len (length string))
+ (i 0)
+ dest)
+ (while (< i len)
+ (let ((a (aref string i)))
+ (setq i (1+ i))
+ (unless (eq a ?\n)
+ (let ((b (aref string i)))
+ (setq i (1+ i))
+ (cond
+ ((eq b ?\n)
+ ;; invalid
+ )
+ ((>= i len)
+ (setq dest (concat dest (base64-decode-unit a b) ))
+ )
+ (t
+ (let ((c (aref string i)))
+ (setq i (1+ i))
+ (cond
+ ((eq c ?\n)
+ (setq dest (concat dest (base64-decode-unit a b)))
+ )
+ ((>= i len)
+ (setq dest (concat dest (base64-decode-unit a b c)))
+ )
+ (t
+ (let ((d (aref string i)))
+ (setq i (1+ i))
+ (setq dest
+ (concat dest
+ (if (eq c ?\n)
+ (base64-decode-unit a b c)
+ (base64-decode-unit a b c d))))
+ ))))))))))
+ dest))
;;; @ base64 encoder/decoder for region
(defun base64-internal-decode-region (beg end)
(save-excursion
- (save-restriction
- (narrow-to-region beg end)
- (goto-char (point-min))
- (while (looking-at ".*\n")
- (condition-case err
- (replace-match
- (base64-decode-string
- (buffer-substring (match-beginning 0) (1- (match-end 0))))
- t t)
- (error
- (prog1
- (message (nth 1 err))
- (replace-match "")))))
- (if (looking-at ".*$")
- (condition-case err
- (replace-match
- (base64-decode-string
- (buffer-substring (match-beginning 0) (match-end 0)))
- t t)
- (error
- (prog1
- (message (nth 1 err))
- (replace-match "")))
- ))
- )))
+ (let ((str (buffer-substring beg end)))
+ (delete-region beg end)
+ (goto-char beg)
+ (insert (base64-internal-decode-string str)))))
(defun base64-external-encode-region (beg end)
(save-excursion
t t nil (cdr base64-external-decoder))
)))
+(defun base64-external-decode-string (string)
+ (with-temp-buffer
+ (insert string)
+ (as-binary-process (apply (function call-process-region)
+ (point-min) (point-max)
+ (car base64-external-decoder)
+ t t nil (cdr base64-external-decoder))
+ )
+ (buffer-string)))
+
+
(defun base64-encode-region (start end)
"Encode current region by base64.
START and END are buffer positions.
(base64-internal-decode-region start end)
))
+(defun base64-decode-string (string)
+ "Decode STRING which is encoded in base64, and return the result.
+This function calls internal base64 decoder if size of STRING is
+smaller than `base64-internal-decoding-limit', otherwise it calls
+external base64 decoder specified by `base64-external-decoder'. In
+this case, you must install the program (maybe mmencode included in
+metamail or XEmacs package)."
+ (interactive "r")
+ (if (and base64-internal-decoding-limit
+ (> (length string) base64-internal-decoding-limit))
+ (base64-external-decode-string string)
+ (base64-internal-decode-string string)
+ ))
+
;;; @ base64 encoder/decoder for file
;;;
;;; @ Quoted-Printable decoder
;;;
-(defun quoted-printable-decode-string (string)
- "Decode STRING which is encoded in quoted-printable, and return the result."
- (let (q h l)
- (mapconcat (function
- (lambda (chr)
- (cond ((eq chr ?=)
- (setq q t)
- "")
- (q (setq h
- (cond ((<= ?a chr) (+ (- chr ?a) 10))
- ((<= ?A chr) (+ (- chr ?A) 10))
- ((<= ?0 chr) (- chr ?0))
- ))
- (setq q nil)
- "")
- (h (setq l (cond ((<= ?a chr) (+ (- chr ?a) 10))
- ((<= ?A chr) (+ (- chr ?A) 10))
- ((<= ?0 chr) (- chr ?0))
- ))
- (prog1
- (char-to-string (logior (ash h 4) l))
- (setq h nil)
- )
- )
- (t (char-to-string chr))
- )))
- string "")))
+(defsubst quoted-printable-hex-char-to-num (chr)
+ (cond ((<= ?a chr) (+ (- chr ?a) 10))
+ ((<= ?A chr) (+ (- chr ?A) 10))
+ ((<= ?0 chr) (- chr ?0))
+ ))
(defun quoted-printable-internal-decode-region (start end)
(save-excursion
(save-restriction
(narrow-to-region start end)
(goto-char (point-min))
- (while (re-search-forward "=\n" nil t)
- (replace-match "")
- )
- (goto-char (point-min))
- (let (b e str)
- (while (re-search-forward quoted-printable-octet-regexp nil t)
- (setq b (match-beginning 0))
- (setq e (match-end 0))
- (setq str (buffer-substring b e))
- (delete-region b e)
- (insert (string-as-multibyte (quoted-printable-decode-string str)))
- ))
- )))
-
+ (while (search-forward "=" nil t)
+ (let ((beg (match-beginning 0)))
+ (cond ((looking-at "\n")
+ (delete-region beg (match-end 0))
+ )
+ ((looking-at
+ `,(concat "[" quoted-printable-hex-chars
+ "][" quoted-printable-hex-chars "]"))
+ (let* ((end (match-end 0))
+ (hex (buffer-substring (match-beginning 0) end)))
+ (delete-region beg end)
+ (insert
+ (logior
+ (ash (quoted-printable-hex-char-to-num (aref hex 0)) 4)
+ (quoted-printable-hex-char-to-num (aref hex 1))))
+ ))
+ (t
+ ;; invalid
+ ))
+ )))))
(defvar quoted-printable-external-decoder '("mmencode" "-q" "-u")
"*list of quoted-printable decoder program name and its arguments.")
(quoted-printable-internal-decode-region start end)
))
+(defun quoted-printable-decode-string (string)
+ "Decode STRING which is encoded in quoted-printable, and return the result."
+ (with-temp-buffer
+ (insert string)
+ (quoted-printable-decode-region (point-min)(point-max))
+ (buffer-string)))
+
(defvar quoted-printable-external-decoder-option-to-specify-file '("-o")
"*list of options of quoted-printable decoder program to specify file.")
((eq chr ?=)
(setq q t)
"")
- (q (setq h (cond ((<= ?a chr) (+ (- chr ?a) 10))
- ((<= ?A chr) (+ (- chr ?A) 10))
- ((<= ?0 chr) (- chr ?0))
- ))
+ (q (setq h (quoted-printable-hex-char-to-num chr))
(setq q nil)
"")
- (h (setq l (cond ((<= ?a chr) (+ (- chr ?a) 10))
- ((<= ?A chr) (+ (- chr ?A) 10))
- ((<= ?0 chr) (- chr ?0))
- ))
+ (h (setq l (quoted-printable-hex-char-to-num chr))
(prog1
(char-to-string (logior (ash h 4) l))
(setq h nil)
(require 'emu)
-(defconst mel-version "7.5")
-
;;; @ variable
;;;
)))
+;;; @ string
+;;;
+
+;;;###autoload
+(defvar mime-string-decoding-method-alist
+ '(("base64" . base64-decode-string)
+ ("quoted-printable" . quoted-printable-decode-string)
+ ("7bit" . identity)
+ ("8bit" . identity)
+ ("binary" . identity)
+ )
+ "Alist of encoding vs. corresponding method to decode string.
+Each element looks like (STRING . FUNCTION).
+STRING is content-transfer-encoding.
+FUNCTION is string decoder.")
+
+;;;###autoload
+(defun mime-decode-string (string encoding)
+ "Decode STRING using ENCODING.
+ENCODING must be string. If ENCODING is found in
+`mime-string-decoding-method-alist' as its key, this function decodes
+the STRING by its value."
+ (let ((f (cdr (assoc encoding mime-string-decoding-method-alist))))
+ (if f
+ (funcall f string)
+ (with-temp-buffer
+ (insert string)
+ (mime-decode-region (point-min)(point-max) encoding)
+ (buffer-string)
+ ))))
+
+
;;; @ file
;;;
projects / elisp / flim.git / commitdiff