X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=eword-encode.el;h=ee3f95cf45bb455d7b7f62c243e45feeeddd8ed9;hb=2e2f5b06a5d30fdf57394f764f2a36929f0e5f63;hp=80e8e8771d40fd5c7033860c62fc924ad0fa5538;hpb=0b1b4523c1dc8ea7fdde1eda5926c2d0685a511d;p=elisp%2Fsemi.git diff --git a/eword-encode.el b/eword-encode.el index 80e8e87..ee3f95c 100644 --- a/eword-encode.el +++ b/eword-encode.el @@ -1,12 +1,11 @@ ;;; 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 -;; 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 @@ -36,7 +35,7 @@ ;;; (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)) @@ -63,10 +62,6 @@ network-code. 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") @@ -438,7 +433,49 @@ MODE is allows `text', `comment', `phrase' or nil. Default value is (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)) @@ -452,20 +489,23 @@ MODE is allows `text', `comment', `phrase' or nil. Default value is ) (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 @@ -518,7 +558,8 @@ encoded-word. ASCII token is not encoded." 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)) @@ -539,6 +580,21 @@ encoded-word. ASCII token is not encoded." (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. @@ -555,59 +611,24 @@ It refer variable `eword-field-encoding-method-alist'." (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)