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.13 $
  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 'emu)
  36 (require 'std11)
  37 (require 'mel)
  38 (require 'mime-def)
  39
  40
  41 ;;; @ version
  42 ;;;
  43
  44 (defconst eword-decode-RCS-ID
  45   "$Id: eword-decode.el,v 0.13 1997-02-26 13:01:25 tmorioka Exp $")
  46 (defconst eword-decode-version (get-version-string eword-decode-RCS-ID))
  47
  48
  49 ;;; @ MIME encoded-word definition
  50 ;;;
  51
  52 (defconst eword-encoded-text-regexp "[!->@-~]+")
  53 (defconst eword-encoded-word-regexp
  54   (concat (regexp-quote "=?")
  55           "\\("
  56           mime-charset-regexp
  57           "\\)"
  58           (regexp-quote "?")
  59           "\\(B\\|Q\\)"
  60           (regexp-quote "?")
  61           "\\("
  62           eword-encoded-text-regexp
  63           "\\)"
  64           (regexp-quote "?=")))
  65
  66
  67 ;;; @@ Base64
  68 ;;;
  69
  70 (defconst base64-token-regexp "[A-Za-z0-9+/]")
  71 (defconst base64-token-padding-regexp "[A-Za-z0-9+/=]")
  72
  73 (defconst eword-B-encoded-text-regexp
  74   (concat "\\(\\("
  75           base64-token-regexp
  76           base64-token-regexp
  77           base64-token-regexp
  78           base64-token-regexp
  79           "\\)*"
  80           base64-token-regexp
  81           base64-token-regexp
  82           base64-token-padding-regexp
  83           base64-token-padding-regexp
  84           "\\)"))
  85
  86 ;; (defconst eword-B-encoding-and-encoded-text-regexp
  87 ;;   (concat "\\(B\\)\\?" eword-B-encoded-text-regexp))
  88
  89
  90 ;;; @@ Quoted-Printable
  91 ;;;
  92
  93 (defconst quoted-printable-hex-chars "0123456789ABCDEF")
  94 (defconst quoted-printable-octet-regexp
  95   (concat "=[" quoted-printable-hex-chars
  96           "][" quoted-printable-hex-chars "]"))
  97
  98 (defconst eword-Q-encoded-text-regexp
  99   (concat "\\([^=?]\\|" quoted-printable-octet-regexp "\\)+"))
 100 ;; (defconst eword-Q-encoding-and-encoded-text-regexp
 101 ;;   (concat "\\(Q\\)\\?" eword-Q-encoded-text-regexp))
 102
 103
 104 ;;; @ for string
 105 ;;;
 106
 107 (defun eword-decode-string (string &optional must-unfold)
 108   "Decode MIME encoded-words in STRING.
 109
 110 STRING is unfolded before decoding.
 111
 112 If an encoded-word is broken or your emacs implementation can not
 113 decode the charset included in it, it is not decoded.
 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)."
 118   (setq string (std11-unfold-string string))
 119   (let ((dest "")(ew nil)
 120         beg end)
 121     (while (and (string-match eword-encoded-word-regexp string)
 122                 (setq beg (match-beginning 0)
 123                       end (match-end 0))
 124                 )
 125       (if (> beg 0)
 126           (if (not
 127                (and (eq ew t)
 128                     (string-match "^[ \t]+$" (substring string 0 beg))
 129                     ))
 130               (setq dest (concat dest (substring string 0 beg)))
 131             )
 132         )
 133       (setq dest
 134             (concat dest
 135                     (eword-decode-encoded-word
 136                      (substring string beg end) must-unfold)
 137                     ))
 138       (setq string (substring string end))
 139       (setq ew t)
 140       )
 141     (concat dest string)
 142     ))
 143
 144
 145 ;;; @ for region
 146 ;;;
 147
 148 (defun eword-decode-region (start end &optional unfolding must-unfold)
 149   "Decode MIME encoded-words in region between START and END.
 150
 151 If UNFOLDING is not nil, it unfolds before decoding.
 152
 153 If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even
 154 if there are in decoded encoded-words (generated by bad manner MUA
 155 such as a version of Net$cape)."
 156   (interactive "*r")
 157   (save-excursion
 158     (save-restriction
 159       (narrow-to-region start end)
 160       (if unfolding
 161           (eword-decode-unfold)
 162         )
 163       (goto-char (point-min))
 164       (while (re-search-forward (concat "\\(" eword-encoded-word-regexp "\\)"
 165                                         "\\(\n?[ \t]\\)+"
 166                                         "\\(" eword-encoded-word-regexp "\\)")
 167                                 nil t)
 168         (replace-match "\\1\\6")
 169         (goto-char (point-min))
 170         )
 171       (while (re-search-forward eword-encoded-word-regexp nil t)
 172         (insert (eword-decode-encoded-word
 173                  (prog1
 174                      (buffer-substring (match-beginning 0) (match-end 0))
 175                    (delete-region (match-beginning 0) (match-end 0))
 176                    ) must-unfold))
 177         )
 178       )))
 179
 180
 181 ;;; @ for message header
 182 ;;;
 183
 184 (defun eword-decode-header (&optional separator)
 185   "Decode MIME encoded-words in header fields.
 186 If SEPARATOR is not nil, it is used as header separator."
 187   (interactive "*")
 188   (save-excursion
 189     (save-restriction
 190       (std11-narrow-to-header separator)
 191       (eword-decode-region (point-min) (point-max) t)
 192       )))
 193
 194 (defun eword-decode-unfold ()
 195   (goto-char (point-min))
 196   (let (field beg end)
 197     (while (re-search-forward std11-field-head-regexp nil t)
 198       (setq beg (match-beginning 0)
 199             end (std11-field-end))
 200       (setq field (buffer-substring beg end))
 201       (if (string-match eword-encoded-word-regexp field)
 202           (save-restriction
 203             (narrow-to-region (goto-char beg) end)
 204             (while (re-search-forward "\n\\([ \t]\\)" nil t)
 205               (replace-match (match-string 1))
 206               )
 207             (goto-char (point-max))
 208             ))
 209       )))
 210
 211
 212 ;;; @ encoded-word decoder
 213 ;;;
 214
 215 (defvar eword-warning-face nil "Face used for invalid encoded-word.")
 216
 217 (defun eword-decode-encoded-word (word &optional must-unfold)
 218   "Decode WORD if it is an encoded-word.
 219
 220 If your emacs implementation can not decode the charset of WORD, it
 221 returns WORD.  Similarly the encoded-word is broken, it returns WORD.
 222
 223 If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even
 224 if there are in decoded encoded-word (generated by bad manner MUA such
 225 as a version of Net$cape)."
 226   (or (if (string-match eword-encoded-word-regexp word)
 227           (let ((charset
 228                  (substring word (match-beginning 1) (match-end 1))
 229                  )
 230                 (encoding
 231                  (upcase
 232                   (substring word (match-beginning 2) (match-end 2))
 233                   ))
 234                 (text
 235                  (substring word (match-beginning 3) (match-end 3))
 236                  ))
 237             (condition-case err
 238                 (eword-decode-encoded-text charset encoding text must-unfold)
 239               (error
 240                (and
 241                 (add-text-properties 0 (length word)
 242                                      (and eword-warning-face
 243                                           (list 'face eword-warning-face))
 244                                      word)
 245                 word)))
 246             ))
 247       word))
 248
 249
 250 ;;; @ encoded-text decoder
 251 ;;;
 252
 253 (defun eword-decode-encoded-text (charset encoding string
 254                                           &optional must-unfold)
 255   "Decode STRING as an encoded-text.
 256
 257 If your emacs implementation can not decode CHARSET, it returns nil.
 258
 259 If ENCODING is not \"B\" or \"Q\", it occurs error.
 260 So you should write error-handling code if you don't want break by errors.
 261
 262 If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even
 263 if there are in decoded encoded-text (generated by bad manner MUA such
 264 as a version of Net$cape)."
 265   (let ((cs (mime-charset-to-coding-system charset)))
 266     (if cs
 267         (let ((dest
 268                (cond
 269                 ((string-equal "B" encoding)
 270                  (if (and (string-match eword-B-encoded-text-regexp string)
 271                           (string-equal string (match-string 0 string)))
 272                      (base64-decode-string string)
 273                    (error "Invalid encoded-text %s" string)))
 274                 ((string-equal "Q" encoding)
 275                  (if (and (string-match eword-Q-encoded-text-regexp string)
 276                           (string-equal string (match-string 0 string)))
 277                      (q-encoding-decode-string string)
 278                    (error "Invalid encoded-text %s" string)))
 279                 (t
 280                  (error "Invalid encoding %s" encoding)
 281                  )))
 282               )
 283           (if dest
 284               (progn
 285                 (setq dest (decode-coding-string dest cs))
 286                 (if must-unfold
 287                     (mapconcat (function
 288                                 (lambda (chr)
 289                                   (cond
 290                                    ((eq chr ?\n) "")
 291                                    ((eq chr ?\t) " ")
 292                                    (t (char-to-string chr)))
 293                                   ))
 294                                (std11-unfold-string dest)
 295                                "")
 296                   dest)
 297                 ))))))
 298
 299
 300 ;;; @ end
 301 ;;;
 302
 303 (provide 'eword-decode)
 304
 305 ;;; eword-decode.el ends here