mel.el

   1 ;;; mel.el --- A MIME encoding/decoding library.
   2
   3 ;; Copyright (C) 1995,1996,1997,1998,1999 Free Software Foundation, Inc.
   4
   5 ;; Author: MORIOKA Tomohiko <tomo@m17n.org>
   6 ;; Created: 1995/6/25
   7 ;; Keywords: MIME, Base64, Quoted-Printable, uuencode, gzip64
   8
   9 ;; This file is part of FLIM (Faithful Library about Internet Message).
  10
  11 ;; This program is free software; you can redistribute it and/or
  12 ;; modify it under the terms of the GNU General Public License as
  13 ;; published by the Free Software Foundation; either version 2, or (at
  14 ;; your option) any later version.
  15
  16 ;; This program is distributed in the hope that it will be useful, but
  17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  19 ;; General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with this program; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24 ;; Boston, MA 02111-1307, USA.
  25
  26 ;;; Code:
  27
  28 (require 'mime-def)
  29 (require 'raw-io)
  30 (require 'alist)
  31
  32 (defcustom mime-encoding-list
  33   '("7bit" "8bit" "binary" "base64" "quoted-printable")
  34   "List of Content-Transfer-Encoding.  Each encoding must be string."
  35   :group 'mime
  36   :type '(repeat string))
  37
  38 (defun mime-encoding-list (&optional service)
  39   "Return list of Content-Transfer-Encoding.
  40 If SERVICE is specified, it returns available list of
  41 Content-Transfer-Encoding for it."
  42   (if service
  43       (let (dest)
  44         (mapatoms (lambda (sym)
  45                     (or (eq sym nil)
  46                         (setq dest (cons (symbol-name sym) dest)))
  47                     )
  48                   (symbol-value (intern (format "%s-obarray" service))))
  49         (let ((rest mel-encoding-module-alist)
  50               pair)
  51           (while (setq pair (car rest))
  52             (let ((key (car pair)))
  53               (or (member key dest)
  54                   (<= (length key) 1)
  55                   (setq dest (cons key dest))))
  56             (setq rest (cdr rest)))
  57           )
  58         dest)
  59     mime-encoding-list))
  60
  61 (defun mime-encoding-alist (&optional service)
  62   "Return table of Content-Transfer-Encoding for completion."
  63   (mapcar #'list (mime-encoding-list service)))
  64
  65 (defsubst mel-use-module (name encodings)
  66   (while encodings
  67     (set-alist 'mel-encoding-module-alist
  68                (car encodings)
  69                (cons name (cdr (assoc (car encodings)
  70                                       mel-encoding-module-alist))))
  71     (setq encodings (cdr encodings))))
  72
  73 (defsubst mel-find-function (service encoding)
  74   (mel-find-function-from-obarray
  75    (symbol-value (intern (format "%s-obarray" service))) encoding))
  76
  77
  78 ;;; @ setting for modules
  79 ;;;
  80
  81 (mel-define-backend "7bit")
  82 (mel-define-method-function (mime-encode-string string (nil "7bit"))
  83                             'identity)
  84 (mel-define-method-function (mime-decode-string string (nil "7bit"))
  85                             'identity)
  86 (mel-define-method mime-encode-region (start end (nil "7bit")))
  87 (mel-define-method mime-decode-region (start end (nil "7bit")))
  88 (mel-define-method-function (mime-insert-encoded-file filename (nil "7bit"))
  89                             'binary-insert-file-contents)
  90 (mel-define-method-function (mime-write-decoded-region
  91                              start end filename (nil "7bit"))
  92                             'binary-write-region)
  93
  94 (mel-define-backend "8bit" ("7bit"))
  95
  96 (mel-define-backend "binary" ("8bit"))
  97
  98 (defvar mel-b-builtin
  99    (and (fboundp 'base64-encode-string)
 100         (subrp (symbol-function 'base64-encode-string))))
 101
 102 (when mel-b-builtin
 103   (mel-define-backend "base64")
 104   (mel-define-method-function (mime-encode-string string (nil "base64"))
 105                               'base64-encode-string)
 106   (mel-define-method-function (mime-decode-string string (nil "base64"))
 107                               'base64-decode-string)
 108   (mel-define-method-function (mime-encode-region start end (nil "base64"))
 109                               'base64-encode-region)
 110   (mel-define-method-function (mime-decode-region start end (nil "base64"))
 111                               'base64-decode-region)
 112   (mel-define-method mime-insert-encoded-file (filename (nil "base64"))
 113     "Encode contents of file FILENAME to base64, and insert the result.
 114 It calls external base64 encoder specified by
 115 `base64-external-encoder'.  So you must install the program (maybe
 116 mmencode included in metamail or XEmacs package)."
 117     (interactive "*fInsert encoded file: ")
 118     (insert (base64-encode-string
 119              (with-temp-buffer
 120                (set-buffer-multibyte nil)
 121                (binary-insert-file-contents filename)
 122                (buffer-string))))
 123     (or (bolp) (insert ?\n)))
 124
 125   ;; (mel-define-method-function (encoded-text-encode-string string (nil "B"))
 126   ;;                             'base64-encode-string)
 127   (mel-define-method encoded-text-decode-string (string (nil "B"))
 128     (if (string-match (eval-when-compile
 129                         (concat "\\`" B-encoded-text-regexp "\\'"))
 130                       string)
 131         (base64-decode-string string)
 132       (error "Invalid encoded-text %s" string)))
 133   )
 134
 135 (mel-use-module 'mel-b-el '("base64" "B"))
 136 (mel-use-module 'mel-q '("quoted-printable" "Q"))
 137 (mel-use-module 'mel-g '("x-gzip64"))
 138 (mel-use-module 'mel-u '("x-uue" "x-uuencode"))
 139
 140 (defvar mel-b-ccl-module
 141   (and (featurep 'mule)
 142        (progn
 143          (require 'path-util)
 144          (module-installed-p 'mel-b-ccl))))
 145
 146 (defvar mel-q-ccl-module
 147   (and (featurep 'mule)
 148        (progn
 149          (require 'path-util)
 150          (module-installed-p 'mel-q-ccl))))
 151
 152 (when mel-b-ccl-module
 153   (mel-use-module 'mel-b-ccl '("base64" "B")))
 154
 155 (when mel-q-ccl-module
 156   (mel-use-module 'mel-q-ccl '("quoted-printable" "Q")))
 157
 158 (when base64-dl-module
 159   (mel-use-module 'mel-b-dl '("base64" "B")))
 160
 161
 162 ;;; @ region
 163 ;;;
 164
 165 ;;;###autoload
 166 (defun mime-encode-region (start end encoding)
 167   "Encode region START to END of current buffer using ENCODING.
 168 ENCODING must be string."
 169   (interactive
 170    (list (region-beginning)(region-end)
 171          (completing-read "Encoding: "
 172                           (mime-encoding-alist)
 173                           nil t "base64")))
 174   (funcall (mel-find-function 'mime-encode-region encoding) start end))
 175
 176
 177 ;;;###autoload
 178 (defun mime-decode-region (start end encoding)
 179   "Decode region START to END of current buffer using ENCODING.
 180 ENCODING must be string."
 181   (interactive
 182    (list (region-beginning)(region-end)
 183          (completing-read "Encoding: "
 184                           (mime-encoding-alist 'mime-decode-region)
 185                           nil t "base64")))
 186   (funcall (mel-find-function 'mime-decode-region encoding)
 187            start end))
 188
 189
 190 ;;; @ string
 191 ;;;
 192
 193 ;;;###autoload
 194 (defun mime-decode-string (string encoding)
 195   "Decode STRING using ENCODING.
 196 ENCODING must be string.  If ENCODING is found in
 197 `mime-string-decoding-method-alist' as its key, this function decodes
 198 the STRING by its value."
 199   (let ((f (mel-find-function 'mime-decode-string encoding)))
 200     (if f
 201         (funcall f string)
 202       string)))
 203
 204
 205 (mel-define-service encoded-text-encode-string)
 206 (defun encoded-text-encode-string (string encoding &optional mode)
 207   "Encode STRING as encoded-text using ENCODING.
 208 ENCODING must be string.
 209 Optional argument MODE allows `text', `comment', `phrase' or nil.
 210 Default value is `phrase'."
 211   (if (string= encoding "B")
 212       (base64-encode-string string 'no-line-break)
 213     (let ((f (mel-find-function 'encoded-text-encode-string encoding)))
 214       (if f
 215           (funcall f string mode)
 216         string))))
 217
 218 (mel-define-service encoded-text-decode-string (string encoding)
 219   "Decode STRING as encoded-text using ENCODING.  ENCODING must be string.")
 220
 221 (defun base64-encoded-length (string)
 222   (* (/ (+ (length string) 2) 3) 4))
 223
 224 (defsubst Q-encoding-printable-char-p (chr mode)
 225   (and (not (memq chr '(?= ?? ?_)))
 226        (<= ?\  chr)(<= chr ?~)
 227        (cond ((eq mode 'text) t)
 228              ((eq mode 'comment)
 229               (not (memq chr '(?\( ?\) ?\\))))
 230              (t
 231               (string-match "[A-Za-z0-9!*+/=_---]" (char-to-string chr))))))
 232
 233 (defun Q-encoded-text-length (string &optional mode)
 234   (let ((l 0)(i 0)(len (length string)) chr)
 235     (while (< i len)
 236       (setq chr (aref string i))
 237       (if (or (Q-encoding-printable-char-p chr mode)
 238               (eq chr ? ))
 239           (setq l (+ l 1))
 240         (setq l (+ l 3)))
 241       (setq i (+ i 1)))
 242     l))
 243
 244
 245 ;;; @ file
 246 ;;;
 247
 248 ;;;###autoload
 249 (defun mime-insert-encoded-file (filename encoding)
 250   "Insert file FILENAME encoded by ENCODING format."
 251   (interactive
 252    (list (read-file-name "Insert encoded file: ")
 253          (completing-read "Encoding: "
 254                           (mime-encoding-alist)
 255                           nil t "base64")))
 256   (funcall (mel-find-function 'mime-insert-encoded-file encoding)
 257            filename))
 258
 259
 260 ;;;###autoload
 261 (defun mime-write-decoded-region (start end filename encoding)
 262   "Decode and write current region encoded by ENCODING into FILENAME.
 263 START and END are buffer positions."
 264   (interactive
 265    (list (region-beginning)(region-end)
 266          (read-file-name "Write decoded region to file: ")
 267          (completing-read "Encoding: "
 268                           (mime-encoding-alist 'mime-write-decoded-region)
 269                           nil t "base64")))
 270   (funcall (mel-find-function 'mime-write-decoded-region encoding)
 271            start end filename))
 272
 273
 274 ;;; @ end
 275 ;;;
 276
 277 (provide 'mel)
 278
 279 ;;; mel.el ends here.