tm-eword.el

   1 ;;;
   2 ;;; tm-eword.el --- RFC 1522 based multilingual MIME message header
   3 ;;;                 encoder/decoder for GNU Emacs
   4 ;;;
   5 ;;; Copyright (C) 1995 Free Software Foundation, Inc.
   6 ;;; Copyright (C) 1993,1994,1995 MORIOKA Tomohiko
   7 ;;;
   8 ;;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
   9 ;;; Keywords: mail, news, MIME, RFC 1522, multilingual, encoded-word
  10 ;;;
  11
  12 (require 'tl-header)
  13 (require 'tl-str)
  14 (require 'tm-def)
  15
  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)
  19
  20 (require 'tm-ew-e)
  21
  22
  23 ;;; @ version
  24 ;;;
  25
  26 (defconst tm-eword/RCS-ID
  27   "$Id: tm-eword.el,v 7.0 1995/10/03 04:40:06 morioka Exp $")
  28
  29 (defconst tm-eword/version (get-version-string tm-eword/RCS-ID))
  30
  31
  32 ;;; @ variables
  33 ;;;
  34
  35 (defvar mime/no-encoding-header-fields '("X-Nsubject" "Newsgroups"))
  36
  37 (defvar mime/use-X-Nsubject nil)
  38
  39
  40 ;;; @ Application Interface
  41 ;;;
  42
  43 ;;; @@ MIME header encoders
  44 ;;;
  45
  46 (defun mime/encode-field (str)
  47   (setq str (message/unfolding-string str))
  48   (let ((ret (message/divide-field str))
  49         field-name field-body)
  50     (setq field-name (car ret))
  51     (setq field-body (nth 1 ret))
  52     (concat field-name " "
  53             (cond ((string= field-body "") "")
  54                   ((or (string-match "^Reply-To:$" field-name)
  55                        (string-match "^From:$" field-name)
  56                        (string-match "^Sender:$" field-name)
  57                        (string-match "^Resent-Reply-To:$" field-name)
  58                        (string-match "^Resent-From:$" field-name)
  59                        (string-match "^Resent-Sender:$" field-name)
  60                        (string-match "^To:$" field-name)
  61                        (string-match "^Resent-To:$" field-name)
  62                        (string-match "^cc:$" field-name)
  63                        (string-match "^Resent-cc:$" field-name)
  64                        (string-match "^bcc:$" field-name)
  65                        (string-match "^Resent-bcc:$" field-name)
  66                        )
  67                    (car (tm-eword::encode-address-list
  68                          (+ (length field-name) 1) field-body))
  69                    )
  70                   (t
  71                    (catch 'tag
  72                      (let ((r mime/no-encoding-header-fields) fn)
  73                        (while r
  74                          (setq fn (car r))
  75                          (if (string-match (concat "^" fn ":$") field-name)
  76                              (throw 'tag field-body)
  77                            )
  78                          (setq r (cdr r))
  79                          ))
  80                      (car (tm-eword::encode-string
  81                            (+ (length field-name) 1) field-body))
  82                      ))
  83                   ))
  84     ))
  85
  86 (defun mime/exist-encoded-word-in-subject ()
  87   (let ((str (message/get-field-body "Subject")))
  88     (if (and str (string-match mime/encoded-word-regexp str))
  89         str)))
  90
  91 (defun mime/encode-message-header ()
  92   (interactive "*")
  93   (save-excursion
  94     (save-restriction
  95       (narrow-to-region (goto-char (point-min))
  96                         (progn
  97                           (re-search-forward
  98                            (concat
  99                             "^" (regexp-quote mail-header-separator) "$")
 100                            nil t)
 101                           (match-beginning 0)
 102                           ))
 103       (goto-char (point-min))
 104       (let (beg end field)
 105         (while (re-search-forward "^.+:.*\\(\n\\s +.*\\)*" nil t)
 106           (setq beg (match-beginning 0))
 107           (setq end  (match-end 0))
 108           (setq field (buffer-substring beg end))
 109           (insert (mime/encode-field
 110                    (prog1
 111                        (buffer-substring beg end)
 112                      (delete-region beg end)
 113                      )))
 114           ))
 115       (if mime/use-X-Nsubject
 116           (let ((str (mime/exist-encoded-word-in-subject)))
 117             (if str
 118                 (insert
 119                  (concat
 120                   "\nX-Nsubject: "
 121                   (mime/decode-encoded-words-string
 122                    (message/unfolding-string str))
 123                   )))))
 124       )))
 125
 126
 127 ;;; @ end
 128 ;;;
 129
 130 (provide 'tm-eword)
 131
 132 (run-hooks 'tm-eword-load-hook)