X-Git-Url: http://git.chise.org/gitweb/?p=elisp%2Fflim.git;a=blobdiff_plain;f=eword-encode.el;h=5b6219966622373bbb417687b5648244f44eae77;hp=e8707b41896e2c949f8a640aaf276591672e6169;hb=refs%2Fheads%2Flimit-1_14;hpb=dae8663db444229cae347ed24479ab3a00ba726a diff --git a/eword-encode.el b/eword-encode.el index e8707b4..5b62199 100644 --- a/eword-encode.el +++ b/eword-encode.el @@ -19,8 +19,8 @@ ;; 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. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Code: @@ -46,6 +46,8 @@ (iso-8859-7 . "Q") (iso-8859-8 . "Q") (iso-8859-9 . "Q") + (iso-8859-14 . "Q") + (iso-8859-15 . "Q") (iso-2022-jp . "B") (iso-2022-jp-3 . "B") (iso-2022-kr . "B") @@ -61,6 +63,17 @@ (defvar mime-header-default-charset-encoding "Q") +(defvar mime-header-encode-method-alist + '((eword-encode-address-list + . (Reply-To + From Sender + Resent-Reply-To Resent-From + Resent-Sender To Resent-To + Cc Resent-Cc Bcc Resent-Bcc + Dcc)) + (eword-encode-in-reply-to . (In-Reply-To)) + (eword-encode-structured-field-body . (Mime-Version User-Agent)) + (eword-encode-unstructured-field-body))) ;;; @ encoded-text encoder ;;; @@ -166,6 +179,26 @@ MODE is allows `text', `comment', `phrase' or nil. Default value is (cons charset mime-header-default-charset-encoding))))) (list charset encoding)))) +;; [tomo:2002-11-05] The following code is a quick-fix for emacsen +;; which is not depended on the Mule model. We should redesign +;; `eword-encode-split-string' to avoid to depend on the Mule model. +(if (featurep 'utf-2000) +;; for CHISE Architecture +(defun tm-eword::words-to-ruled-words (wl &optional mode) + (let (mcs) + (mapcar (function + (lambda (word) + (setq mcs (detect-mime-charset-string (cdr word))) + (make-ew-rword + (cdr word) + mcs + (cdr (or (assq mcs mime-header-charset-encoding-alist) + (cons mcs mime-header-default-charset-encoding))) + mode) + )) + wl))) + +;; for legacy Mule (defun tm-eword::words-to-ruled-words (wl &optional mode) (mapcar (function (lambda (word) @@ -173,6 +206,7 @@ MODE is allows `text', `comment', `phrase' or nil. Default value is (make-ew-rword (cdr word) (car ret)(nth 1 ret) mode) ))) wl)) +) (defun ew-space-process (seq) (let (prev a ac b c cc) @@ -516,14 +550,14 @@ MODE is allows `text', `comment', `phrase' or nil. Default value is (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) @@ -603,25 +637,22 @@ encoded-word. ASCII token is not encoded." (setq field-body (std11-unfold-string field-body)) (if (string= field-body "") "" - (let (start) + (let ((method-alist mime-header-encode-method-alist) + start ret) (if (symbolp field-name) (setq start (1+ (length (symbol-name field-name)))) (setq start (1+ (length field-name)) field-name (intern (capitalize field-name)))) - (cond ((memq field-name - '(Reply-To - From Sender - Resent-Reply-To Resent-From - Resent-Sender To Resent-To - Cc Resent-Cc Bcc Resent-Bcc - Dcc)) - (eword-encode-address-list field-body start)) - ((eq field-name 'In-Reply-To) - (eword-encode-in-reply-to field-body start)) - ((memq field-name '(Mime-Version User-Agent)) - (eword-encode-structured-field-body field-body start)) - (t - (eword-encode-unstructured-field-body field-body start)))))) + (while (car method-alist) + (if (or (not (cdr (car method-alist))) + (memq field-name + (cdr (car method-alist)))) + (progn + (setq ret + (apply (caar method-alist) (list field-body start))) + (setq method-alist nil))) + (setq method-alist (cdr method-alist))) + ret))) (defalias 'eword-encode-field-body 'mime-encode-field-body) (make-obsolete 'eword-encode-field-body 'mime-encode-field-body) @@ -649,8 +680,7 @@ encoded-word. ASCII token is not encoded." ;;;###autoload (defun mime-encode-header-in-buffer (&optional code-conversion) "Encode header fields to network representation, such as MIME encoded-word. - -It refer variable `mime-field-encoding-method-alist'." +It refers the `mime-field-encoding-method-alist' variable." (interactive "*") (save-excursion (save-restriction @@ -660,28 +690,29 @@ It refer variable `mime-field-encoding-method-alist'." bbeg end field-name) (while (re-search-forward std11-field-head-regexp nil t) (setq bbeg (match-end 0) - field-name (buffer-substring (match-beginning 0) (1- bbeg)) + field-name (buffer-substring-no-properties (match-beginning 0) + (1- bbeg)) end (std11-field-end)) (and (delq 'ascii (find-charset-region bbeg end)) (let ((method (eword-find-field-encoding-method (downcase field-name)))) (cond ((eq method 'mime) - (let ((field-body - (buffer-substring-no-properties bbeg end) - )) - (delete-region bbeg end) - (insert (mime-encode-field-body field-body - field-name)))) + (let* ((field-body + (buffer-substring-no-properties bbeg end)) + (encoded-body + (mime-encode-field-body + field-body field-name))) + (if (not encoded-body) + (error "Cannot encode %s:%s" + field-name field-body) + (delete-region bbeg end) + (insert encoded-body)))) (code-conversion (let ((cs (or (mime-charset-to-coding-system method) default-cs))) - (encode-coding-region bbeg end cs) - ))) - )) - )) - ))) + (encode-coding-region bbeg end cs))))))))))) (defalias 'eword-encode-header 'mime-encode-header-in-buffer) (make-obsolete 'eword-encode-header 'mime-encode-header-in-buffer)