tm-ew-d.el

   1 ;;; tm-ew-d.el --- RFC 2047 based encoded-word decoder for GNU Emacs
   2
   3 ;; Copyright (C) 1995,1996,1997 Free Software Foundation, Inc.
   4
   5 ;; Author: ENAMI Tsugutomo <enami@sys.ptg.sony.co.jp>
   6 ;;         MORIOKA Tomohiko <morioka@jaist.ac.jp>
   7 ;; Maintainer: MORIOKA Tomohiko <morioka@jaist.ac.jp>
   8 ;; Created: 1995/10/03
   9 ;; Original: 1992/07/20 ENAMI Tsugutomo's `mime.el'.
  10 ;;      Renamed: 1993/06/03 to tiny-mime.el.
  11 ;;      Renamed: 1995/10/03 from tiny-mime.el. (split off encoder)
  12 ;; Version: $Revision: 7.39 $
  13 ;; Keywords: encoded-word, MIME, multilingual, header, mail, news
  14
  15 ;; This file is part of tm (Tools for MIME).
  16
  17 ;; This program is free software; you can redistribute it and/or
  18 ;; modify it under the terms of the GNU General Public License as
  19 ;; published by the Free Software Foundation; either version 2, or (at
  20 ;; your option) any later version.
  21
  22 ;; This program is distributed in the hope that it will be useful, but
  23 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  24 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  25 ;; General Public License for more details.
  26
  27 ;; You should have received a copy of the GNU General Public License
  28 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  29 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  30 ;; Boston, MA 02111-1307, USA.
  31
  32 ;;; Code:
  33
  34 (require 'emu)
  35 (require 'std11)
  36 (require 'mel)
  37 (require 'tm-def)
  38 (require 'tl-str)
  39
  40
  41 ;;; @ version
  42 ;;;
  43
  44 (defconst tm-ew-d/RCS-ID
  45   "$Id: tm-ew-d.el,v 7.39 1997/01/21 06:17:18 shuhei-k Exp $")
  46 (defconst mime/eword-decoder-version (get-version-string tm-ew-d/RCS-ID))
  47
  48
  49 ;;; @ MIME encoded-word definition
  50 ;;;
  51
  52 (defconst mime/encoded-text-regexp "[!->@-~]+")
  53 (defconst mime/encoded-word-regexp (concat (regexp-quote "=?")
  54                                            "\\("
  55                                            mime/charset-regexp
  56                                            "\\)"
  57                                            (regexp-quote "?")
  58                                            "\\(B\\|Q\\)"
  59                                            (regexp-quote "?")
  60                                            "\\("
  61                                            mime/encoded-text-regexp
  62                                            "\\)"
  63                                            (regexp-quote "?=")))
  64
  65
  66 ;;; @ for string
  67 ;;;
  68
  69 (defun mime-eword/decode-string (string &optional must-unfold)
  70   "Decode MIME encoded-words in STRING.
  71
  72 STRING is unfolded before decoding.
  73
  74 If an encoded-word is broken or your emacs implementation can not
  75 decode the charset included in it, it is not decoded.
  76
  77 If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even
  78 if there are in decoded encoded-words (generated by bad manner MUA
  79 such as a version of Net$cape). [tm-ew-d.el]"
  80   (setq string (std11-unfold-string string))
  81   (let ((dest "")(ew nil)
  82         beg end)
  83     (while (and (string-match mime/encoded-word-regexp string)
  84                 (setq beg (match-beginning 0)
  85                       end (match-end 0))
  86                 )
  87       (if (> beg 0)
  88           (if (not
  89                (and (eq ew t)
  90                     (string-match "^[ \t]+$" (substring string 0 beg))
  91                     ))
  92               (setq dest (concat dest (substring string 0 beg)))
  93             )
  94         )
  95       (setq dest
  96             (concat dest
  97                     (mime/decode-encoded-word
  98                      (substring string beg end) must-unfold)
  99                     ))
 100       (setq string (substring string end))
 101       (setq ew t)
 102       )
 103     (concat dest string)
 104     ))
 105
 106
 107 ;;; @ for region
 108 ;;;
 109
 110 (defun mime-eword/decode-region (start end &optional unfolding must-unfold)
 111   "Decode MIME encoded-words in region between START and END.
 112
 113 If UNFOLDING is not nil, it unfolds before decoding.
 114
 115 If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even
 116 if there are in decoded encoded-words (generated by bad manner MUA
 117 such as a version of Net$cape). [tm-ew-d.el]"
 118   (interactive "*r")
 119   (save-excursion
 120     (save-restriction
 121       (narrow-to-region start end)
 122       (if unfolding
 123           (mime/unfolding)
 124         )
 125       (goto-char (point-min))
 126       (while (re-search-forward (concat "\\(" mime/encoded-word-regexp "\\)"
 127                                         "\\(\n?[ \t]\\)+"
 128                                         "\\(" mime/encoded-word-regexp "\\)")
 129                                 nil t)
 130         (replace-match "\\1\\6")
 131         (goto-char (point-min))
 132         )
 133       (let (charset encoding text)
 134         (while (re-search-forward mime/encoded-word-regexp nil t)
 135           (insert (mime/decode-encoded-word
 136                    (prog1
 137                        (buffer-substring (match-beginning 0) (match-end 0))
 138                      (delete-region (match-beginning 0) (match-end 0))
 139                      ) must-unfold))
 140           ))
 141       )))
 142
 143
 144 ;;; @ for message header
 145 ;;;
 146
 147 (defun mime/decode-message-header ()
 148   "Decode MIME encoded-words in message header. [tm-ew-d.el]"
 149   (interactive "*")
 150   (save-excursion
 151     (save-restriction
 152       (narrow-to-region (goto-char (point-min))
 153                         (progn (re-search-forward "^$" nil t) (point)))
 154       (mime-eword/decode-region (point-min) (point-max) t)
 155       )))
 156
 157 (defun mime/unfolding ()
 158   (goto-char (point-min))
 159   (let (field beg end)
 160     (while (re-search-forward std11-field-head-regexp nil t)
 161       (setq beg (match-beginning 0)
 162             end (std11-field-end))
 163       (setq field (buffer-substring beg end))
 164       (if (string-match mime/encoded-word-regexp field)
 165           (save-restriction
 166             (narrow-to-region (goto-char beg) end)
 167             (while (re-search-forward "\n\\([ \t]\\)" nil t)
 168               (replace-match
 169                (match-string 1))
 170               )
 171             (goto-char (point-max))
 172             ))
 173       )))
 174
 175
 176 ;;; @ encoded-word decoder
 177 ;;;
 178
 179 (defun mime/decode-encoded-word (word &optional must-unfold)
 180   "Decode WORD if it is an encoded-word.
 181
 182 If your emacs implementation can not decode the charset of WORD, it
 183 returns WORD.  Similarly the encoded-word is broken, it returns WORD.
 184
 185 If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even
 186 if there are in decoded encoded-word (generated by bad manner MUA such
 187 as a version of Net$cape). [tm-ew-d.el]"
 188   (or (if (string-match mime/encoded-word-regexp word)
 189           (let ((charset
 190                  (substring word (match-beginning 1) (match-end 1))
 191                  )
 192                 (encoding
 193                  (upcase
 194                   (substring word (match-beginning 2) (match-end 2))
 195                   ))
 196                 (text
 197                  (substring word (match-beginning 3) (match-end 3))
 198                  ))
 199             (condition-case err
 200                 (mime/decode-encoded-text charset encoding text must-unfold)
 201               (error
 202                (and (tl:add-text-properties 0 (length word)
 203                                             (and tm:warning-face
 204                                                  (list 'face tm:warning-face))
 205                                             word)
 206                     word)))
 207             ))
 208       word))
 209
 210
 211 ;;; @ encoded-text decoder
 212 ;;;
 213
 214 (defun mime/decode-encoded-text (charset encoding string &optional must-unfold)
 215   "Decode STRING as an encoded-text.
 216
 217 If your emacs implementation can not decode CHARSET, it returns nil.
 218
 219 If ENCODING is not \"B\" or \"Q\", it occurs error.
 220 So you should write error-handling code if you don't want break by errors.
 221
 222 If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even
 223 if there are in decoded encoded-text (generated by bad manner MUA such
 224 as a version of Net$cape). [tm-ew-d.el]"
 225   (let ((cs (mime-charset-to-coding-system charset)))
 226     (if cs
 227         (let ((dest
 228                (cond
 229                 ((string-equal "B" encoding)
 230                  (if (and (string-match mime/B-encoded-text-regexp string)
 231                           (string-equal string (match-string 0 string)))
 232                      (base64-decode-string string)
 233                    (error "Invalid encoded-text %s" string)))
 234                 ((string-equal "Q" encoding)
 235                  (if (and (string-match mime/Q-encoded-text-regexp string)
 236                           (string-equal string (match-string 0 string)))
 237                      (q-encoding-decode-string string)
 238                    (error "Invalid encoded-text %s" string)))
 239                 (t
 240                  (error "Invalid encoding %s" encoding)
 241                  )))
 242               )
 243           (if dest
 244               (progn
 245                 (setq dest (decode-coding-string dest cs))
 246                 (if must-unfold
 247                     (mapconcat (function
 248                                 (lambda (chr)
 249                                   (cond
 250                                    ((eq chr ?\n) "")
 251                                    ((eq chr ?\t) " ")
 252                                    (t (char-to-string chr)))
 253                                   ))
 254                                (std11-unfold-string dest)
 255                                "")
 256                   dest)
 257                 ))))))
 258
 259
 260 ;;; @ end
 261 ;;;
 262
 263 (provide 'tm-ew-d)
 264
 265 ;;; tm-ew-d.el ends here