;;; eword-encode.el --- RFC 2047 based encoded-word encoder for GNU Emacs
-;; Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc.
+;; Copyright (C) 1995,1996,1997,1998,1999 Free Software Foundation, Inc.
;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
;; Keywords: encoded-word, MIME, multilingual, header, mail, news
;;; Code:
-(require 'emu)
+(require 'poem)
(require 'mel)
(require 'std11)
(require 'mime-def)
(cn-gb . "B")
(cn-gb-2312 . "B")
(euc-kr . "B")
+ (tis-620 . "B")
(iso-2022-jp-2 . "B")
(iso-2022-int-1 . "B")
+ (utf-8 . "B")
))
ENCODING allows \"B\" or \"Q\".
MODE is allows `text', `comment', `phrase' or nil. Default value is
`phrase'."
- (let ((text
- (cond ((string= encoding "B")
- (base64-encode-string string))
- ((string= encoding "Q")
- (q-encoding-encode-string string mode))
- )
- ))
+ (let ((text (encoded-text-encode-string string encoding)))
(if text
(concat "=?" (upcase (symbol-name charset)) "?"
encoding "?" text "?=")
;;;
(defsubst eword-encode-char-type (character)
- (if (or (eq character ? )(eq character ?\t))
+ (if (memq character '(? ?\t ?\n))
nil
(char-charset character)
))
)
((string-equal encoding "Q")
(setq string (encode-mime-charset-string string charset))
- (q-encoding-encoded-length string
- (ew-rword-type rword))
+ (Q-encoded-text-length string (ew-rword-type rword))
)))
(if ret
(cons (+ 7 (length (symbol-name charset)) ret) string)
))
(defun eword-encode-rword-list (column rwl)
- (let (ret dest ps special str ew-f pew-f)
+ (let (ret dest ps special str ew-f pew-f bew)
(while rwl
(setq ew-f (nth 2 (car rwl)))
(if (and pew-f ew-f)
(setq rwl (cons '(" ") rwl)
+ bew t
pew-f nil)
- (setq pew-f ew-f)
+ (setq pew-f ew-f
+ bew nil)
)
(setq ret (tm-eword::encode-string-1 column rwl))
(setq str (car ret))
(if (eq (elt str 0) ?\n)
- (if (eq special ?\()
- (progn
- (setq dest (concat dest "\n ("))
- (setq ret (tm-eword::encode-string-1 2 rwl))
- (setq str (car ret))
- ))
+ (cond
+ ((eq special ?\()
+ (setq dest (concat dest "\n ("))
+ (setq ret (tm-eword::encode-string-1 2 rwl))
+ (setq str (car ret)))
+ ((eq bew t)
+ (setq dest (concat dest "\n "))
+ (setq ret (tm-eword::encode-string-1 1 (cdr rwl)))
+ (setq str (car ret))))
(cond ((eq special ? )
(if (string= str "(")
(setq ps t)
(let ((phrase (nth 1 phrase-route-addr))
(route (nth 2 phrase-route-addr))
dest)
- (if (eq (car (car phrase)) 'spaces)
- (setq phrase (cdr phrase))
- )
+ ;; (if (eq (car (car phrase)) 'spaces)
+ ;; (setq phrase (cdr phrase))
+ ;; )
(setq dest (eword-encode-phrase-to-rword-list phrase))
(if dest
(setq dest (append dest '((" " nil nil))))
'((" " nil nil)
("(" nil nil))
(eword-encode-split-string comment 'comment)
- '((")" nil nil))
+ (list '(")" nil nil))
)))
dest))
(if dest
(while (setq addresses (cdr addresses))
(setq dest
- (append dest
- '(("," nil nil))
- '((" " nil nil))
- (eword-encode-mailbox-to-rword-list (car addresses))
- ))
+ (nconc dest
+ (list '("," nil nil))
+ ;; (list '(" " nil nil))
+ (eword-encode-mailbox-to-rword-list (car addresses))
+ ))
))
dest))
(defsubst eword-encode-msg-id-to-rword-list (msg-id)
- (cons '("<" nil nil)
- (append (eword-encode-addr-seq-to-rword-list (cdr msg-id))
- '((">" nil nil)))))
+ (list
+ (list
+ (concat "<"
+ (caar (eword-encode-addr-seq-to-rword-list (cdr msg-id)))
+ ">")
+ nil nil)))
(defsubst eword-encode-in-reply-to-to-rword-list (in-reply-to)
(let (dest)
(car (eword-encode-rword-list
(or column 13)
(eword-encode-in-reply-to-to-rword-list
- (std11-parse-in-reply-to
- (std11-lexical-analyze string))))))
+ (std11-parse-msg-ids-string string)))))
(defun eword-encode-structured-field-body (string &optional column)
"Encode header field STRING as structured field, and return the result.
(or column eword-encode-default-start-column)
(eword-encode-split-string string 'text))))
-(defun eword-encode-field (string)
- "Encode header field STRING, and return the result.
+(defun eword-encode-field-body (field-body field-name)
+ "Encode FIELD-BODY as FIELD-NAME, and return the result.
A lexical token includes non-ASCII character is encoded as MIME
encoded-word. ASCII token is not encoded."
- (setq string (std11-unfold-string string))
- (let ((ret (string-match std11-field-head-regexp string)))
- (or (if ret
- (let ((field-name (substring string 0 (1- (match-end 0))))
- (field-body (eliminate-top-spaces
- (substring string (match-end 0))))
- field-name-symbol)
- (if (setq ret
- (cond ((string= field-body "") "")
- ((memq (setq field-name-symbol
- (intern (capitalize field-name)))
- '(Reply-To
- From Sender
- Resent-Reply-To Resent-From
- Resent-Sender To Resent-To
- Cc Resent-Cc Bcc Resent-Bcc
- Dcc))
- (eword-encode-address-list
- field-body (+ (length field-name) 2))
- )
- ((eq field-name-symbol 'In-Reply-To)
- (eword-encode-in-reply-to
- field-body (+ (length field-name) 2))
- )
- ((memq field-name-symbol
- '(Mime-Version User-Agent))
- (eword-encode-structured-field-body
- field-body (+ (length field-name) 2))
- )
- (t
- (eword-encode-unstructured-field-body
- field-body (1+ (length field-name)))
- ))
- )
- (concat field-name ": " ret)
- )))
- (eword-encode-string string 0)
- )))
+ (setq field-body (std11-unfold-string field-body))
+ (if (string= field-body "")
+ ""
+ (let (start)
+ (if (symbolp field-name)
+ (setq start (1+ (length (symbol-name field-name))))
+ (setq start (1+ (length field-name))
+ field-name (intern (capitalize field-name))))
+ (cond ((memq field-name
+ '(Reply-To
+ From Sender
+ Resent-Reply-To Resent-From
+ Resent-Sender To Resent-To
+ Cc Resent-Cc Bcc Resent-Bcc
+ Dcc))
+ (eword-encode-address-list field-body start)
+ )
+ ((eq field-name 'In-Reply-To)
+ (eword-encode-in-reply-to field-body start)
+ )
+ ((memq field-name '(Mime-Version User-Agent))
+ (eword-encode-structured-field-body field-body start)
+ )
+ (t
+ (eword-encode-unstructured-field-body field-body start)
+ ))
+ )))
(defun eword-in-subject-p ()
(let ((str (std11-field-body "Subject")))
(std11-narrow-to-header mail-header-separator)
(goto-char (point-min))
(let ((default-cs (mime-charset-to-coding-system default-mime-charset))
- beg end field-name)
+ bbeg end field-name)
(while (re-search-forward std11-field-head-regexp nil t)
- (setq beg (match-beginning 0))
- (setq field-name (buffer-substring beg (1- (match-end 0))))
- (setq end (std11-field-end))
- (and (find-non-ascii-charset-region beg end)
+ (setq bbeg (match-end 0)
+ field-name (buffer-substring (match-beginning 0) (1- bbeg))
+ end (std11-field-end))
+ (and (find-non-ascii-charset-region bbeg end)
(let ((method (eword-find-field-encoding-method
(downcase field-name))))
(cond ((eq method 'mime)
- (let ((field
- (buffer-substring-no-properties beg end)
+ (let ((field-body
+ (buffer-substring-no-properties bbeg end)
))
- (delete-region beg end)
- (insert (eword-encode-field field))
+ (delete-region bbeg end)
+ (insert (eword-encode-field-body field-body
+ field-name))
))
(code-conversion
(let ((cs
(or (mime-charset-to-coding-system
method)
default-cs)))
- (encode-coding-region beg end cs)
+ (encode-coding-region bbeg end cs)
)))
))
))
projects / elisp / flim.git / blobdiff