mcs-xmu.el

   1 ;;; mcs-xmu.el --- Functions to unify ISO646 characters for XEmacs-mule
   2
   3 ;; Copyright (C) 1997,1998,1999 Free Software Foundation, Inc.
   4
   5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
   6 ;; Keywords: emulation, compatibility, Mule
   7
   8 ;; This file is part of APEL (A Portable Emacs Library).
   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., 51 Franklin Street, Fifth Floor,
  23 ;; Boston, MA 02110-1301, USA.
  24
  25 ;;; Commentary:
  26
  27 ;;    This module will be loaded from mcs-xm automatically.
  28 ;;    There is no guarantee that it will work alone.
  29
  30 ;;; Code:
  31
  32 (defcustom mime-iso646-character-unification-alist
  33   (eval-when-compile
  34     (let (dest
  35           (i 33))
  36       (while (< i 92)
  37         (setq dest
  38               (cons (cons (char-to-string (make-char 'latin-jisx0201 i))
  39                           (format "%c" i))
  40                     dest))
  41         (setq i (1+ i)))
  42       (setq i 93)
  43       (while (< i 126)
  44         (setq dest
  45               (cons (cons (char-to-string (make-char 'latin-jisx0201 i))
  46                           (format "%c" i))
  47                     dest))
  48         (setq i (1+ i)))
  49       (nreverse dest)))
  50   "Alist unified string vs. canonical string."
  51   :group 'i18n
  52   :type '(repeat (cons string string)))
  53
  54 (defcustom mime-unified-character-face nil
  55   "Face of unified character."
  56   :group 'i18n
  57   :type 'face)
  58
  59 (defcustom mime-character-unification-limit-size 2048
  60   "Limit size to unify characters.  It is referred by the function
  61 `decode-mime-charset-region-with-iso646-unification'.  If the length of
  62 the specified region (start end) is larger than its value, the function
  63 works for only decoding MIME-CHARSET.  If it is nil, size is unlimited."
  64   :group 'i18n
  65   :type '(radio (integer :tag "Max size")
  66                 (const :tag "Unlimited" nil)))
  67
  68 (defun decode-mime-charset-region-with-iso646-unification (start end charset
  69                                                                  lbt)
  70   (save-excursion
  71     (save-restriction
  72       (narrow-to-region start end)
  73       (if (prog1
  74               (or (null mime-character-unification-limit-size)
  75                   (<= (- end start) mime-character-unification-limit-size))
  76             (decode-mime-charset-region-default start end charset lbt))
  77           (let ((rest mime-iso646-character-unification-alist))
  78             (while rest
  79               (let ((pair (car rest))
  80                     case-fold-search)
  81                 (goto-char (point-min))
  82                 (while (search-forward (car pair) nil t)
  83                   (let ((str (cdr pair)))
  84                     (if mime-unified-character-face
  85                         (put-text-property
  86                          0 (length str)
  87                          'face mime-unified-character-face str))
  88                     (replace-match str 'fixed-case 'literal)
  89                     )
  90                   ))
  91               (setq rest (cdr rest)))))
  92       )))
  93
  94
  95 ;;; @ end
  96 ;;;
  97
  98 (require 'product)
  99 (product-provide (provide 'mcs-xmu) (require 'apel-ver))
 100
 101 ;;; mcs-xmu.el ends here