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.4 $
  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.4 1997-02-24 08:51:06 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 ;;; @ for string
  68 ;;;
  69
  70 (defun eword-decode-string (string &optional must-unfold)
  71   "Decode MIME encoded-words in STRING.
  72
  73 STRING is unfolded before decoding.
  74
  75 If an encoded-word is broken or your emacs implementation can not
  76 decode the charset included in it, it is not decoded.
  77
  78 If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even
  79 if there are in decoded encoded-words (generated by bad manner MUA
  80 such as a version of Net$cape)."
  81   (setq string (std11-unfold-string string))
  82   (let ((dest "")(ew nil)
  83         beg end)
  84     (while (and (string-match eword-encoded-word-regexp string)
  85                 (setq beg (match-beginning 0)
  86                       end (match-end 0))
  87                 )
  88       (if (> beg 0)
  89           (if (not
  90                (and (eq ew t)
  91                     (string-match "^[ \t]+$" (substring string 0 beg))
  92                     ))
  93               (setq dest (concat dest (substring string 0 beg)))
  94             )
  95         )
  96       (setq dest
  97             (concat dest
  98                     (eword-decode-encoded-word
  99                      (substring string beg end) must-unfold)
 100                     ))
 101       (setq string (substring string end))
 102       (setq ew t)
 103       )
 104     (concat dest string)
 105     ))
 106
 107
 108 ;;; @ for region
 109 ;;;
 110
 111 (defun eword-decode-region (start end &optional unfolding must-unfold)
 112   "Decode MIME encoded-words in region between START and END.
 113
 114 If UNFOLDING is not nil, it unfolds before decoding.
 115
 116 If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even
 117 if there are in decoded encoded-words (generated by bad manner MUA
 118 such as a version of Net$cape)."
 119   (interactive "*r")
 120   (save-excursion
 121     (save-restriction
 122       (narrow-to-region start end)
 123       (if unfolding
 124           (eword-decode-unfold)
 125         )
 126       (goto-char (point-min))
 127       (while (re-search-forward (concat "\\(" eword-encoded-word-regexp "\\)"
 128                                         "\\(\n?[ \t]\\)+"
 129                                         "\\(" eword-encoded-word-regexp "\\)")
 130                                 nil t)
 131         (replace-match "\\1\\6")
 132         (goto-char (point-min))
 133         )
 134       (let (charset encoding text)
 135         (while (re-search-forward eword-encoded-word-regexp nil t)
 136           (insert (eword-decode-encoded-word
 137                    (prog1
 138                        (buffer-substring (match-beginning 0) (match-end 0))
 139                      (delete-region (match-beginning 0) (match-end 0))
 140                      ) must-unfold))
 141           ))
 142       )))
 143
 144
 145 ;;; @ for message header
 146 ;;;
 147
 148 (defun eword-decode-header (&optional separator)
 149   "Decode MIME encoded-words in header fields.
 150 If SEPARATOR is not nil, it is used as header separator."
 151   (interactive "*")
 152   (save-excursion
 153     (save-restriction
 154       (std11-narrow-to-header separator)
 155       (eword-decode-region (point-min) (point-max) t)
 156       )))
 157
 158 (defun eword-decode-unfold ()
 159   (goto-char (point-min))
 160   (let (field beg end)
 161     (while (re-search-forward std11-field-head-regexp nil t)
 162       (setq beg (match-beginning 0)
 163             end (std11-field-end))
 164       (setq field (buffer-substring beg end))
 165       (if (string-match eword-encoded-word-regexp field)
 166           (save-restriction
 167             (narrow-to-region (goto-char beg) end)
 168             (while (re-search-forward "\n\\([ \t]\\)" nil t)
 169               (replace-match (match-string 1))
 170               )
 171             (goto-char (point-max))
 172             ))
 173       )))
 174
 175
 176 ;;; @ encoded-word decoder
 177 ;;;
 178
 179 (defun eword-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)."
 188   (or (if (string-match eword-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                 (eword-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 eword-decode-encoded-text (charset encoding string
 215                                           &optional must-unfold)
 216   "Decode STRING as an encoded-text.
 217
 218 If your emacs implementation can not decode CHARSET, it returns nil.
 219
 220 If ENCODING is not \"B\" or \"Q\", it occurs error.
 221 So you should write error-handling code if you don't want break by errors.
 222
 223 If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even
 224 if there are in decoded encoded-text (generated by bad manner MUA such
 225 as a version of Net$cape)."
 226   (let ((cs (mime-charset-to-coding-system charset)))
 227     (if cs
 228         (let ((dest
 229                (cond
 230                 ((string-equal "B" encoding)
 231                  (if (and (string-match eword-B-encoded-text-regexp string)
 232                           (string-equal string (match-string 0 string)))
 233                      (base64-decode-string string)
 234                    (error "Invalid encoded-text %s" string)))
 235                 ((string-equal "Q" encoding)
 236                  (if (and (string-match eword-Q-encoded-text-regexp string)
 237                           (string-equal string (match-string 0 string)))
 238                      (q-encoding-decode-string string)
 239                    (error "Invalid encoded-text %s" string)))
 240                 (t
 241                  (error "Invalid encoding %s" encoding)
 242                  )))
 243               )
 244           (if dest
 245               (progn
 246                 (setq dest (decode-coding-string dest cs))
 247                 (if must-unfold
 248                     (mapconcat (function
 249                                 (lambda (chr)
 250                                   (cond
 251                                    ((eq chr ?\n) "")
 252                                    ((eq chr ?\t) " ")
 253                                    (t (char-to-string chr)))
 254                                   ))
 255                                (std11-unfold-string dest)
 256                                "")
 257                   dest)
 258                 ))))))
 259
 260
 261 ;;; @ end
 262 ;;;
 263
 264 (provide 'eword-decode)
 265
 266 ;;; eword-decode.el ends here