-;;
-;; A multilingual MIME message header encoder/decoder.
-;; by Morioka Tomohiko (morioka@jaist.ac.jp)
-;;
-;; original MIME decoder is
-;; mime.el,v 1.5 1992/07/18 07:52:08 by Enami Tsugutomo
-;;
+;;;
+;;; A multilingual MIME message header encoder/decoder.
+;;; by Morioka Tomohiko (morioka@jaist.ac.jp)
+;;;
+;;; original MIME decoder is
+;;; mime.el,v 1.5 1992/07/18 07:52:08 by Enami Tsugutomo
+;;;
-(provide 'tiny-mime)
+;;; @ require modules
+;;;
+(require 'tl-header)
+(require 'tl-str)
+(require 'tl-num)
+(if (not (fboundp 'member))
+ (require 'tl-18)
+ )
-(defconst mime/RCS-ID
- "$Id: tiny-mime.el,v 4.7 1994/08/03 05:40:35 morioka Exp $")
-(defconst mime/tiny-mime-version
- (and (string-match "[0-9][0-9.]*" mime/RCS-ID)
- (substring mime/RCS-ID (match-beginning 0)(match-end 0))
- ))
+;;; @ version
+;;;
+(defconst mime/RCS-ID
+ "$Id: tiny-mime.el,v 5.12 1995/05/21 16:06:27 morioka Exp $")
-(require 'tl-header)
+(defconst mime/tiny-mime-version (get-version-string mime/RCS-ID))
;;; @ MIME encoded-word definition
(defconst mime/Base64-encoding-and-encoded-text-regexp
(concat "\\(B\\)\\?" mime/Base64-encoded-text-regexp))
-(defconst mime/Quoted-Printable-hex-char "[0123456789ABCDEF]")
+(defconst mime/Quoted-Printable-hex-char-regexp "[0123456789ABCDEF]")
+(defconst mime/Quoted-Printable-octet-regexp
+ (concat "="
+ mime/Quoted-Printable-hex-char-regexp
+ mime/Quoted-Printable-hex-char-regexp))
(defconst mime/Quoted-Printable-encoded-text-regexp
- (concat "\\([^=?_]\\|="
- mime/Quoted-Printable-hex-char
- mime/Quoted-Printable-hex-char
- "\\)+"))
+ (concat "\\([^=?]\\|" mime/Quoted-Printable-octet-regexp "\\)+"))
(defconst mime/Quoted-Printable-encoding-and-encoded-text-regexp
(concat "\\(Q\\)\\?" mime/Quoted-Printable-encoded-text-regexp))
(defun mime/rest-of-string (str)
(if (stringp str)
(substring str (match-end 0))
- (buffer-substring (match-end 0))))
+ (buffer-substring (match-end 0)(point-max))
+ ))
+
;;; @ variables
;;;
field-name field-body)
(setq field-name (car ret))
(setq field-body (nth 1 ret))
- (if (string= field-body "")
- field-name
- (concat field-name " "
- (if (or (string-match "^Reply-To:$" field-name)
- (string-match "^From:$" field-name)
- (string-match "^Sender:$" field-name)
- (string-match "^Resent-Reply-To:$" field-name)
- (string-match "^Resent-From:$" field-name)
- (string-match "^Resent-Sender:$" field-name)
- (string-match "^To:$" field-name)
- (string-match "^Resent-To:$" field-name)
- (string-match "^cc:$" field-name)
- (string-match "^Resent-cc:$" field-name)
- (string-match "^bcc:$" field-name)
- (string-match "^Resent-bcc:$" field-name)
- )
- (mime/encode-address-list (+ (length field-name) 1)
- field-body)
- (catch 'label
- (let ((i 0)
- (n (length mime/no-encoding-header-fields))
- fn)
- (while (< i n)
- (setq fn (nth i mime/no-encoding-header-fields))
- (if (string-match (concat "^" fn ":$") field-name)
- (progn
- (throw 'label field-body)
- ))
- (setq i (+ i 1))
- )
- (nth 1 (mime/encode-header-string (+ (length field-name) 1)
- field-body))
- ))
- ))
- )))
+ (concat field-name " "
+ (cond ((string= field-body "") "")
+ ((or (string-match "^Reply-To:$" field-name)
+ (string-match "^From:$" field-name)
+ (string-match "^Sender:$" field-name)
+ (string-match "^Resent-Reply-To:$" field-name)
+ (string-match "^Resent-From:$" field-name)
+ (string-match "^Resent-Sender:$" field-name)
+ (string-match "^To:$" field-name)
+ (string-match "^Resent-To:$" field-name)
+ (string-match "^cc:$" field-name)
+ (string-match "^Resent-cc:$" field-name)
+ (string-match "^bcc:$" field-name)
+ (string-match "^Resent-bcc:$" field-name)
+ )
+ (mime/encode-address-list
+ (+ (length field-name) 1) field-body)
+ )
+ (t
+ (catch 'tag
+ (let ((r mime/no-encoding-header-fields) fn)
+ (while r
+ (setq fn (car r))
+ (if (string-match (concat "^" fn ":$") field-name)
+ (throw 'tag field-body)
+ )
+ (setq r (cdr r))
+ ))
+ (nth 1 (mime/encode-header-string
+ (+ (length field-name) 1) field-body))
+ ))
+ ))
+ ))
(defun mime/encode-message-header ()
(interactive "*")
))
(defun mime/encode-header-string (n string &optional mode)
- (let ((ssl (mime/separate-string-for-encoder string))
- i len cell et w ew (dest "") b l)
- (setq len (length ssl))
- (setq cell (nth 0 ssl))
- (setq et (car cell))
- (setq w (cdr cell))
- (if (eq et nil)
- (progn
- (if (> (+ n (string-width w)) 76)
- (progn
- (setq dest (concat dest "\n "))
- (setq b 1)
- )
- (setq b n))
- (setq dest (concat dest w))
- (setq b (+ b (string-width w)))
- )
- (progn
- (setq ew (mime/encode-header-word n (cdr cell) (car et) (cdr et)))
- (setq dest (nth 1 ew))
- (setq b (car ew))
- ))
- (setq i 1)
- (while (< i len)
- (setq cell (nth i ssl))
+ (if (string= string "")
+ (list n "")
+ (let ((ssl (mime/separate-string-for-encoder string))
+ i len cell et w ew (dest "") b l)
+ (setq len (length ssl))
+ (setq cell (nth 0 ssl))
(setq et (car cell))
- (setq w (cdr cell))
- (cond ((string-match "^[ \t]*$" w)
- (setq b (+ b (string-width (cdr cell))))
- (setq dest (concat dest (cdr cell)))
- )
- ((eq et nil)
- (if (> (+ b (string-width w)) 76)
- (progn
- (if (eq (elt dest (- (length dest) 1)) 32)
- (setq dest (substring dest 0 (- (length dest) 1)))
+ ;; string-width crashes when the argument is nil,
+ ;; so replace the argument
+ ;; (original modification by Kenji Rikitake 9-JAN-1995)
+ (setq w (or (cdr cell) ""))
+ (if (eq et nil)
+ (progn
+ (if (> (+ n (string-width w)) 76)
+ (progn
+ (setq dest (concat dest "\n "))
+ (setq b 1)
+ )
+ (setq b n))
+ (setq dest (concat dest w))
+ (setq b (+ b (string-width w)))
+ )
+ (progn
+ (setq ew (mime/encode-header-word n (cdr cell) (car et) (cdr et)))
+ (setq dest (nth 1 ew))
+ (setq b (car ew))
+ ))
+ (setq i 1)
+ (while (< i len)
+ (setq cell (nth i ssl))
+ (setq et (car cell))
+ (setq w (cdr cell))
+ (cond ((string-match "^[ \t]*$" w)
+ (setq b (+ b (string-width (cdr cell))))
+ (setq dest (concat dest (cdr cell)))
+ )
+ ((eq et nil)
+ (if (> (+ b (string-width w)) 76)
+ (progn
+ (if (eq (elt dest (- (length dest) 1)) 32)
+ (setq dest (substring dest 0 (- (length dest) 1)))
+ )
+ (setq dest (concat dest "\n " w))
+ (setq b (+ (length w) 1))
)
- (setq dest (concat dest "\n " w))
- (setq b (+ (length w) 1))
- )
- (setq l (length dest))
- (if (and (>= l 2)
- (eq (elt dest (- l 2)) ?\?)
- (eq (elt dest (- l 1)) ?=)
- )
+ (setq l (length dest))
+ (if (and (>= l 2)
+ (eq (elt dest (- l 2)) ?\?)
+ (eq (elt dest (- l 1)) ?=)
+ )
+ (progn
+ (setq dest (concat dest " "))
+ (setq b (+ b 1))
+ ))
+ (setq dest (concat dest w))
+ (setq b (+ b (string-width w)))
+ ))
+ (t
+ (if (not (eq (elt dest (- (length dest) 1)) 32))
(progn
(setq dest (concat dest " "))
(setq b (+ b 1))
))
- (setq dest (concat dest w))
- (setq b (+ b (string-width w)))
+ (setq ew
+ (mime/encode-header-word b (cdr cell) (car et) (cdr et)))
+ (setq b (car ew))
+ (if (string-match "^\n" (nth 1 ew))
+ (setq dest (concat (substring dest 0 (- (length dest) 1))
+ (nth 1 ew)))
+ (setq dest (concat dest (nth 1 ew)))
+ )
))
- (t
- (if (not (eq (elt dest (- (length dest) 1)) 32))
- (progn
- (setq dest (concat dest " "))
- (setq b (+ b 1))
- ))
- (setq ew (mime/encode-header-word b (cdr cell) (car et) (cdr et)))
- (setq b (car ew))
- (if (string-match "^\n" (nth 1 ew))
- (setq dest (concat (substring dest 0 (- (length dest) 1))
- (nth 1 ew)))
- (setq dest (concat dest (nth 1 ew)))
- )
- ))
- (setq i (+ i 1))
- )
- (list b dest)))
+ (setq i (+ i 1))
+ )
+ (list b dest)
+ )))
(defun mime/encode-address-list (n str)
- (let ((ret (message/parse-addresses str))
- len (i 0) cell en-ret j cl (dest "") s)
- (setq len (length ret))
- (while (< i len)
- (setq cell (nth i ret))
+ (let* ((ret (message/parse-addresses str))
+ (r ret) cell en-ret j cl (dest "") s)
+ (while r
+ (setq cell (car r))
(cond ((string= (nth 1 cell) "<")
(setq en-ret (mime/encode-header-string n (nth 0 cell) 'phrase))
(setq dest (concat dest (nth 1 en-ret)))
(setq n (car en-ret))
- (if (< i (- len 1))
- (setq en-ret
+ (if (> (length r) 1)
+ (setq en-ret
(mime/encode-header-string
n (concat (nth 1 cell)(nth 2 cell)(nth 3 cell) ", ")))
(setq en-ret (mime/encode-header-string
(setq dest (concat dest (nth 1 en-ret)))
(setq n (car en-ret))
- (setq en-ret (mime/encode-header-string (+ n 2) (nth 2 cell) 'comment))
+ (setq en-ret (mime/encode-header-string (+ n 2) (nth 2 cell)
+ 'comment))
(if (eq (elt (nth 1 en-ret) 0) ?\n)
(progn
(setq dest (concat dest "\n ("))
- (setq en-ret (mime/encode-header-string 2 (nth 2 cell) 'comment))
+ (setq en-ret (mime/encode-header-string 2 (nth 2 cell)
+ 'comment))
)
(progn
(setq dest (concat dest " ("))
))
(setq dest (concat dest (nth 1 en-ret)))
(setq n (car en-ret))
- (if (< i (- len 1))
+ (if (> (length r) 1)
(setq en-ret
- (mime/encode-header-string n (concat (nth 3 cell) ", ")))
+ (mime/encode-header-string n (concat (nth 3 cell) ", "))
+ )
(setq en-ret (mime/encode-header-string n (nth 3 cell)))
)
(setq dest (concat dest (nth 1 en-ret)))
(setq n (car en-ret))
)
(t
- (if (< i (- len 1))
+ (if (> (length r) 1)
(setq en-ret
- (mime/encode-header-string n (concat (nth 0 cell) ", ")))
+ (mime/encode-header-string n (concat (nth 0 cell) ", "))
+ )
(setq en-ret (mime/encode-header-string n (nth 0 cell)))
)
(setq dest (concat dest (nth 1 en-ret)))
(setq n (car en-ret))
))
- (setq i (+ i 1)) )
+ (setq r (cdr r))
+ )
dest))
-;;; @ utility functions
-;;;
-
-;; by mol. 1993/10/4
-(defun hex-char-to-number (chr)
- (cond ((and (<= ?0 chr)(<= chr ?9)) (- chr ?0))
- ((and (<= ?A chr)(<= chr ?F)) (+ (- chr ?A) 10))
- ((and (<= ?a chr)(<= chr ?f)) (+ (- chr ?a) 10))
- ))
-
-(defun number-to-hex-char (n)
- (if (< n 10)
- (+ ?0 n)
- (+ ?A (- n 10))))
-
;;; @ utility for encoder
;;;
(defun mime/char-type (chr)
(if (or (= chr 32)(= chr ?\t))
LC-space
- (mime/char-leading-char chr)
+ (get-lc chr)
))
(defun mime/separate-string-by-chartype (string)
(dest nil) (ds "") s
pcs i j cs chr)
(if (= len 0) nil
- (progn (setq chr (elt string 0))
- (setq pcs (mime/char-type chr))
- (setq i (char-bytes chr))
- (setq ds (substring string 0 i))
- (while (< i len)
- (setq chr (elt string i))
- (setq cs (mime/char-type chr))
- (setq j (+ i (char-bytes chr)))
- (setq s (substring string i j))
- (setq i j)
- (if (= cs pcs)
- (setq ds (concat ds s))
- (progn (setq dest (append dest (list (cons pcs ds))))
- (setq pcs cs)
- (setq ds s)
- ))
- )
- (if (not (string= ds ""))
- (setq dest (append dest (list (cons pcs ds)))))
- dest)
+ (progn
+ (setq chr (elt string 0))
+ (setq pcs (mime/char-type chr))
+ (setq i (char-bytes chr))
+ (setq ds (substring string 0 i))
+ (while (< i len)
+ (setq chr (elt string i))
+ (setq cs (mime/char-type chr))
+ (setq j (+ i (char-bytes chr)))
+ (setq s (substring string i j))
+ (setq i j)
+ (if (= cs pcs)
+ (setq ds (concat ds s))
+ (progn (setq dest (append dest (list (cons pcs ds))))
+ (setq pcs cs)
+ (setq ds s)
+ ))
+ )
+ (if (not (string= ds ""))
+ (setq dest (append dest (list (cons pcs ds)))))
+ dest)
)))
(defun mime/separate-string-by-charset (str)
(run-hooks 'mime/tiny-mime-load-hook)
+(provide 'tiny-mime)
+
;;; @
;;; Local Variables:
;;; mode: emacs-lisp
projects / elisp / tm.git / blobdiff