+++ /dev/null
-;;; tm-ew-d.el --- RFC 2047 based encoded-word decoder for GNU Emacs
-
-;; Copyright (C) 1995,1996,1997 Free Software Foundation, Inc.
-
-;; Author: ENAMI Tsugutomo <enami@sys.ptg.sony.co.jp>
-;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
-;; Maintainer: MORIOKA Tomohiko <morioka@jaist.ac.jp>
-;; Created: 1995/10/03
-;; Original: 1992/07/20 ENAMI Tsugutomo's `mime.el'.
-;; Renamed: 1993/06/03 to tiny-mime.el.
-;; Renamed: 1995/10/03 from tiny-mime.el. (split off encoder)
-;; Version: $Revision: 7.40 $
-;; Keywords: encoded-word, MIME, multilingual, header, mail, news
-
-;; This file is part of tm (Tools for MIME).
-
-;; This program is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation; either version 2, or (at
-;; your option) any later version.
-
-;; This program is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;; General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; 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 'emu)
-(require 'std11)
-(require 'mel)
-(require 'tm-def)
-(require 'tl-str)
-
-
-;;; @ version
-;;;
-
-(defconst tm-ew-d/RCS-ID
- "$Id: tm-ew-d.el,v 7.40 1997/03/06 17:53:51 morioka Exp $")
-(defconst mime/eword-decoder-version (get-version-string tm-ew-d/RCS-ID))
-
-
-;;; @ MIME encoded-word definition
-;;;
-
-(defconst mime/encoded-text-regexp "[!->@-~]+")
-(defconst mime/encoded-word-regexp (concat (regexp-quote "=?")
- "\\("
- mime/charset-regexp
- "\\)"
- (regexp-quote "?")
- "\\(B\\|Q\\)"
- (regexp-quote "?")
- "\\("
- mime/encoded-text-regexp
- "\\)"
- (regexp-quote "?=")))
-
-
-;;; @ for string
-;;;
-
-(defun mime-eword/decode-string (string &optional must-unfold)
- "Decode MIME encoded-words in STRING.
-
-STRING is unfolded before decoding.
-
-If an encoded-word is broken or your emacs implementation can not
-decode the charset included in it, it is not decoded.
-
-If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even
-if there are in decoded encoded-words (generated by bad manner MUA
-such as a version of Net$cape). [tm-ew-d.el]"
- (setq string (std11-unfold-string string))
- (let ((dest "")(ew nil)
- beg end)
- (while (and (string-match mime/encoded-word-regexp string)
- (setq beg (match-beginning 0)
- end (match-end 0))
- )
- (if (> beg 0)
- (if (not
- (and (eq ew t)
- (string-match "^[ \t]+$" (substring string 0 beg))
- ))
- (setq dest (concat dest (substring string 0 beg)))
- )
- )
- (setq dest
- (concat dest
- (mime/decode-encoded-word
- (substring string beg end) must-unfold)
- ))
- (setq string (substring string end))
- (setq ew t)
- )
- (concat dest string)
- ))
-
-
-;;; @ for region
-;;;
-
-(defun mime-eword/decode-region (start end &optional unfolding must-unfold)
- "Decode MIME encoded-words in region between START and END.
-
-If UNFOLDING is not nil, it unfolds before decoding.
-
-If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even
-if there are in decoded encoded-words (generated by bad manner MUA
-such as a version of Net$cape). [tm-ew-d.el]"
- (interactive "*r")
- (save-excursion
- (save-restriction
- (narrow-to-region start end)
- (if unfolding
- (mime/unfolding)
- )
- (goto-char (point-min))
- (while (re-search-forward (concat "\\(" mime/encoded-word-regexp "\\)"
- "\\(\n?[ \t]\\)+"
- "\\(" mime/encoded-word-regexp "\\)")
- nil t)
- (replace-match "\\1\\6")
- (goto-char (point-min))
- )
- (let (charset encoding text)
- (while (re-search-forward mime/encoded-word-regexp nil t)
- (insert (mime/decode-encoded-word
- (prog1
- (buffer-substring (match-beginning 0) (match-end 0))
- (delete-region (match-beginning 0) (match-end 0))
- ) must-unfold))
- ))
- )))
-
-
-;;; @ for message header
-;;;
-
-(defun mime/decode-message-header ()
- "Decode MIME encoded-words in message header. [tm-ew-d.el]"
- (interactive "*")
- (save-excursion
- (save-restriction
- (narrow-to-region (goto-char (point-min))
- (progn (re-search-forward "^$" nil t) (point)))
- (mime-eword/decode-region (point-min) (point-max) t)
- )))
-
-(defun mime/unfolding ()
- (goto-char (point-min))
- (let (field beg end)
- (while (re-search-forward std11-field-head-regexp nil t)
- (setq beg (match-beginning 0)
- end (std11-field-end))
- (setq field (buffer-substring beg end))
- (if (string-match mime/encoded-word-regexp field)
- (save-restriction
- (narrow-to-region (goto-char beg) end)
- (while (re-search-forward "\n\\([ \t]\\)" nil t)
- (replace-match
- (match-string 1))
- )
- (goto-char (point-max))
- ))
- )))
-
-
-;;; @ encoded-word decoder
-;;;
-
-(defun mime/decode-encoded-word (word &optional must-unfold)
- "Decode WORD if it is an encoded-word.
-
-If your emacs implementation can not decode the charset of WORD, it
-returns WORD. Similarly the encoded-word is broken, it returns WORD.
-
-If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even
-if there are in decoded encoded-word (generated by bad manner MUA such
-as a version of Net$cape). [tm-ew-d.el]"
- (or (if (string-match mime/encoded-word-regexp word)
- (let ((charset
- (substring word (match-beginning 1) (match-end 1))
- )
- (encoding
- (upcase
- (substring word (match-beginning 2) (match-end 2))
- ))
- (text
- (substring word (match-beginning 3) (match-end 3))
- ))
- (condition-case err
- (mime/decode-encoded-text charset encoding text must-unfold)
- (error
- (and (add-text-properties 0 (length word)
- (and tm:warning-face
- (list 'face tm:warning-face))
- word)
- word)))
- ))
- word))
-
-
-;;; @ encoded-text decoder
-;;;
-
-(defun mime/decode-encoded-text (charset encoding string &optional must-unfold)
- "Decode STRING as an encoded-text.
-
-If your emacs implementation can not decode CHARSET, it returns nil.
-
-If ENCODING is not \"B\" or \"Q\", it occurs error.
-So you should write error-handling code if you don't want break by errors.
-
-If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even
-if there are in decoded encoded-text (generated by bad manner MUA such
-as a version of Net$cape). [tm-ew-d.el]"
- (let ((cs (mime-charset-to-coding-system charset)))
- (if cs
- (let ((dest
- (cond
- ((string-equal "B" encoding)
- (if (and (string-match mime/B-encoded-text-regexp string)
- (string-equal string (match-string 0 string)))
- (base64-decode-string string)
- (error "Invalid encoded-text %s" string)))
- ((string-equal "Q" encoding)
- (if (and (string-match mime/Q-encoded-text-regexp string)
- (string-equal string (match-string 0 string)))
- (q-encoding-decode-string string)
- (error "Invalid encoded-text %s" string)))
- (t
- (error "Invalid encoding %s" encoding)
- )))
- )
- (if dest
- (progn
- (setq dest (decode-coding-string dest cs))
- (if must-unfold
- (mapconcat (function
- (lambda (chr)
- (cond
- ((eq chr ?\n) "")
- ((eq chr ?\t) " ")
- (t (char-to-string chr)))
- ))
- (std11-unfold-string dest)
- "")
- dest)
- ))))))
-
-
-;;; @ end
-;;;
-
-(provide 'tm-ew-d)
-
-;;; tm-ew-d.el ends here
+++ /dev/null
-;;; tm-ew-e.el --- RFC 2047 based encoded-word encoder for GNU Emacs
-
-;; Copyright (C) 1995,1996,1997 Free Software Foundation, Inc.
-
-;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
-;; Version: $Revision: 7.58 $
-;; Keywords: encoded-word, MIME, multilingual, header, mail, news
-
-;; This file is part of tm (Tools for MIME).
-
-;; This program is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation; either version 2, or (at
-;; your option) any later version.
-
-;; This program is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;; General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; 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.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/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-1 . "Q")
- (iso-8859-2 . "Q")
- (iso-8859-3 . "Q")
- (iso-8859-4 . "Q")
- (iso-8859-5 . "Q")
- (koi8-r . "Q")
- (iso-8859-7 . "Q")
- (iso-8859-8 . "Q")
- (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::encode-encoded-text (charset encoding string &optional mode)
- (let ((text
- (cond ((string= encoding "B")
- (base64-encode-string string))
- ((string= encoding "Q")
- (q-encoding-encode-string string mode))
- )
- ))
- (if text
- (concat "=?" (upcase (symbol-name charset)) "?"
- encoding "?" text "?=")
- )))
-
-
-;;; @ leading char
-;;;
-
-(defun tm-eword::char-type (chr)
- (if (or (= chr 32)(= chr ?\t))
- nil
- (char-charset chr)
- ))
-
-(defun tm-eword::parse-lc-word (str)
- (let* ((chr (sref str 0))
- (lc (tm-eword::char-type chr))
- (i (char-length chr))
- (len (length str))
- )
- (while (and (< i len)
- (setq chr (sref str i))
- (eq lc (tm-eword::char-type chr))
- )
- (setq i (+ i (char-length chr)))
- )
- (cons (cons lc (substring str 0 i)) (substring str i))
- ))
-
-(defun tm-eword::split-to-lc-words (str)
- (let (ret dest)
- (while (and (not (string= str ""))
- (setq ret (tm-eword::parse-lc-word str))
- )
- (setq dest (cons (car ret) dest))
- (setq str (cdr ret))
- )
- (reverse dest)
- ))
-
-
-;;; @ word
-;;;
-
-(defun tm-eword::parse-word (lcwl)
- (let* ((lcw (car lcwl))
- (lc (car lcw))
- )
- (if (null lc)
- lcwl
- (let ((lcl (list lc))
- (str (cdr lcw))
- )
- (catch 'tag
- (while (setq lcwl (cdr lcwl))
- (setq lcw (car lcwl))
- (setq lc (car lcw))
- (if (null lc)
- (throw 'tag nil)
- )
- (if (not (memq lc lcl))
- (setq lcl (cons lc lcl))
- )
- (setq str (concat str (cdr lcw)))
- ))
- (cons (cons lcl str) lcwl)
- ))))
-
-(defun tm-eword::lc-words-to-words (lcwl)
- (let (ret dest)
- (while (setq ret (tm-eword::parse-word lcwl))
- (setq dest (cons (car ret) dest))
- (setq lcwl (cdr ret))
- )
- (reverse dest)
- ))
-
-
-;;; @ rule
-;;;
-
-(defmacro tm-eword::make-rword (text charset encoding type)
- (` (list (, text)(, charset)(, encoding)(, type))))
-(defmacro tm-eword::rword-text (rword)
- (` (car (, rword))))
-(defmacro tm-eword::rword-charset (rword)
- (` (car (cdr (, rword)))))
-(defmacro tm-eword::rword-encoding (rword)
- (` (car (cdr (cdr (, rword))))))
-(defmacro tm-eword::rword-type (rword)
- (` (car (cdr (cdr (cdr (, rword)))))))
-
-(defun tm-eword::find-charset-rule (charsets)
- (if charsets
- (let* ((charset (charsets-to-mime-charset charsets))
- (encoding (cdr (assq charset mime-eword/charset-encoding-alist)))
- )
- (list charset encoding)
- )))
-
-(defun tm-eword::words-to-ruled-words (wl &optional mode)
- (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)
- )))
- wl))
-
-(defun tm-eword::space-process (seq)
- (let (prev a ac b c cc)
- (while seq
- (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))
- (progn
- (setq a (car prev))
- (setq ac (tm-eword::rword-charset a))
- (if (and (tm-eword::rword-encoding a)
- (tm-eword::rword-encoding c))
- (cond ((eq ac cc)
- (setq prev (cons
- (cons (concat (car a)(car b)(car c))
- (cdr a))
- (cdr prev)
- ))
- (setq seq (cdr seq))
- )
- (t
- (setq prev (cons
- (cons (concat (car a)(car b))
- (cdr a))
- (cdr prev)
- ))
- ))
- (setq prev (cons b prev))
- ))
- (setq prev (cons b prev))
- ))
- (reverse prev)
- ))
-
-(defun tm-eword::split-string (str &optional mode)
- (tm-eword::space-process
- (tm-eword::words-to-ruled-words (tm-eword::lc-words-to-words
- (tm-eword::split-to-lc-words str))
- mode)))
-
-
-;;; @ length
-;;;
-
-(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))
- ret)
- (setq ret
- (cond ((string-equal encoding "B")
- (setq string (encode-mime-charset-string string charset))
- (base64-encoded-length string)
- )
- ((string-equal encoding "Q")
- (setq string (encode-mime-charset-string string charset))
- (q-encoding-encoded-length string
- (tm-eword::rword-type rword))
- )))
- (if ret
- (cons (+ 7 (length (symbol-name charset)) ret) string)
- )))
-
-
-;;; @ encode-string
-;;;
-
-(defun tm-eword::encode-string-1 (column rwl)
- (let* ((rword (car rwl))
- (ret (tm-eword::encoded-word-length rword))
- string len)
- (if (null ret)
- (cond ((and (setq string (car rword))
- (<= (setq len (+ (length string) column)) 76)
- )
- (setq rwl (cdr rwl))
- )
- (t
- (setq string "\n ")
- (setq len 1)
- ))
- (cond ((and (setq len (car ret))
- (<= (+ column len) 76)
- )
- (setq string
- (tm-eword::encode-encoded-text
- (tm-eword::rword-charset rword)
- (tm-eword::rword-encoding rword)
- (cdr ret)
- (tm-eword::rword-type rword)
- ))
- (setq len (+ (length string) column))
- (setq rwl (cdr rwl))
- )
- (t
- (setq string (car rword))
- (let* ((p 0) np
- (str "") nstr)
- (while (and (< p len)
- (progn
- (setq np (+ p (char-length (sref string p))))
- (setq nstr (substring string 0 np))
- (setq ret (tm-eword::encoded-word-length
- (cons nstr (cdr rword))
- ))
- (setq nstr (cdr ret))
- (setq len (+ (car ret) column))
- (<= len 76)
- ))
- (setq str nstr
- p np))
- (if (string-equal str "")
- (setq string "\n "
- len 1)
- (setq rwl (cons (cons (substring string p) (cdr rword))
- (cdr rwl)))
- (setq string
- (tm-eword::encode-encoded-text
- (tm-eword::rword-charset rword)
- (tm-eword::rword-encoding rword)
- str
- (tm-eword::rword-type rword)))
- (setq len (+ (length string) column))
- )
- )))
- )
- (list string len rwl)
- ))
-
-(defun tm-eword::encode-rwl (column rwl)
- (let (ret dest ps special str ew-f pew-f)
- (while rwl
- (setq ew-f (nth 2 (car rwl)))
- (if (and pew-f ew-f)
- (setq rwl (cons '(" ") rwl)
- pew-f nil)
- (setq pew-f ew-f)
- )
- (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 32)
- (if (string= str "(")
- (setq ps t)
- (setq dest (concat dest " "))
- (setq ps nil)
- ))
- ((eq special ?\()
- (if ps
- (progn
- (setq dest (concat dest " ("))
- (setq ps nil)
- )
- (setq dest (concat dest "("))
- )
- )))
- (cond ((string= str " ")
- (setq special 32)
- )
- ((string= str "(")
- (setq special ?\()
- )
- (t
- (setq special nil)
- (setq dest (concat dest str))
- ))
- (setq column (nth 1 ret)
- rwl (nth 2 ret))
- )
- (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)
- (let (token type dest str)
- (while phrase
- (setq token (car phrase))
- (setq type (car token))
- (cond ((eq type 'quoted-string)
- (setq str (concat "\"" (cdr token) "\""))
- (setq dest
- (append dest
- (list
- (let ((ret (tm-eword::find-charset-rule
- (find-non-ascii-charset-string str))))
- (tm-eword::make-rword
- str (car ret)(nth 1 ret) 'phrase)
- )
- )))
- )
- ((eq type 'comment)
- (setq dest
- (append dest
- '(("(" nil nil))
- (tm-eword::words-to-ruled-words
- (tm-eword::lc-words-to-words
- (tm-eword::split-to-lc-words (cdr token)))
- 'comment)
- '((")" nil nil))
- ))
- )
- (t
- (setq dest (append dest
- (tm-eword::words-to-ruled-words
- (tm-eword::lc-words-to-words
- (tm-eword::split-to-lc-words (cdr token))
- ) 'phrase)))
- ))
- (setq phrase (cdr phrase))
- )
- (tm-eword::space-process dest)
- ))
-
-(defun tm-eword::phrase-route-addr-to-rwl (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))
- dest)
- (if (eq (car (car phrase)) 'spaces)
- (setq phrase (cdr phrase))
- )
- (setq dest (tm-eword::phrase-to-rwl phrase))
- (if dest
- (setq dest (append dest '((" " nil nil))))
- )
- (append
- dest
- (list (list (concat "<" (std11-addr-to-string route) ">") nil nil))
- ))))
-
-(defun tm-eword::addr-spec-to-rwl (addr-spec)
- (if (eq (car addr-spec) 'addr-spec)
- (list (list (std11-addr-to-string (cdr addr-spec)) nil nil))
- ))
-
-(defun tm-eword::mailbox-to-rwl (mbox)
- (let ((addr (nth 1 mbox))
- (comment (nth 2 mbox))
- dest)
- (setq dest (or (tm-eword::phrase-route-addr-to-rwl addr)
- (tm-eword::addr-spec-to-rwl addr)
- ))
- (if comment
- (setq dest
- (append dest
- '((" " nil nil)
- ("(" nil nil))
- (tm-eword::split-string comment 'comment)
- '((")" nil nil))
- )))
- dest))
-
-(defun tm-eword::addresses-to-rwl (addresses)
- (let ((dest (tm-eword::mailbox-to-rwl (car addresses))))
- (if dest
- (while (setq addresses (cdr addresses))
- (setq dest (append dest
- '(("," nil nil))
- '((" " nil nil))
- (tm-eword::mailbox-to-rwl (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
-;;;
-
-(defun mime/encode-field (str)
- (setq str (std11-unfold-string str))
- (let ((ret (string-match std11-field-head-regexp str)))
- (or (if ret
- (let ((field-name (substring str 0 (1- (match-end 0))))
- (field-body (eliminate-top-spaces
- (substring str (match-end 0))))
- fname)
- (if (setq ret
- (cond ((string-equal field-body "") "")
- ((member (setq fname (downcase field-name))
- '("reply-to" "from" "sender"
- "resent-reply-to" "resent-from"
- "resent-sender" "to" "resent-to"
- "cc" "resent-cc"
- "bcc" "resent-bcc" "dcc")
- )
- (car (tm-eword::encode-address-list
- (+ (length field-name) 2) field-body))
- )
- (t
- (car (tm-eword::encode-string
- (+ (length field-name) 1)
- field-body 'text))
- ))
- )
- (concat field-name ": " ret)
- )))
- (car (tm-eword::encode-string 0 str))
- )))
-
-(defun mime/exist-encoded-word-in-subject ()
- (let ((str (std11-field-body "Subject")))
- (if (and str (string-match mime/encoded-word-regexp str))
- str)))
-
-(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 ((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))
- (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)
- )))
- ))
- ))
- ))
- (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)
- (car (tm-eword::encode-rwl (or column 0) (tm-eword::split-string str mode)))
- )
-
-
-;;; @ end
-;;;
-
-(provide 'tm-ew-e)
-
-;;; tm-ew-e.el ends here
projects / elisp / tm.git / commitdiff