tm-ew-d.el

   1 ;;; tm-ew-d.el --- RFC 2047 based encoded-word decoder for GNU Emacs
   2
   3 ;; Copyright (C) 1995,1996 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.34 $
  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
  39
  40 ;;; @ version
  41 ;;;
  42
  43 (defconst tm-ew-d/RCS-ID
  44   "$Id: tm-ew-d.el,v 7.34 1996/12/04 04:49:14 morioka Exp $")
  45 (defconst mime/eword-decoder-version (get-version-string tm-ew-d/RCS-ID))
  46
  47
  48 ;;; @ MIME encoded-word definition
  49 ;;;
  50
  51 (defconst mime/encoded-text-regexp "[!->@-~]+")
  52 (defconst mime/encoded-word-regexp (concat (regexp-quote "=?")
  53                                            "\\("
  54                                            mime/charset-regexp
  55                                            "\\)"
  56                                            (regexp-quote "?")
  57                                            "\\(B\\|Q\\)"
  58                                            (regexp-quote "?")
  59                                            "\\("
  60                                            mime/encoded-text-regexp
  61                                            "\\)"
  62                                            (regexp-quote "?=")))
  63
  64
  65 ;;; @ for string
  66 ;;;
  67
  68 (defun mime-eword/decode-string (string &optional must-unfold)
  69   "Decode MIME encoded-words in STRING.
  70
  71 STRING is unfolded before decoding.
  72
  73 If an encoded-word is broken or your emacs implementation can not
  74 decode the charset included in it, it is not decoded.
  75
  76 If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even
  77 if there are in decoded encoded-words (generated by bad manner MUA
  78 such as a version of Net$cape). [tm-ew-d.el]"
  79   (setq string (std11-unfold-string string))
  80   (let ((dest "")(ew nil)
  81         beg end)
  82     (while (and (string-match mime/encoded-word-regexp string)
  83                 (setq beg (match-beginning 0)
  84                       end (match-end 0))
  85                 )
  86       (if (> beg 0)
  87           (if (not
  88                (and (eq ew t)
  89                     (string-match "^[ \t]+$" (substring string 0 beg))
  90                     ))
  91               (setq dest (concat dest (substring string 0 beg)))
  92             )
  93         )
  94       (setq dest
  95             (concat dest
  96                     (mime/decode-encoded-word
  97                      (substring string beg end) must-unfold)
  98                     ))
  99       (setq string (substring string end))
 100       (setq ew t)
 101       )
 102     (concat dest string)
 103     ))
 104
 105
 106 ;;; @ for region
 107 ;;;
 108
 109 (defun mime-eword/decode-region (start end &optional unfolding must-unfold)
 110   "Decode MIME encoded-words in region between START and END.
 111
 112 If UNFOLDING is not nil, it unfolds before decoding.
 113
 114 If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even
 115 if there are in decoded encoded-words (generated by bad manner MUA
 116 such as a version of Net$cape). [tm-ew-d.el]"
 117   (interactive "*r")
 118   (save-excursion
 119     (save-restriction
 120       (narrow-to-region start end)
 121       (if unfolding
 122           (mime/unfolding)
 123         )
 124       (goto-char (point-min))
 125       (while (re-search-forward "\\?=\\(\n*\\s +\\)+=\\?" nil t)
 126         (replace-match "?==?")
 127         )
 128       (goto-char (point-min))
 129       (let (charset encoding text)
 130         (while (re-search-forward mime/encoded-word-regexp nil t)
 131           (insert (mime/decode-encoded-word
 132                    (prog1
 133                        (buffer-substring (match-beginning 0) (match-end 0))
 134                      (delete-region (match-beginning 0) (match-end 0))
 135                      ) must-unfold))
 136           ))
 137       )))
 138
 139
 140 ;;; @ for message header
 141 ;;;
 142
 143 (defun mime/decode-message-header ()
 144   "Decode MIME encoded-words in message header. [tm-ew-d.el]"
 145   (interactive "*")
 146   (save-excursion
 147     (save-restriction
 148       (narrow-to-region (goto-char (point-min))
 149                         (progn (re-search-forward "^$" nil t) (point)))
 150       (mime-eword/decode-region (point-min) (point-max) t)
 151       )))
 152
 153 (defun mime/unfolding ()
 154   (goto-char (point-min))
 155   (let (field beg end)
 156     (while (re-search-forward std11-field-head-regexp nil t)
 157       (setq beg (match-beginning 0)
 158             end (std11-field-end))
 159       (setq field (buffer-substring beg end))
 160       (if (string-match mime/encoded-word-regexp field)
 161           (save-restriction
 162             (narrow-to-region (goto-char beg) end)
 163             (while (re-search-forward "\n\\([ \t]\\)" nil t)
 164               (replace-match
 165                (match-string 1))
 166               )
 167             (goto-char (point-max))
 168             ))
 169       )))
 170
 171
 172 ;;; @ encoded-word decoder
 173 ;;;
 174
 175 (defun mime/decode-encoded-word (word &optional must-unfold)
 176   "Decode WORD if it is an encoded-word.
 177
 178 If your emacs implementation can not decode the charset of WORD, it
 179 returns WORD.  Similarly the encoded-word is broken, it returns WORD.
 180
 181 If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even
 182 if there are in decoded encoded-word (generated by bad manner MUA such
 183 as a version of Net$cape). [tm-ew-d.el]"
 184   (or (if (string-match mime/encoded-word-regexp word)
 185           (let ((charset
 186                  (substring word (match-beginning 1) (match-end 1))
 187                  )
 188                 (encoding
 189                  (upcase
 190                   (substring word (match-beginning 2) (match-end 2))
 191                   ))
 192                 (text
 193                  (substring word (match-beginning 3) (match-end 3))
 194                  ))
 195             (condition-case err
 196                 (mime/decode-encoded-text charset encoding text must-unfold)
 197               (error nil))
 198             ))
 199       word))
 200
 201
 202 ;;; @ encoded-text decoder
 203 ;;;
 204
 205 (defun mime/decode-encoded-text (charset encoding string &optional must-unfold)
 206   "Decode STRING as an encoded-text.
 207
 208 If your emacs implementation can not decode CHARSET, it returns nil.
 209
 210 If ENCODING is not \"B\" or \"Q\", it occurs error.
 211 So you should write error-handling code if you don't want break by errors.
 212
 213 If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even
 214 if there are in decoded encoded-text (generated by bad manner MUA such
 215 as a version of Net$cape). [tm-ew-d.el]"
 216   (let ((cs (mime-charset-to-coding-system charset)))
 217     (if cs
 218         (let ((dest
 219                (cond ((and (string-equal "B" encoding)
 220                            (string-match mime/B-encoded-text-regexp string))
 221                       (base64-decode-string string))
 222                      ((and (string-equal "Q" encoding)
 223                            (string-match mime/Q-encoded-text-regexp string))
 224                       (q-encoding-decode-string string))
 225                      (t (message "Invalid encoded-word %s" encoding)
 226                         nil))))
 227           (if dest
 228               (progn
 229                 (setq dest (decode-coding-string dest cs))
 230                 (if must-unfold
 231                     (mapconcat (function
 232                                 (lambda (chr)
 233                                   (if (eq chr ?\n)
 234                                       ""
 235                                     (char-to-string chr)
 236                                     )
 237                                   ))
 238                                (std11-unfold-string dest)
 239                                "")
 240                   dest)
 241                 ))))))
 242
 243
 244 ;;; @ end
 245 ;;;
 246
 247 (provide 'tm-ew-d)
 248
 249 ;;; tm-ew-d.el ends here