2 ;;; tm-eword.el --- RFC 1522 based multilingual MIME message header
3 ;;; encoder/decoder for GNU Emacs
5 ;;; Copyright (C) 1995 Free Software Foundation, Inc.
6 ;;; Copyright (C) 1993,1994,1995 MORIOKA Tomohiko
8 ;;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
9 ;;; Keywords: mail, news, MIME, RFC 1522, multilingual, encoded-word
16 (autoload 'mime/decode-encoded-words-string "tm-ew-d")
17 (autoload 'mime/decode-encoded-words-region "tm-ew-d" nil t)
18 (autoload 'mime/decode-message-header "tm-ew-d" nil t)
26 (defconst tm-eword/RCS-ID
27 "$Id: tm-eword.el,v 7.2 1995/10/05 12:22:42 morioka Exp $")
29 (defconst tm-eword/version (get-version-string tm-eword/RCS-ID))
35 (defvar mime/no-encoding-header-fields '("X-Nsubject" "Newsgroups"))
37 (defvar mime/use-X-Nsubject nil)
40 ;;; @ Application Interface
43 ;;; @@ MIME header encoders
46 (defun mime/encode-field (str)
47 (setq str (rfc822/unfolding-string str))
48 (let ((ret (string-match rfc822/field-top-regexp str)))
50 (let ((field-name (substring str 0 (match-end 1)))
51 (field-body (eliminate-top-spaces
52 (substring str (match-end 0))))
54 (concat field-name ": "
55 (cond ((string= field-body "") "")
56 ((member (setq fname (downcase field-name))
57 '("reply-to" "from" "sender"
58 "resent-reply-to" "resent-from"
59 "resent-sender" "to" "resent-to"
61 "bcc" "resent-bcc" "dcc")
63 (car (tm-eword::encode-address-list
64 (+ (length field-name) 1) field-body))
68 (let ((r mime/no-encoding-header-fields) fn)
71 (if (string= (downcase fn) fname)
72 (throw 'tag field-body)
76 (car (tm-eword::encode-string
77 (+ (length field-name) 1) field-body))
83 (defun mime/exist-encoded-word-in-subject ()
84 (let ((str (rfc822/get-field-body "Subject")))
85 (if (and str (string-match mime/encoded-word-regexp str))
88 (defun mime/encode-message-header ()
92 (narrow-to-region (goto-char (point-min))
96 "^" (regexp-quote mail-header-separator) "$")
100 (goto-char (point-min))
102 (while (re-search-forward "^.+:.*\\(\n\\s +.*\\)*" nil t)
103 (setq beg (match-beginning 0))
104 (setq end (match-end 0))
105 (if (setq field (mime/encode-field (buffer-substring beg end)))
107 (delete-region beg end)
111 (if mime/use-X-Nsubject
112 (let ((str (mime/exist-encoded-word-in-subject)))
117 (mime/decode-encoded-words-string
118 (rfc822/unfolding-string str))
128 (run-hooks 'tm-eword-load-hook)