;;; eword-encode.el --- RFC 2047 based encoded-word encoder for GNU Emacs
-;; Copyright (C) 1995,1996,1997,1998,1999 Free Software Foundation, Inc.
+;; Copyright (C) 1995,1996,1997,1998,1999,2000 Free Software Foundation, Inc.
-;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Author: MORIOKA Tomohiko <tomo@m17n.org>
;; Keywords: encoded-word, MIME, multilingual, header, mail, news
;; This file is part of FLIM (Faithful Library about Internet Message).
;;; @ variables
;;;
-(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)
- (t . mime)
- )
- "*Alist to specify field encoding method.
-Its key is field-name, value is encoding method.
-
-If method is `mime', this field will be encoded into MIME format.
-
-If method is a MIME-charset, this field will be encoded as the charset
-when it must be convert into network-code.
-
-If method is `default-mime-charset', this field will be encoded as
-variable `default-mime-charset' when it must be convert into
-network-code.
-
-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
+;; User options are defined in mime-def.el.
+
+(defvar mime-header-charset-encoding-alist
'((us-ascii . nil)
(iso-8859-1 . "Q")
(iso-8859-2 . "Q")
(iso-8859-8 . "Q")
(iso-8859-9 . "Q")
(iso-2022-jp . "B")
+ (iso-2022-jp-3 . "B")
(iso-2022-kr . "B")
(gb2312 . "B")
(cn-gb . "B")
(utf-8 . "B")
))
+(defvar mime-header-default-charset-encoding "Q")
+
;;; @ encoded-text encoder
;;;
(let ((len (length string))
dest)
(while (> len 0)
- (let* ((chr (sref string 0))
+ (let* ((chr (aref string 0))
+ ;; (chr (sref string 0))
(charset (eword-encode-char-type chr))
- (i (char-length chr)))
+ (i 1)
+ ;; (i (char-length chr))
+ )
(while (and (< i len)
- (setq chr (sref string i))
- (eq charset (eword-encode-char-type chr))
- )
- (setq i (char-next-index chr i))
+ (setq chr (aref string i))
+ ;; (setq chr (sref string i))
+ (eq charset (eword-encode-char-type chr)))
+ (setq i (1+ i))
+ ;; (setq i (char-next-index chr i))
)
(setq dest (cons (cons charset (substring string 0 i)) dest)
string (substring string i)
- len (- len i)
- )))
- (nreverse dest)
- ))
+ len (- len i))))
+ (nreverse dest)))
;;; @ word
(defun ew-find-charset-rule (charsets)
(if charsets
(let* ((charset (find-mime-charset-by-charsets charsets))
- (encoding (cdr (or (assq charset eword-charset-encoding-alist)
- '(nil . "Q")))))
- (list charset encoding)
- )))
+ (encoding
+ (cdr (or (assq charset mime-header-charset-encoding-alist)
+ (cons charset mime-header-default-charset-encoding)))))
+ (list charset encoding))))
(defun tm-eword::words-to-ruled-words (wl &optional mode)
(mapcar (function
(str "") nstr)
(while (and (< p len)
(progn
- (setq np (char-next-index (sref string p) p))
+ (setq np (1+ 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))
(append dest
(list
(let ((ret (ew-find-charset-rule
- (find-non-ascii-charset-string str))))
+ (find-charset-string str))))
(make-ew-rword
str (car ret)(nth 1 ret) 'phrase)
)
(if (or (eq pname 'spaces)
(eq pname 'comment))
(nconc dest (list (list (cdr token) nil nil)))
- (nconc (butlast dest)
+ (nconc (nreverse (cdr (reverse dest)))
+ ;; (butlast dest)
(list
(list (concat (car (car (last dest)))
(cdr token))
)))
dest))
+(defsubst eword-encode-mailboxes-to-rword-list (mboxes)
+ (let ((dest (eword-encode-mailbox-to-rword-list (car mboxes))))
+ (if dest
+ (while (setq mboxes (cdr mboxes))
+ (setq dest
+ (nconc dest
+ (list '("," nil nil))
+ (eword-encode-mailbox-to-rword-list
+ (car mboxes))))))
+ dest))
+
+(defsubst eword-encode-address-to-rword-list (address)
+ (cond
+ ((eq (car address) 'mailbox)
+ (eword-encode-mailbox-to-rword-list address))
+ ((eq (car address) 'group)
+ (nconc
+ (eword-encode-phrase-to-rword-list (nth 1 address))
+ (list (list ":" nil nil))
+ (eword-encode-mailboxes-to-rword-list (nth 2 address))
+ (list (list ";" nil nil))))))
+
(defsubst eword-encode-addresses-to-rword-list (addresses)
- (let ((dest (eword-encode-mailbox-to-rword-list (car addresses))))
+ (let ((dest (eword-encode-address-to-rword-list (car addresses))))
(if dest
(while (setq addresses (cdr addresses))
(setq dest
(nconc dest
(list '("," nil nil))
;; (list '(" " nil nil))
- (eword-encode-mailbox-to-rword-list (car addresses))
- ))
- ))
+ (eword-encode-address-to-rword-list (car addresses))))))
dest))
(defsubst eword-encode-msg-id-to-rword-list (msg-id)
;;; @ application interfaces
;;;
-(defcustom eword-encode-default-start-column 10
- "Default start column if it is omitted."
- :group 'eword-encode
- :type 'integer)
+(defvar eword-encode-default-start-column 10
+ "Default start column if it is omitted.")
(defun eword-encode-string (string &optional column mode)
"Encode STRING as encoded-words, and return the result.
(or column eword-encode-default-start-column)
(eword-encode-split-string string 'text))))
-(defun eword-encode-field-body (field-body field-name)
+;;;###autoload
+(defun mime-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."
Resent-Sender To Resent-To
Cc Resent-Cc Bcc Resent-Bcc
Dcc))
- (eword-encode-address-list field-body start)
- )
+ (eword-encode-address-list field-body start))
((eq field-name 'In-Reply-To)
- (eword-encode-in-reply-to field-body start)
- )
+ (eword-encode-in-reply-to field-body start))
((memq field-name '(Mime-Version User-Agent))
- (eword-encode-structured-field-body field-body start)
- )
+ (eword-encode-structured-field-body field-body start))
(t
- (eword-encode-unstructured-field-body field-body start)
- ))
- )))
+ (eword-encode-unstructured-field-body field-body start))))))
+(defalias 'eword-encode-field-body 'mime-encode-field-body)
+(make-obsolete 'eword-encode-field-body 'mime-encode-field-body)
(defun eword-in-subject-p ()
(let ((str (std11-field-body "Subject")))
(if (and str (string-match eword-encoded-word-regexp str))
str)))
+(make-obsolete 'eword-in-subject-p "Don't use it.")
(defsubst eword-find-field-encoding-method (field-name)
(setq field-name (downcase field-name))
- (let ((alist eword-field-encoding-method-alist))
+ (let ((alist mime-field-encoding-method-alist))
(catch 'found
(while alist
(let* ((pair (car alist))
(throw 'found (cdr pair))
))
(setq alist (cdr alist)))
- (cdr (assq t eword-field-encoding-method-alist))
+ (cdr (assq t mime-field-encoding-method-alist))
)))
-(defun eword-encode-header (&optional code-conversion)
+;;;###autoload
+(defun mime-encode-header-in-buffer (&optional code-conversion)
"Encode header fields to network representation, such as MIME encoded-word.
-It refer variable `eword-field-encoding-method-alist'."
+It refer variable `mime-field-encoding-method-alist'."
(interactive "*")
(save-excursion
(save-restriction
(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)
+ (and (delq 'ascii (find-charset-region bbeg end))
(let ((method (eword-find-field-encoding-method
(downcase field-name))))
(cond ((eq method 'mime)
(buffer-substring-no-properties bbeg end)
))
(delete-region bbeg end)
- (insert (eword-encode-field-body field-body
- field-name))
- ))
+ (insert (mime-encode-field-body field-body
+ field-name))))
(code-conversion
(let ((cs
(or (mime-charset-to-coding-system
))
))
)))
+(defalias 'eword-encode-header 'mime-encode-header-in-buffer)
+(make-obsolete 'eword-encode-header 'mime-encode-header-in-buffer)
;;; @ end