cgit.sxemacs.org Git - packages/blob - xemacs-packages/mew/mew/mew-mule2.el

   1 ;;; mew-mule2.el --- Environment of Mule version 2 for Mew
   2
   3 ;; Author:  Kazu Yamamoto <Kazu@Mew.org>
   4 ;; Created: Mar 20, 1997
   5 ;; Revised: Aug 30, 1999
   6
   7 ;;; Code:
   8
   9 (defconst mew-mule2-version "mew-mule2.el version 0.09")
  10
  11 ;; must be here
  12 (if (fboundp 'find-coding-system)
  13     (fset 'mew-coding-system-p (symbol-function 'find-coding-system))
  14   (fset 'mew-coding-system-p (symbol-function 'coding-system-p)))
  15
  16 ;; In the context of Mew, 'charset' means MIME charset.
  17 ;; 'cs' means the internal representation of Emacs (was known as Mule).
  18
  19 ;;
  20 ;; User CS definitions
  21 ;;
  22
  23 (define-ccl-program mew-ccl-*-to-lf
  24   '(1
  25     ((read r0)
  26      (loop
  27       (if (r0 == 13)
  28           ((write 10)
  29            (read-if (r1 == 10)
  30                     (read r0)
  31                     (r0 = (r1 + 0)))
  32            (repeat))
  33         (write-read-repeat r0)))))
  34   "Read text with any eol converting to the LF eol.")
  35
  36 (define-ccl-program mew-ccl-lf-to-lf
  37   '(1
  38     ((read r0)
  39      (loop
  40       (write-read-repeat r0))))
  41   "Write text with the LF eol.")
  42
  43 (define-ccl-program mew-ccl-lf-to-crlf
  44   '(2
  45     ((loop
  46       (read-if (r0 == 10)
  47                (write 13))
  48       (write r0)
  49       (repeat))))
  50   "Write text with the CRLF eol.")
  51
  52 (define-ccl-program mew-ccl-lf-to-cr
  53   '(1
  54     ((loop
  55       (read-if (r0 == 10)
  56                (write 13)
  57                (write r0))
  58       (repeat))))
  59   "Write text with the CR eol.")
  60
  61 (make-coding-system 'mew-cs-text
  62                     4 ?= "No conversion" nil
  63                     (cons mew-ccl-*-to-lf mew-ccl-lf-to-lf))
  64
  65 (make-coding-system 'mew-cs-text-lf
  66                     4 ?= "No conversion" nil
  67                     (cons mew-ccl-*-to-lf mew-ccl-lf-to-lf))
  68
  69 (make-coding-system 'mew-cs-text-crlf
  70                     4 ?= "No conversion" nil
  71                     (cons mew-ccl-*-to-lf mew-ccl-lf-to-crlf))
  72
  73 (make-coding-system 'mew-cs-text-cr
  74                     4 ?= "No conversion" nil
  75                     (cons mew-ccl-*-to-lf mew-ccl-lf-to-cr))
  76
  77 (defvar mew-cs-dummy          '*noconv*)
  78 (defvar mew-cs-binary         '*noconv*)
  79 (defvar mew-cs-text-for-read  'mew-cs-text)
  80 (defvar mew-cs-text-for-write 'mew-cs-text-lf)
  81 (defvar mew-cs-autoconv       '*autoconv*)
  82 (defvar mew-cs-7bit           '*iso-2022-ss2-7*)
  83 (defvar mew-cs-7bit-crlf      '*iso-2022-ss2-7*dos)
  84 (defvar mew-cs-mime-trans     '*iso-2022-ss2-7*)
  85 (defvar mew-cs-rfc822-trans   '*iso-2022-ss2-7*)
  86 (defvar mew-cs-draft          '*iso-2022-ss2-7*)
  87 (defvar mew-cs-scan           '*ctext*)
  88 (defvar mew-cs-infile         '*autoconv*)
  89 (defvar mew-cs-outfile        '*iso-2022-ss2-7*)
  90 (defvar mew-cs-virtual        (if (mew-coding-system-p '*ctext*unix)
  91                                   '*ctext*unix '*ctext*)) ;; ^M as it is
  92 (defvar mew-cs-pick           '*euc-japan*)
  93
  94 (defvar mew-cs-database
  95   '(("us-ascii"    (0)             nil           "7bit"
  96                                    nil           "Q")
  97     ("iso-8859-1"  (0 129)         *iso-8859-1*  "quoted-printable"
  98                                    *iso-8859-1*  "Q")
  99     ("iso-8859-2"  (0 130)         *iso-8859-2*  "quoted-printable"
 100                                    *iso-8859-2*  "Q")
 101     ("iso-8859-3"  (0 131)         *iso-8859-3*  "quoted-printable"
 102                                    *iso-8859-3*  "Q")
 103     ("iso-8859-4"  (0 132)         *iso-8859-4*  "quoted-printable"
 104                                    *iso-8859-4*  "Q")
 105     ("koi8-r"      (0 140)         *koi8*        "quoted-printable"
 106                                    *koi8*        "Q")
 107     ("iso-8859-6"  (0 135)         *iso-8859-6*  "base64"
 108                                    *iso-8859-6*  "B")
 109     ("iso-8859-7"  (0 134)         *iso-8859-7*  "base64"
 110                                    *iso-8859-7*  "B")
 111     ("iso-8859-8"  (0 136)         *iso-8859-8*  "base64"
 112                                    *iso-8859-8*  "B")
 113     ("iso-8859-9"  (0 141)         *iso-8859-9*  "quoted-printable"
 114                                    *iso-8859-9*  "Q")
 115     ("tis-620"     (0 133 128)     *tis620*      "base64"
 116                                    *tis620*      "B")
 117     ("iso-2022-jp" (0 138 146 144) *iso-2022-jp* "7bit"
 118                                    *iso-2022-jp* "B")
 119     ("euc-kr"      (0 147)         *euc-kr*      "base64"
 120                                    *euc-kr*      "B")
 121     ("iso-2022-kr" (0 147)         *iso-2022-kr* "7bit"
 122                                    *euc-kr*      "B")
 123     ("gb2312"      (0 145)         *euc-china*   "base64"
 124                                    *euc-china*   "B")
 125     ("hz-gb-2312"  (0 145)         *hz*          "base64"
 126                                    *hz*          "B")
 127     ("big5"        (0 152 153)     *big5*        "base64"
 128                                    *big5*        "B")
 129     ("iso-2022-jp-2" (0 138 146 144 145 147 148 129 134)
 130      *iso-2022-ss2-7* "7bit" *iso-2022-ss2-7* "B")
 131     ;; charset-to-cs purpose only
 132     ("euc-jp"          nil *euc-japan*)
 133     ("shift_jis"       nil *sjis*)
 134     ("cn-gb"           nil *euc-china*) ;; the same as gb2312 above
 135     ("cn-big5"         nil *big5*)      ;; the same as big5 above
 136 ;   ("iso-2022-cn"     nil xxx)
 137 ;   ("iso-2022-cn-ext" nil xxx)
 138     ("iso-2022-int-1"  nil *iso-2022-int-1*)
 139     ))
 140
 141 ;;
 142 ;; Leading characters
 143 ;;
 144
 145 (defvar mew-lc-ascii 0)
 146 (defvar mew-lc-kana  137)
 147 (defvar mew-lc-jp    146)
 148 (fset 'mew-make-char (symbol-function 'make-character))
 149
 150 (defun mew-char-charset (char)
 151   (cond
 152    ((<= char 128) 0)
 153    (t (aref (char-to-string char) 0))))
 154
 155 ;;
 156 ;; CS
 157 ;;
 158
 159 (defun mew-find-cs-region (beg end)
 160   (save-excursion
 161     (save-restriction
 162       (narrow-to-region beg end)
 163       (goto-char (point-min))
 164       (let ((re-official "[^\232-\235\240-\377")
 165             (re-private "\\|[\232-\235][^\000-\237")
 166             lclist lc mc-flag)
 167         (while (re-search-forward (concat re-official "]" re-private "]")
 168                                   nil t)
 169           (setq lc (preceding-char))
 170           (cond
 171            ((<= lc ?\177)
 172             (setq lc 0)
 173             (setq re-official (concat re-official "\000-\177")))
 174            ((< lc ?\240)
 175             (setq re-official (concat re-official (char-to-string lc))))
 176            (t
 177             (setq re-private (concat re-private (char-to-string lc))))
 178            )
 179           (setq lclist (cons lc lclist)))
 180         lclist))))
 181
 182 ;; to internal
 183 (defun mew-cs-decode-region (beg end cs)
 184   (if cs (code-convert-region beg end cs '*internal*)))
 185
 186 ;; to extenal
 187 (defun mew-cs-encode-region (beg end cs)
 188   (if cs (code-convert-region beg end '*internal* cs)))
 189
 190 ;; to internal
 191 (defun mew-cs-decode-string (str cs)
 192   (if cs (code-convert-string str cs '*internal*) str))
 193
 194 ;; to external
 195 (defun mew-cs-encode-string (str cs)
 196   (if cs (code-convert-string str '*internal* cs) str))
 197
 198 ;;
 199 ;; Process environment
 200 ;;
 201
 202 (defun mew-set-process-cs (pro from-pro to-pro)
 203   (set-process-coding-system pro from-pro to-pro))
 204
 205 (defmacro mew-plet (&rest body)
 206   (` (let ((call-process-hook nil)
 207            (default-process-coding-system
 208              (cons '*noconv* '*noconv*)))
 209        (,@ body))))
 210
 211 (defmacro mew-piolet (input output &rest body)
 212   (` (let ((call-process-hook nil)
 213            (default-process-coding-system
 214              (cons (, input) (, output))))
 215        (,@ body))))
 216
 217 (defmacro mew-pioalet (input output arg &rest body)
 218   (` (let ((call-process-hook nil)
 219            (default-process-coding-system
 220              (cons (, input) (, output)))
 221            (pathname-coding-system (, arg)))
 222        (,@ body))))
 223
 224 (defmacro mew-flet (&rest body)
 225   (` (let ((file-coding-system          '*noconv*)
 226            (file-coding-system-for-read '*noconv*)
 227            jam-zcat-filename-list
 228            jka-compr-compression-info-list)
 229        (,@ body))))
 230
 231 (defmacro mew-frwlet (read write &rest body)
 232   (` (let ((file-coding-system          (, write))
 233            (file-coding-system-for-read (, read))
 234            jam-zcat-filename-list
 235            jka-compr-compression-info-list)
 236        (,@ body))))
 237
 238 ;;
 239 ;; Post conversion
 240 ;;
 241
 242 (defmacro mew-cs-post-conv (cs)
 243   (` (get (, cs) 'post-read-conversion)))
 244
 245 ;;
 246 ;;
 247 ;;
 248
 249 (fset 'mew-aref (symbol-function 'sref))
 250 (fset 'mew-charlen (symbol-function 'char-bytes))
 251
 252 ;;
 253 ;;
 254 ;;
 255
 256 (require 'mew-mule)
 257 (provide 'mew-mule2)
 258
 259 ;;; Copyright Notice:
 260
 261 ;; Copyright (C) 1997, 1998, 1999 Mew developing team.
 262 ;; All rights reserved.
 263
 264 ;; Redistribution and use in source and binary forms, with or without
 265 ;; modification, are permitted provided that the following conditions
 266 ;; are met:
 267 ;;
 268 ;; 1. Redistributions of source code must retain the above copyright
 269 ;;    notice, this list of conditions and the following disclaimer.
 270 ;; 2. Redistributions in binary form must reproduce the above copyright
 271 ;;    notice, this list of conditions and the following disclaimer in the
 272 ;;    documentation and/or other materials provided with the distribution.
 273 ;; 3. Neither the name of the team nor the names of its contributors
 274 ;;    may be used to endorse or promote products derived from this software
 275 ;;    without specific prior written permission.
 276 ;;
 277 ;; THIS SOFTWARE IS PROVIDED BY THE TEAM AND CONTRIBUTORS ``AS IS'' AND
 278 ;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
 279 ;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
 280 ;; PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE TEAM OR CONTRIBUTORS BE
 281 ;; LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
 282 ;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
 283 ;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
 284 ;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
 285 ;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
 286 ;; OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
 287 ;; IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 288
 289 ;;; mew-mule2.el ends here