-;;; tm-ew-e.el --- RFC 1522 based MIME encoded-word encoder for GNU Emacs
+;;; tm-ew-e.el --- RFC 2047 based encoded-word encoder for GNU Emacs
-;; Copyright (C) 1995,1996 Free Software Foundation, Inc.
+;; Copyright (C) 1995,1996,1997 Free Software Foundation, Inc.
;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
-;; Version: $Revision: 7.47 $
-;; Keywords: mail, news, MIME, RFC 1522, multilingual, encoded-word
+;; Version: $Revision: 7.58 $
+;; Keywords: encoded-word, MIME, multilingual, header, mail, news
;; This file is part of tm (Tools for MIME).
;; General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with this program; see the file COPYING. If not, write to
-;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Code:
(require 'mel)
(require 'std11)
(require 'tm-def)
+(require 'tl-list)
;;; @ version
;;;
(defconst tm-ew-e/RCS-ID
- "$Id: tm-ew-e.el,v 7.47 1996/08/30 04:26:46 morioka Exp $")
+ "$Id: tm-ew-e.el,v 7.58 1997/02/11 10:49:13 morioka Exp $")
(defconst mime-eword/encoder-version (get-version-string tm-ew-e/RCS-ID))
;;; @ variables
;;;
-(defvar mime/no-encoding-header-fields '("X-Nsubject" "Newsgroups"))
-
-(defvar mime/use-X-Nsubject nil)
+(defvar mime/field-encoding-method-alist
+ (if (boundp 'mime/no-encoding-header-fields)
+ (nconc
+ (mapcar (function
+ (lambda (field-name)
+ (cons field-name 'default-mime-charset)
+ ))
+ mime/no-encoding-header-fields)
+ '((t . mime))
+ )
+ '(("X-Nsubject" . iso-2022-jp-2)
+ ("Newsgroups" . 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. [tm-ew-e.el]")
+
+(defvar mime/generate-X-Nsubject
+ (and (boundp 'mime/use-X-Nsubject)
+ mime/use-X-Nsubject)
+ "*If it is not nil, X-Nsubject field is generated
+when Subject field is encoded by `mime/encode-message-header'.
+\[tm-ew-e.el]")
(defvar mime-eword/charset-encoding-alist
'((us-ascii . nil)
(iso-8859-9 . "Q")
(iso-2022-jp . "B")
(iso-2022-kr . "B")
+ (gb2312 . "B")
+ (cn-gb . "B")
+ (cn-gb-2312 . "B")
(euc-kr . "B")
(iso-2022-jp-2 . "B")
(iso-2022-int-1 . "B")
))
+
;;; @ encoded-text encoder
;;;
(defun tm-eword::char-type (chr)
(if (or (= chr 32)(= chr ?\t))
nil
- (char-leading-char chr)
+ (char-charset chr)
))
(defun tm-eword::parse-lc-word (str)
)
(t
(setq string (car rword))
- (let* ((sl (length string))
- (p 0) np
+ (let* ((p 0) np
(str "") nstr)
(while (and (< p len)
(progn
(append dest
(list
(let ((ret (tm-eword::find-charset-rule
- (find-charset-string str))))
+ (find-non-ascii-charset-string str))))
(tm-eword::make-rword
str (car ret)(nth 1 ret) 'phrase)
)
(+ (length field-name) 2) field-body))
)
(t
- (catch 'tag
- (let ((r mime/no-encoding-header-fields)
- fn)
- (while r
- (setq fn (car r))
- (if (string-equal (downcase fn) fname)
- (throw 'tag field-body)
- )
- (setq r (cdr r))
- ))
- (car (tm-eword::encode-string
- (+ (length field-name) 1)
- field-body 'text))
- ))
- ))
+ (car (tm-eword::encode-string
+ (+ (length field-name) 1)
+ field-body 'text))
+ ))
+ )
(concat field-name ": " ret)
)))
(car (tm-eword::encode-string 0 str))
(if (and str (string-match mime/encoded-word-regexp str))
str)))
-(defun mime/encode-message-header ()
+(defun mime/encode-message-header (&optional code-conversion)
(interactive "*")
(save-excursion
(save-restriction
(std11-narrow-to-header mail-header-separator)
(goto-char (point-min))
- (let (beg end field)
+ (let ((default-cs (mime-charset-to-coding-system default-mime-charset))
+ beg 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))
- (if (and (find-charset-region beg end)
- (setq field
- (mime/encode-field
- (buffer-substring-no-properties beg end)
- ))
- )
- (progn
- (delete-region beg end)
- (insert field)
- ))
+ (and (find-non-ascii-charset-region beg end)
+ (let ((ret (or (ASSOC (downcase field-name)
+ mime/field-encoding-method-alist
+ :test (function
+ (lambda (str1 str2)
+ (and (stringp str2)
+ (string= str1
+ (downcase str2))
+ ))))
+ (assq t mime/field-encoding-method-alist)
+ )))
+ (if ret
+ (let ((method (cdr ret)))
+ (cond ((eq method 'mime)
+ (let ((field
+ (buffer-substring-no-properties beg end)
+ ))
+ (delete-region beg end)
+ (insert (mime/encode-field field))
+ ))
+ (code-conversion
+ (let ((cs
+ (or (mime-charset-to-coding-system
+ method)
+ default-cs)))
+ (encode-coding-region beg end cs)
+ )))
+ ))
+ ))
))
- (if mime/use-X-Nsubject
- (let ((str (mime/exist-encoded-word-in-subject)))
- (if str
- (insert
- (concat
- "\nX-Nsubject: "
- (mime-eword/decode-string (std11-unfold-string str))
- )))))
+ (and mime/generate-X-Nsubject
+ (or (std11-field-body "X-Nsubject")
+ (let ((str (mime/exist-encoded-word-in-subject)))
+ (if str
+ (progn
+ (setq str
+ (mime-eword/decode-string
+ (std11-unfold-string str)))
+ (if code-conversion
+ (setq str
+ (encode-mime-charset-string
+ str
+ (or (cdr (ASSOC
+ "x-nsubject"
+ mime/field-encoding-method-alist
+ :test
+ (function
+ (lambda (str1 str2)
+ (and (stringp str2)
+ (string= str1
+ (downcase str2))
+ )))))
+ 'iso-2022-jp-2)))
+ )
+ (insert (concat "\nX-Nsubject: " str))
+ )))))
)))
(defun mime-eword/encode-string (str &optional column mode)
projects / elisp / tm.git / blobdiff