;;; mime.el,v 1.5 1992/07/18 07:52:08 by Enami Tsugutomo
;;;
+
;;; @ require modules
;;;
+
+(require 'emu)
+(require 'mel)
(require 'tl-header)
(require 'tl-str)
-(require 'tl-num)
-(if (not (fboundp 'member))
- (require 'tl-18)
- )
+(require 'tm-def)
;;; @ version
;;;
+
(defconst mime/RCS-ID
- "$Id: tiny-mime.el,v 5.16 1995/07/26 05:54:16 morioka Exp $")
+ "$Id: tiny-mime.el,v 6.7 1995/09/20 12:17:28 morioka Exp $")
(defconst mime/tiny-mime-version (get-version-string mime/RCS-ID))
;;; @ MIME encoded-word definition
;;;
-(defconst mime/charset-regexp "[A-Za-z0-9!#$%&'*+---^_`{}|~]")
(defconst mime/encoded-text-regexp "[!->@-~]+")
-
-(defconst mime/Base64-token-regexp "[A-Za-z0-9+/=]")
-(defconst mime/Base64-encoded-text-regexp
- (concat "\\("
- mime/Base64-token-regexp
- mime/Base64-token-regexp
- mime/Base64-token-regexp
- mime/Base64-token-regexp
- "\\)+"))
-(defconst mime/Base64-encoding-and-encoded-text-regexp
- (concat "\\(B\\)\\?" mime/Base64-encoded-text-regexp))
-
-(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-octet-regexp "\\)+"))
-(defconst mime/Quoted-Printable-encoding-and-encoded-text-regexp
- (concat "\\(Q\\)\\?" mime/Quoted-Printable-encoded-text-regexp))
-
(defconst mime/encoded-word-regexp (concat (regexp-quote "=?")
"\\("
mime/charset-regexp
- "+\\)"
+ "\\)"
(regexp-quote "?")
"\\(B\\|Q\\)"
(regexp-quote "?")
;;; @ variables
;;;
-(defvar mime/no-encoding-header-fields '("X-Nsubject"))
+(defvar mime/no-encoding-header-fields '("X-Nsubject" "Newsgroups"))
(defvar mime/use-X-Nsubject nil)
-;;; @ compatible module among Mule, NEmacs and NEpoch
-;;;
-(cond ((boundp 'MULE) (require 'tm-mule))
- ((boundp 'NEMACS)(require 'tm-nemacs))
- (t (require 'tm-orig))
- )
-
-
;;; @ Application Interface
;;;
;;; @@ MIME header decoders
;;;
-;; by mol. 1993/10/4
+(defun mime/decode-encoded-text (charset encoding str)
+ (let ((dest
+ (cond ((string= "B" encoding)
+ (base64-decode-string str))
+ ((string= "Q" encoding)
+ (q-encoding-decode-string str))
+ (t (message "unknown encoding %s" encoding)
+ nil))))
+ (if dest
+ (mime/convert-string-to-emacs charset dest)
+ )))
+
(defun mime/decode-encoded-word (word)
- (if (string-match mime/encoded-word-regexp word)
- (let ((charset (upcase (mime/encoded-word-charset word)))
- (encoding (mime/encoded-word-encoding word))
- (text (mime/encoded-word-encoded-text word)))
- (mime/decode-encoded-text charset encoding text))
- word))
+ (or (if (string-match mime/encoded-word-regexp word)
+ (let ((charset (upcase (mime/encoded-word-charset word)))
+ (encoding (upcase (mime/encoded-word-encoding word)))
+ (text (mime/encoded-word-encoded-text word)))
+ (mime/decode-encoded-text charset encoding text)
+ ))
+ word))
(defun mime/decode-region (beg end)
(interactive "*r")
)
)
(setq end (match-end 0))
- (setq dest (concat dest (mime/decode-encoded-word (substring str beg end))
+ (setq dest (concat dest
+ (mime/decode-encoded-word (substring str beg end))
))
(setq str (substring str end))
(setq ew t)
;;;
(defun mime/encode-string (string encoding &optional mode)
- (cond ((equal encoding "B") (mime/base64-encode-string string))
- ((equal encoding "Q") (mime/Quoted-Printable-encode-string string mode))
- (t nil)
+ (cond ((string= encoding "B") (base64-encode-string string))
+ ((string= encoding "Q") (q-encoding-encode-string string mode))
))
(defun mime/encode-field (str)
))
))
+(defun mime/exist-encoded-word-in-subject ()
+ (let ((str (message/get-field-body "Subject")))
+ (if (and str (string-match mime/encoded-word-regexp str))
+ str)))
+
(defun mime/encode-message-header ()
(interactive "*")
(save-excursion
(narrow-to-region (goto-char (point-min))
(progn
(re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "$")
+ (concat
+ "^" (regexp-quote mail-header-separator) "$")
nil t)
(match-beginning 0)
))
)))
))
(if mime/use-X-Nsubject
- (progn
- (goto-char (point-min))
- (if (re-search-forward "^Subject:.*\\(\n\\s +.*\\)*" nil t)
- (let ((str (buffer-substring (match-beginning 0)(match-end 0))))
- (if (string-match mime/encoded-word-regexp str)
- (insert (concat
- "\nX-Nsubject: "
- (nth 1 (message/divide-field
- (mime/decode-string
- (message/unfolding-string str))
- ))))
- ))
- )))
+ (let ((str (mime/exist-encoded-word-in-subject)))
+ (if str
+ (insert (concat
+ "\nX-Nsubject: "
+ (mime/decode-string (message/unfolding-string str))
+ )))))
)))
-;;; @ Base64 (B-encode) decoder/encoder
-;;; by Enami Tsugutomo
-;;; modified by mol.
-
-(defun mime/base64-decode-string (string)
- (mime/base64-mapconcat (function mime/base64-decode-chars) 4 string))
-
-;; (mime/base64-encode-string (mime/base64-decode-string "GyRAOjRGI0stGyhK"))
-(defun mime/base64-encode-string (string &optional mode)
- (let ((es (mime/base64-mapconcat (function mime/base64-encode-chars) 3 string))
- m)
- (setq m (mod (length es) 4))
- (concat es
- (cond ((= m 3) "=")
- ((= m 2) "==")
- ))
- ))
-
-;; (char-to-string (mime/base64-bit-to-char 26))
-(defun mime/base64-bit-to-char (n)
- (cond ((eq n nil) ?=)
- ((< n 26) (+ ?A n))
- ((< n 52) (+ ?a (- n 26)))
- ((< n 62) (+ ?0 (- n 52)))
- ((= n 62) ?+)
- ((= n 63) ?/)
- (t (error "not a base64 integer %d" n))))
-
-(defun mime/base64-char-to-bit (c)
- (cond ((and (<= ?A c) (<= c ?Z)) (- c ?A))
- ((and (<= ?a c) (<= c ?z)) (+ (- c ?a) 26))
- ((and (<= ?0 c) (<= c ?9)) (+ (- c ?0) 52))
- ((= c ?+) 62)
- ((= c ?/) 63)
- ((= c ?=) nil)
- (t (error "not a base64 character %c" c))))
-
-(defun mime/mask (i n) (logand i (1- (ash 1 n))))
-
-(defun mime/base64-encode-1 (a &optional b &optional c)
- (cons (ash a -2)
- (cons (logior (ash (mime/mask a 2) (- 6 2))
- (if b (ash b -4) 0))
- (if b
- (cons (logior (ash (mime/mask b 4) (- 6 4))
- (if c (ash c -6) 0))
- (if c
- (cons (mime/mask c (- 6 0))
- nil)))))))
-
-(defun mime/base64-decode-1 (a b &optional c &optional d)
- (cons (logior (ash a 2) (ash b (- 2 6)))
- (if c (cons (logior (ash (mime/mask b 4) 4)
- (mime/mask (ash c (- 4 6)) 4))
- (if d (cons (logior (ash (mime/mask c 2) 6) d)
- nil))))))
-
-;; (mime/base64-decode-chars ?G ?y ?R ?A)
-(defun mime/base64-decode-chars (a b c d)
- (apply (function mime/base64-decode-1)
- (mapcar (function mime/base64-char-to-bit)
- (list a b c d))))
-
-;; (mapcar (function char-to-string) (mime/base64-encode-chars 27 36 64))
-(defun mime/base64-encode-chars (a b c)
- (mapcar (function mime/base64-bit-to-char) (mime/base64-encode-1 a b c)))
-
-(defun mime/base64-fecth-from (func from pos len)
- (let (ret)
- (while (< 0 len)
- (setq len (1- len)
- ret (cons (funcall func from (+ pos len)) ret)))
- ret))
-
-(defun mime/base64-fecth-from-buffer (from pos len)
- (mime/base64-fecth-from (function (lambda (f p) (char-after p)))
- from pos len))
-
-(defun mime/base64-fecth-from-string (from pos len)
- (mime/base64-fecth-from (function (lambda (f p)
- (if (< p (length f)) (aref f p))))
- from pos len))
-
-(defun mime/base64-fecth (source pos len)
- (cond ((stringp source) (mime/base64-fecth-from-string source pos len))
- (t (mime/base64-fecth-from-buffer source pos len))))
-
-(defun mime/base64-mapconcat (func unit string)
- (let ((i 0) ret)
- (while (< i (length string))
- (setq ret
- (apply (function concat)
- ret
- (mapcar (function char-to-string)
- (apply func (mime/base64-fecth string i unit)))))
- (setq i (+ i unit)))
- ret))
-
-;;; @ Quoted-Printable (Q-encode) encoder/decoder
-;;;
-
-(defun mime/Quoted-Printable-decode-string (str)
- (let ((dest "")
- (len (length str))
- (i 0) chr num h l)
- (while (< i len)
- (setq chr (elt str i))
- (cond ((eq chr ?=)
- (if (< (+ i 2) len)
- (progn
- (setq h (hex-char-to-number (elt str (+ i 1))))
- (setq l (hex-char-to-number (elt str (+ i 2))))
- (setq num (+ (* h 16) l))
- (setq dest (concat dest (char-to-string num)))
- (setq i (+ i 3))
- )
- (progn
- (setq dest (concat dest (char-to-string chr)))
- (setq i (+ i 1))
- )))
- ((eq chr ?_)
- (setq dest (concat dest (char-to-string 32)))
- (setq i (+ i 1))
- )
- (t
- (setq dest (concat dest (char-to-string chr)))
- (setq i (+ i 1))
- ))
- )
- dest))
-
-(defun mime/Quoted-Printable-encode-string (str &optional mode)
- (if (null mode)
- (setq mode 'phrase))
- (let ((dest "")
- (len (length str))
- (i 0) chr)
- (while (< i len)
- (setq chr (elt str i))
- (cond ((eq chr 32)
- (setq dest (concat dest "_"))
- )
- ((or (eq chr ?=)
- (eq chr ??)
- (eq chr ?_)
- (and (eq mode 'comment)
- (or (eq chr ?\()
- (eq chr ?\))
- (eq chr ?\\)
- ))
- (and (eq mode 'phrase)
- (not (string-match "[A-Za-z0-9!*+/=_---]"
- (char-to-string chr)))
- )
- (< chr 32)
- (> chr 126))
- (setq dest (concat dest
- "="
- (char-to-string (number-to-hex-char (/ chr 16)))
- (char-to-string (number-to-hex-char (% chr 16)))
- ))
- )
- (t (setq dest (concat dest (char-to-string chr)))
- ))
- (setq i (+ i 1))
- )
- dest))
;;; @ functions for message header encoding
;;;
(while (and (< i len)
(setq js (mime/convert-string-from-emacs
(substring string 0 i) charset))
- (setq m (+ n (mime/encoded-word-length js encoding) cesl))
+ (setq m (+ n
+ (mime/encoded-word-length js encoding)
+ cesl))
(< m 76))
(setq j i)
(setq i (+ i (char-bytes (elt string i))))
(defun mime/encode-header-word (n string charset encoding)
(let (dest str ret m)
- (if (null (setq ret (mime/encode-and-split-string n string charset encoding)))
+ (if (null (setq ret
+ (mime/encode-and-split-string n string charset encoding)))
nil
(progn
(setq dest (nth 1 ret))
(setq m (car ret))
(setq str (nth 2 ret))
(while (and (stringp str)
- (setq ret (mime/encode-and-split-string 1 str charset encoding))
+ (setq ret
+ (mime/encode-and-split-string
+ 1 str charset encoding))
)
(setq dest (concat dest "\n " (nth 1 ret)))
(setq m (car ret))
(let (field beg end)
(while (re-search-forward message/field-name-regexp nil t)
(setq beg (match-beginning 0))
- (setq end (progn
- (if (re-search-forward "\n[!-9;-~]+:" nil t)
- (goto-char (match-beginning 0))
- (if (re-search-forward "^$" nil t)
- (goto-char (1- (match-beginning 0)))
- (end-of-line)
- ))
- (point)
- ))
+ (setq end (message/field-end))
(setq field (buffer-substring beg end))
(if (string-match mime/encoded-word-regexp field)
(save-restriction
projects / elisp / tm.git / blobdiff