;;; eword-encode.el --- RFC 2047 based encoded-word encoder for GNU Emacs
-;; Copyright (C) 1995,1996,1997 Free Software Foundation, Inc.
+;; Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc.
;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
-;; Version: $Revision: 0.25 $
;; Keywords: encoded-word, MIME, multilingual, header, mail, news
-;; This file is part of SEMI (SEMI is Emacs MIME Interfaces).
+;; This file is part of SEMI (Spadework for Emacs MIME Interfaces).
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;;;
(defconst eword-encode-RCS-ID
- "$Id: eword-encode.el,v 0.25 1997-06-26 09:21:38 morioka Exp $")
+ "$Id: eword-encode.el,v 1.2 1998-03-13 12:55:54 morioka Exp $")
(defconst eword-encode-version (get-version-string eword-encode-RCS-ID))
If method is nil, this field will not be encoded.")
-(defvar eword-generate-X-Nsubject nil
- "*If it is not nil, X-Nsubject field is generated
-when Subject field is encoded by `eword-encode-header'.")
-
(defvar eword-charset-encoding-alist
'((us-ascii . nil)
(iso-8859-1 . "Q")
(tm-eword::space-process dest)
))
-(defun tm-eword::phrase-route-addr-to-rwl (phrase-route-addr)
+(defun eword-addr-seq-to-rwl (seq)
+ (let (dest pname)
+ (while seq
+ (let* ((token (car seq))
+ (name (car token))
+ )
+ (cond ((eq name 'spaces)
+ (setq dest (nconc dest (list (list (cdr token) nil nil))))
+ )
+ ((eq name 'comment)
+ (setq dest
+ (nconc
+ dest
+ (list (list "(" nil nil))
+ (tm-eword::split-string (cdr token) 'comment)
+ (list (list ")" nil nil))
+ ))
+ )
+ ((eq name 'quoted-string)
+ (setq dest
+ (nconc
+ dest
+ (list
+ (list (concat "\"" (cdr token) "\"") nil nil)
+ )))
+ )
+ (t
+ (setq dest
+ (if (or (eq pname 'spaces)
+ (eq pname 'comment))
+ (nconc dest (list (list (cdr token) nil nil)))
+ (nconc (butlast dest)
+ (list
+ (list (concat (car (car (last dest)))
+ (cdr token))
+ nil nil)))))
+ ))
+ (setq seq (cdr seq)
+ pname name))
+ )
+ dest))
+
+(defun 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))
)
(append
dest
- (list (list (concat "<" (std11-addr-to-string route) ">") nil nil))
+ (eword-addr-seq-to-rwl
+ (append '((specials . "<"))
+ route
+ '((specials . ">"))))
))))
-(defun tm-eword::addr-spec-to-rwl (addr-spec)
+(defun 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))
+ (eword-addr-seq-to-rwl (cdr addr-spec))
))
(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)
+ (setq dest (or (eword-phrase-route-addr-to-rwl addr)
+ (eword-addr-spec-to-rwl addr)
))
(if comment
(setq dest
resent-reply-to resent-from
resent-sender to resent-to
cc resent-cc
- bcc resent-bcc dcc)
+ bcc resent-bcc dcc
+ mime-version)
)
(car (tm-eword::encode-address-list
(+ (length field-name) 2) field-body))
(if (and str (string-match eword-encoded-word-regexp str))
str)))
+(defsubst eword-find-field-encoding-method (field-name)
+ (setq field-name (downcase field-name))
+ (let ((alist eword-field-encoding-method-alist))
+ (catch 'found
+ (while alist
+ (let* ((pair (car alist))
+ (str (car pair)))
+ (if (and (stringp str)
+ (string= field-name (downcase str)))
+ (throw 'found (cdr pair))
+ ))
+ (setq alist (cdr alist)))
+ (cdr (assq t eword-field-encoding-method-alist))
+ )))
+
(defun eword-encode-header (&optional code-conversion)
"Encode header fields to network representation, such as MIME encoded-word.
(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 (let ((fname (downcase field-name)))
- (assoc-if
- (function
- (lambda (str)
- (and (stringp str)
- (string= fname (downcase str))
- )))
- eword-field-encoding-method-alist))
- (assq t eword-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 (eword-encode-field field))
- ))
- (code-conversion
- (let ((cs
- (or (mime-charset-to-coding-system
- method)
- default-cs)))
- (encode-coding-region beg end cs)
- )))
- ))
+ (let ((method (eword-find-field-encoding-method
+ (downcase field-name))))
+ (cond ((eq method 'mime)
+ (let ((field
+ (buffer-substring-no-properties beg end)
+ ))
+ (delete-region beg end)
+ (insert (eword-encode-field field))
+ ))
+ (code-conversion
+ (let ((cs
+ (or (mime-charset-to-coding-system
+ method)
+ default-cs)))
+ (encode-coding-region beg end cs)
+ )))
))
))
- (and eword-generate-X-Nsubject
- (or (std11-field-body "X-Nsubject")
- (let ((str (eword-in-subject-p)))
- (if str
- (progn
- (setq str
- (eword-decode-string
- (std11-unfold-string str)))
- (if code-conversion
- (setq str
- (encode-mime-charset-string
- str
- (or (cdr (assoc-if
- (function
- (lambda (str)
- (and (stringp str)
- (string= "x-nsubject"
- (downcase str))
- )))
- eword-field-encoding-method-alist))
- 'iso-2022-jp-2)))
- )
- (insert (concat "\nX-Nsubject: " str))
- )))))
)))
(defun eword-encode-string (str &optional column mode)
projects / elisp / semi.git / blobdiff