;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
;; Keywords: encoded-word, MIME, multilingual, header, mail, news
-;; This file is part of SEMI (Spadework for Emacs MIME Interfaces).
+;; This file is part of FLIM (Faithful Library about Internet Message).
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
(require 'eword-decode)
-;;; @ version
-;;;
-
-(defconst eword-encode-version "1.2")
-
-
;;; @ variables
;;;
-(defvar eword-field-encoding-method-alist
+(defgroup eword-encode nil
+ "Encoded-word encoding"
+ :group 'mime)
+
+(defcustom eword-field-encoding-method-alist
'(("X-Nsubject" . iso-2022-jp-2)
("Newsgroups" . nil)
("Message-ID" . nil)
variable `default-mime-charset' when it must be convert into
network-code.
-If method is nil, this field will not be encoded.")
+If method is nil, this field will not be encoded."
+ :group 'eword-encode
+ :type '(repeat (cons (choice :tag "Field"
+ (string :tag "Name")
+ (const :tag "Default" t))
+ (choice :tag "Method"
+ (const :tag "MIME conversion" mime)
+ (symbol :tag "non-MIME conversion")
+ (const :tag "no-conversion" nil)))))
(defvar eword-charset-encoding-alist
'((us-ascii . nil)
(while (> len 0)
(let* ((chr (sref string 0))
(charset (eword-encode-char-type chr))
- (i (char-bytes chr))
- )
+ (i (char-length chr)))
(while (and (< i len)
(setq chr (sref string i))
(eq charset (eword-encode-char-type chr))
)
- (setq i (+ i (char-bytes chr)))
+ (setq i (char-next-index chr i))
)
(setq dest (cons (cons charset (substring string 0 i)) dest)
string (substring string i)
;;; @ rule
;;;
-(defmacro tm-eword::make-rword (text charset encoding type)
+(defmacro make-ew-rword (text charset encoding type)
(` (list (, text)(, charset)(, encoding)(, type))))
-(defmacro tm-eword::rword-text (rword)
+(defmacro ew-rword-text (rword)
(` (car (, rword))))
-(defmacro tm-eword::rword-charset (rword)
+(defmacro ew-rword-charset (rword)
(` (car (cdr (, rword)))))
-(defmacro tm-eword::rword-encoding (rword)
+(defmacro ew-rword-encoding (rword)
(` (car (cdr (cdr (, rword))))))
-(defmacro tm-eword::rword-type (rword)
+(defmacro ew-rword-type (rword)
(` (car (cdr (cdr (cdr (, rword)))))))
(defun tm-eword::find-charset-rule (charsets)
(mapcar (function
(lambda (word)
(let ((ret (tm-eword::find-charset-rule (car word))))
- (tm-eword::make-rword (cdr word) (car ret)(nth 1 ret) mode)
+ (make-ew-rword (cdr word) (car ret)(nth 1 ret) mode)
)))
wl))
(setq b (car seq))
(setq seq (cdr seq))
(setq c (car seq))
- (setq cc (tm-eword::rword-charset c))
- (if (null (tm-eword::rword-charset b))
+ (setq cc (ew-rword-charset c))
+ (if (null (ew-rword-charset b))
(progn
(setq a (car prev))
- (setq ac (tm-eword::rword-charset a))
- (if (and (tm-eword::rword-encoding a)
- (tm-eword::rword-encoding c))
+ (setq ac (ew-rword-charset a))
+ (if (and (ew-rword-encoding a)
+ (ew-rword-encoding c))
(cond ((eq ac cc)
(setq prev (cons
(cons (concat (car a)(car b)(car c))
(reverse prev)
))
-(defun tm-eword::split-string (str &optional mode)
+(defun eword-encode-split-string (str &optional mode)
(tm-eword::space-process
(tm-eword::words-to-ruled-words
(eword-encode-charset-words-to-words
;;;
(defun tm-eword::encoded-word-length (rword)
- (let ((string (tm-eword::rword-text rword))
- (charset (tm-eword::rword-charset rword))
- (encoding (tm-eword::rword-encoding rword))
+ (let ((string (ew-rword-text rword))
+ (charset (ew-rword-charset rword))
+ (encoding (ew-rword-encoding rword))
ret)
(setq ret
(cond ((string-equal encoding "B")
((string-equal encoding "Q")
(setq string (encode-mime-charset-string string charset))
(q-encoding-encoded-length string
- (tm-eword::rword-type rword))
+ (ew-rword-type rword))
)))
(if ret
(cons (+ 7 (length (symbol-name charset)) ret) string)
)
(setq string
(eword-encode-text
- (tm-eword::rword-charset rword)
- (tm-eword::rword-encoding rword)
+ (ew-rword-charset rword)
+ (ew-rword-encoding rword)
(cdr ret)
- (tm-eword::rword-type rword)
+ (ew-rword-type rword)
))
(setq len (+ (length string) column))
(setq rwl (cdr rwl))
(str "") nstr)
(while (and (< p len)
(progn
- (setq np (+ p (char-bytes (sref string p))))
+ (setq np (char-next-index (sref string p) p))
(setq nstr (substring string 0 np))
(setq ret (tm-eword::encoded-word-length
(cons nstr (cdr rword))
(cdr rwl)))
(setq string
(eword-encode-text
- (tm-eword::rword-charset rword)
- (tm-eword::rword-encoding rword)
+ (ew-rword-charset rword)
+ (ew-rword-encoding rword)
str
- (tm-eword::rword-type rword)))
+ (ew-rword-type rword)))
(setq len (+ (length string) column))
)
)))
(list string len rwl)
))
-(defun tm-eword::encode-rwl (column rwl)
+(defun eword-encode-rword-list (column rwl)
(let (ret dest ps special str ew-f pew-f)
(while rwl
(setq ew-f (nth 2 (car rwl)))
(list dest column)
))
-(defun tm-eword::encode-string (column str &optional mode)
- (tm-eword::encode-rwl column (tm-eword::split-string str mode))
- )
-
;;; @ converter
;;;
-(defun tm-eword::phrase-to-rwl (phrase)
+(defun eword-encode-phrase-to-rword-list (phrase)
(let (token type dest str)
(while phrase
(setq token (car phrase))
(list
(let ((ret (tm-eword::find-charset-rule
(find-non-ascii-charset-string str))))
- (tm-eword::make-rword
+ (make-ew-rword
str (car ret)(nth 1 ret) 'phrase)
)
)))
(tm-eword::space-process dest)
))
-(defun eword-addr-seq-to-rwl (seq)
+(defun eword-encode-addr-seq-to-rword-list (seq)
(let (dest pname)
(while seq
(let* ((token (car seq))
(nconc
dest
(list (list "(" nil nil))
- (tm-eword::split-string (cdr token) 'comment)
+ (eword-encode-split-string (cdr token) 'comment)
(list (list ")" nil nil))
))
)
)
dest))
-(defun eword-phrase-route-addr-to-rwl (phrase-route-addr)
+(defun eword-encode-phrase-route-addr-to-rword-list (phrase-route-addr)
(if (eq (car phrase-route-addr) 'phrase-route-addr)
(let ((phrase (nth 1 phrase-route-addr))
(route (nth 2 phrase-route-addr))
(if (eq (car (car phrase)) 'spaces)
(setq phrase (cdr phrase))
)
- (setq dest (tm-eword::phrase-to-rwl phrase))
+ (setq dest (eword-encode-phrase-to-rword-list phrase))
(if dest
(setq dest (append dest '((" " nil nil))))
)
(append
dest
- (eword-addr-seq-to-rwl
+ (eword-encode-addr-seq-to-rword-list
(append '((specials . "<"))
route
'((specials . ">"))))
))))
-(defun eword-addr-spec-to-rwl (addr-spec)
+(defun eword-encode-addr-spec-to-rword-list (addr-spec)
(if (eq (car addr-spec) 'addr-spec)
- (eword-addr-seq-to-rwl (cdr addr-spec))
+ (eword-encode-addr-seq-to-rword-list (cdr addr-spec))
))
-(defun tm-eword::mailbox-to-rwl (mbox)
+(defun eword-encode-mailbox-to-rword-list (mbox)
(let ((addr (nth 1 mbox))
(comment (nth 2 mbox))
dest)
- (setq dest (or (eword-phrase-route-addr-to-rwl addr)
- (eword-addr-spec-to-rwl addr)
+ (setq dest (or (eword-encode-phrase-route-addr-to-rword-list addr)
+ (eword-encode-addr-spec-to-rword-list addr)
))
(if comment
(setq dest
(append dest
'((" " nil nil)
("(" nil nil))
- (tm-eword::split-string comment 'comment)
+ (eword-encode-split-string comment 'comment)
'((")" nil nil))
)))
dest))
-(defun tm-eword::addresses-to-rwl (addresses)
- (let ((dest (tm-eword::mailbox-to-rwl (car addresses))))
+(defsubst eword-encode-addresses-to-rword-list (addresses)
+ (let ((dest (eword-encode-mailbox-to-rword-list (car addresses))))
(if dest
(while (setq addresses (cdr addresses))
- (setq dest (append dest
- '(("," nil nil))
- '((" " nil nil))
- (tm-eword::mailbox-to-rwl (car addresses))
- ))
+ (setq dest
+ (append dest
+ '(("," nil nil))
+ '((" " nil nil))
+ (eword-encode-mailbox-to-rword-list (car addresses))
+ ))
))
dest))
-(defun tm-eword::encode-address-list (column str)
- (tm-eword::encode-rwl
- column
- (tm-eword::addresses-to-rwl (std11-parse-addresses-string str))
- ))
-
;;; @ application interfaces
;;;
+(defcustom eword-encode-default-start-column 10
+ "Default start column if it is omitted."
+ :group 'eword-encode
+ :type 'integer)
+
+(defun eword-encode-string (string &optional column mode)
+ "Encode STRING as encoded-words, and return the result.
+Optional argument COLUMN is start-position of the field.
+Optional argument MODE allows `text', `comment', `phrase' or nil.
+Default value is `phrase'."
+ (car (eword-encode-rword-list
+ (or column eword-encode-default-start-column)
+ (eword-encode-split-string string mode))))
+
+(defun eword-encode-address-list (string &optional column)
+ "Encode header field STRING as list of address, and return the result.
+Optional argument COLUMN is start-position of the field."
+ (car (eword-encode-rword-list
+ (or column eword-encode-default-start-column)
+ (eword-encode-addresses-to-rword-list
+ (std11-parse-addresses-string string))
+ )))
+
+(defun eword-encode-structured-field-body (string &optional column)
+ "Encode header field STRING as structured field, and return the result.
+Optional argument COLUMN is start-position of the field."
+ (car (eword-encode-rword-list
+ (or column eword-encode-default-start-column)
+ (eword-encode-addr-seq-to-rword-list (std11-lexical-analyze string))
+ )))
+
+(defun eword-encode-unstructured-field-body (string &optional column)
+ "Encode header field STRING as unstructured field, and return the result.
+Optional argument COLUMN is start-position of the field."
+ (car (eword-encode-rword-list
+ (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.
A lexical token includes non-ASCII character is encoded as MIME
(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-equal field-body "") "")
- ((memq (intern (downcase field-name))
- '(reply-to
- from sender
- resent-reply-to resent-from
- resent-sender to resent-to
- cc resent-cc
- bcc resent-bcc dcc
- mime-version)
- )
- (car (tm-eword::encode-address-list
- (+ (length field-name) 2) field-body))
+ (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))
+ )
+ ((memq field-name-symbol
+ '(In-Reply-To
+ Mime-Version User-Agent))
+ (eword-encode-structured-field-body
+ field-body (+ (length field-name) 2))
)
(t
- (car (tm-eword::encode-string
- (1+ (length field-name))
- field-body 'text))
+ (eword-encode-unstructured-field-body
+ field-body (1+ (length field-name)))
))
)
(concat field-name ": " ret)
)))
- (car (tm-eword::encode-string 0 string))
+ (eword-encode-string string 0)
)))
(defun eword-in-subject-p ()
))
)))
-(defun eword-encode-string (str &optional column mode)
- (car (tm-eword::encode-rwl (or column 0) (tm-eword::split-string str mode)))
- )
-
;;; @ end
;;;
projects / elisp / flim.git / blobdiff