mime-text.el

   1 ;;; mime-text.el --- mime-view content filter for text
   2
   3 ;; Copyright (C) 1994,1995,1996,1997,1998 Free Software Foundation, Inc.
   4
   5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
   6 ;; Keywords: text, MIME, multimedia, mail, news
   7
   8 ;; This file is part of WEMI (Widget based Emacs MIME Interfaces).
   9
  10 ;; This program is free software; you can redistribute it and/or
  11 ;; modify it under the terms of the GNU General Public License as
  12 ;; published by the Free Software Foundation; either version 2, or (at
  13 ;; your option) any later version.
  14
  15 ;; This program is distributed in the hope that it will be useful, but
  16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  18 ;; General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24
  25 ;;; Code:
  26
  27 (require 'mime-view)
  28 (autoload 'widget-convert-text "wid-edit")
  29
  30
  31 ;;; @ buffer local variables in raw-buffer
  32 ;;;
  33
  34 (defvar mime-text-decoder nil
  35   "Function to decode text in current buffer.
  36 Interface of the function is (CHARSET &optional ENCODING).
  37 CHARSET is symbol of MIME charset and ENCODING is value of
  38 Content-Transfer-Encoding.
  39
  40 Notice that this variable is usually used as buffer local variable in
  41 raw-buffer.")
  42
  43 (make-variable-buffer-local 'mime-text-decoder)
  44
  45
  46 ;;; @ code conversion
  47 ;;;
  48
  49 (defun mime-text-decode-buffer (charset &optional encoding)
  50   "Decode text of current buffer as CHARSET.
  51 It code-converts current buffer from network representation specified
  52 by MIME CHARSET to internal code.  CHARSET is symbol of MIME charset.
  53 See also variable `mime-charset-coding-system-alist'."
  54   (decode-mime-charset-region (point-min)(point-max)
  55                               (or charset default-mime-charset))
  56   )
  57
  58 (defun mime-text-decode-buffer-maybe (charset &optional encoding)
  59   "Decode text of current buffer as CHARSET if ENCODING is actual encoding.
  60 It code-converts current buffer from network representation specified
  61 by MIME CHARSET to internal code if ENCODING is not nil, \"7bit\",
  62 \"8bit\" or \"binary\".  CHARSET is symbol of MIME charset.
  63 See also variable `mime-charset-coding-system-alist'."
  64   (or (member encoding '(nil "7bit" "8bit" "binary"))
  65       (mime-text-decode-buffer charset)
  66       ))
  67
  68 (defun mime-text-insert-decoded-body (entity situation)
  69   "Insert text body of ENTITY in SITUATION.
  70 It decodes MIME-encoding then code-converts as MIME-charset.
  71 MIME-encoding is value of field 'encoding of SITUATION.  It must be
  72 'nil or string.  MIME-charset is value of field \"charset\" of
  73 SITUATION.  It must be symbol.
  74 This function calls text-decoder for MIME-charset specified by buffer
  75 local variable `mime-text-decoder' and variable
  76 `mime-text-decoder-alist'."
  77   (insert-buffer-substring mime-raw-buffer
  78                            (mime-entity-body-start entity)
  79                            (mime-entity-body-end entity))
  80   (let ((encoding (cdr (assq 'encoding situation))))
  81     (mime-decode-region (point-min) (point-max) encoding)
  82     (goto-char (point-min))
  83     (while (search-forward "\r\n" nil t)
  84       (replace-match "\n")
  85       )
  86     (let ((text-decoder
  87            (save-excursion
  88              (set-buffer mime-raw-buffer)
  89              (or mime-text-decoder
  90                  (cdr (or (assq major-mode mime-text-decoder-alist)
  91                           (assq t mime-text-decoder-alist)))
  92                  ))))
  93       (and (functionp text-decoder)
  94            (funcall text-decoder (cdr (assoc "charset" situation)) encoding)
  95            ))
  96     (run-hooks 'mime-text-decode-hook)
  97     ))
  98
  99
 100 ;;; @ for URL
 101 ;;;
 102
 103 (require 'browse-url)
 104
 105 (defvar mime-text-url-regexp
 106   "\\(http\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\):\\(//[-a-zA-Z0-9_.]+:[0-9]*\\)?[-a-zA-Z0-9_=?#$@~`%&*+|\\/.,]*[-a-zA-Z0-9_=#$@~`%&*+|\\/]"
 107   "*Regexp to match URL in text/plain body.")
 108
 109 (defun mime-text-browse-url (&optional url)
 110   (if (fboundp browse-url-browser-function)
 111       (if url
 112         (funcall browse-url-browser-function url)
 113       (call-interactively browse-url-browser-function))
 114     (if (fboundp mime-button-mother-dispatcher)
 115         (call-interactively mime-button-mother-dispatcher)
 116       )
 117     ))
 118
 119 (defsubst mime-text-add-url-buttons ()
 120   "Add URL-buttons for text body."
 121   (goto-char (point-min))
 122   (while (re-search-forward mime-text-url-regexp nil t)
 123     (let ((beg (match-beginning 0))
 124           (end (match-end 0)))
 125       (widget-convert-text 'url-link beg end)
 126       )))
 127
 128 (defun mime-text-add-url-buttons-maybe ()
 129   "Add URL-buttons if 'browse-url-browser-function is not 'nil."
 130   (if browse-url-browser-function
 131       (mime-text-add-url-buttons)
 132     ))
 133
 134
 135 ;;; @ content filters for mime-text
 136 ;;;
 137
 138 (defun mime-preview-text/plain (entity situation)
 139   (save-restriction
 140     (narrow-to-region (point-max)(point-max))
 141     (mime-text-insert-decoded-body entity situation)
 142     (goto-char (point-max))
 143     (if (not (eq (char-after (1- (point))) ?\n))
 144         (insert "\n")
 145       )
 146     (mime-text-add-url-buttons)
 147     (run-hooks 'mime-preview-text/plain-hook)
 148     ))
 149
 150 (defun mime-preview-text/richtext (entity situation)
 151   (save-restriction
 152     (narrow-to-region (point-max)(point-max))
 153     (mime-text-insert-decoded-body entity situation)
 154     (let ((beg (point-min)))
 155       (remove-text-properties beg (point-max) '(face nil))
 156       (richtext-decode beg (point-max))
 157       )))
 158
 159 (defun mime-preview-text/enriched (entity situation)
 160   (save-restriction
 161     (narrow-to-region (point-max)(point-max))
 162     (mime-text-insert-decoded-body entity situation)
 163     (let ((beg (point-min)))
 164       (remove-text-properties beg (point-max) '(face nil))
 165       (enriched-decode beg (point-max))
 166       )))
 167
 168
 169 ;;; @ end
 170 ;;;
 171
 172 (provide 'mime-text)
 173
 174 ;;; mime-text.el ends here