eword-decode.el

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