emu.el

   1 ;;; emu.el --- Emulation module for each Emacs variants
   2
   3 ;; Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc.
   4
   5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
   6 ;; Keywords: emulation, compatibility, NEmacs, MULE, Emacs/mule, XEmacs
   7
   8 ;; This file is part of emu.
   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 'poe)
  28
  29 (defvar running-emacs-18 (<= emacs-major-version 18))
  30 (defvar running-xemacs (featurep 'xemacs))
  31
  32 (defvar running-mule-merged-emacs (and (not (boundp 'MULE))
  33                                        (not running-xemacs) (featurep 'mule)))
  34 (defvar running-xemacs-with-mule (and running-xemacs (featurep 'mule)))
  35
  36 (defvar running-emacs-19 (and (not running-xemacs) (= emacs-major-version 19)))
  37 (defvar running-emacs-19_29-or-later
  38   (or (and running-emacs-19 (>= emacs-minor-version 29))
  39       (and (not running-xemacs)(>= emacs-major-version 20))))
  40
  41 (defvar running-xemacs-19 (and running-xemacs
  42                                (= emacs-major-version 19)))
  43 (defvar running-xemacs-20-or-later (and running-xemacs
  44                                         (>= emacs-major-version 20)))
  45 (defvar running-xemacs-19_14-or-later
  46   (or (and running-xemacs-19 (>= emacs-minor-version 14))
  47       running-xemacs-20-or-later))
  48
  49 (cond (running-xemacs
  50        ;; for XEmacs
  51        (defvar mouse-button-1 'button1)
  52        (defvar mouse-button-2 'button2)
  53        (defvar mouse-button-3 'button3)
  54        )
  55       ((>= emacs-major-version 19)
  56        ;; mouse
  57        (defvar mouse-button-1 [mouse-1])
  58        (defvar mouse-button-2 [mouse-2])
  59        (defvar mouse-button-3 [down-mouse-3])
  60        )
  61       (t
  62        ;; mouse
  63        (defvar mouse-button-1 nil)
  64        (defvar mouse-button-2 nil)
  65        (defvar mouse-button-3 nil)
  66        ))
  67
  68 ;; for tm-7.106
  69 (unless (fboundp 'tl:make-overlay)
  70   (defalias 'tl:make-overlay 'make-overlay)
  71   (make-obsolete 'tl:make-overlay 'make-overlay)
  72   )
  73 (unless (fboundp 'tl:overlay-put)
  74   (defalias 'tl:overlay-put 'overlay-put)
  75   (make-obsolete 'tl:overlay-put 'overlay-put)
  76   )
  77 (unless (fboundp 'tl:overlay-put)
  78   (defalias 'tl:overlay-buffer 'overlay-buffer)
  79   (make-obsolete 'tl:overlay-buffer 'overlay-buffer)
  80   )
  81
  82 (require 'poem)
  83 (require 'mcharset)
  84 (require 'invisible)
  85
  86 (defsubst char-list-to-string (char-list)
  87   "Convert list of character CHAR-LIST to string."
  88   (apply (function string) char-list))
  89
  90 (cond ((featurep 'mule)
  91        (cond ((featurep 'xemacs) ; for XEmacs with MULE
  92               ;; old Mule emulating aliases
  93
  94               ;;(defalias 'char-leading-char 'char-charset)
  95
  96               (defun char-category (character)
  97                 "Return string of category mnemonics for CHAR in TABLE.
  98 CHAR can be any multilingual character
  99 TABLE defaults to the current buffer's category table."
 100                 (mapconcat (lambda (chr)
 101                              (char-to-string (int-char chr)))
 102                            (char-category-list character)
 103                            ""))
 104               )
 105              ((>= emacs-major-version 20) ; for Emacs 20
 106               (defalias 'insert-binary-file-contents-literally
 107                 'insert-file-contents-literally)
 108
 109               ;; old Mule emulating aliases
 110               (defun char-category (character)
 111                 "Return string of category mnemonics for CHAR in TABLE.
 112 CHAR can be any multilingual character
 113 TABLE defaults to the current buffer's category table."
 114                 (category-set-mnemonics (char-category-set character)))
 115               )
 116              (t ; for MULE 1.* and 2.*
 117               (require 'emu-mule)
 118               ))
 119        )
 120       ((boundp 'NEMACS)
 121        ;; for NEmacs and NEpoch
 122
 123        ;; old MULE emulation
 124        (defconst *noconv*    0)
 125        (defconst *sjis*      1)
 126        (defconst *junet*     2)
 127        (defconst *ctext*     2)
 128        (defconst *internal*  3)
 129        (defconst *euc-japan* 3)
 130
 131        (defun code-convert-string (str ic oc)
 132          "Convert code in STRING from SOURCE code to TARGET code,
 133 On successful converion, returns the result string,
 134 else returns nil."
 135          (if (not (eq ic oc))
 136              (convert-string-kanji-code str ic oc)
 137            str))
 138
 139        (defun code-convert-region (beg end ic oc)
 140          "Convert code of the text between BEGIN and END from SOURCE
 141 to TARGET. On successful conversion returns t,
 142 else returns nil."
 143          (if (/= ic oc)
 144              (save-excursion
 145                (save-restriction
 146                  (narrow-to-region beg end)
 147                  (convert-region-kanji-code beg end ic oc)))
 148            ))
 149        )
 150       (t
 151        ;; for Emacs 19 and XEmacs without MULE
 152
 153        ;; old MULE emulation
 154        (defconst *internal* nil)
 155        (defconst *ctext* nil)
 156        (defconst *noconv* nil)
 157
 158        (defun code-convert-string (str ic oc)
 159          "Convert code in STRING from SOURCE code to TARGET code,
 160 On successful converion, returns the result string,
 161 else returns nil. [emu-latin1.el; old MULE emulating function]"
 162          str)
 163
 164        (defun code-convert-region (beg end ic oc)
 165          "Convert code of the text between BEGIN and END from SOURCE
 166 to TARGET. On successful conversion returns t,
 167 else returns nil. [emu-latin1.el; old MULE emulating function]"
 168          t)
 169        ))
 170
 171
 172 ;;; @ Mule emulating aliases
 173 ;;;
 174 ;;; You should not use it.
 175
 176 (or (boundp '*noconv*)
 177     (defconst *noconv* 'binary
 178       "Coding-system for binary.
 179 This constant is defined to emulate old MULE anything older than MULE 2.3.
 180 It is obsolete, so don't use it."))
 181
 182
 183 ;;; @ without code-conversion
 184 ;;;
 185
 186 (defalias 'insert-binary-file-contents 'insert-file-contents-as-binary)
 187 (make-obsolete 'insert-binary-file-contents 'insert-file-contents-as-binary)
 188
 189 (defun-maybe insert-binary-file-contents-literally (filename
 190                                                     &optional visit
 191                                                     beg end replace)
 192   "Like `insert-file-contents-literally', q.v., but don't code conversion.
 193 A buffer may be modified in several ways after reading into the buffer due
 194 to advanced Emacs features, such as file-name-handlers, format decoding,
 195 find-file-hooks, etc.
 196   This function ensures that none of these modifications will take place."
 197   (as-binary-input-file
 198    ;; Returns list absolute file name and length of data inserted.
 199    (insert-file-contents-literally filename visit beg end replace)))
 200
 201
 202 ;;; @ for text/richtext and text/enriched
 203 ;;;
 204
 205 (cond ((fboundp 'richtext-decode)
 206        ;; have richtext.el
 207        )
 208       ((or running-emacs-19_29-or-later running-xemacs-19_14-or-later)
 209        ;; have enriched.el
 210        (autoload 'richtext-decode "richtext")
 211        (or (assq 'text/richtext format-alist)
 212            (setq format-alist
 213                  (cons
 214                   (cons 'text/richtext
 215                         '("Extended MIME text/richtext format."
 216                           "Content-[Tt]ype:[ \t]*text/richtext"
 217                           richtext-decode richtext-encode t enriched-mode))
 218                   format-alist)))
 219        )
 220       (t
 221        ;; don't have enriched.el
 222        (autoload 'richtext-decode "tinyrich")
 223        (autoload 'enriched-decode "tinyrich")
 224        ))
 225
 226 (if (or (and (eq emacs-major-version 19)
 227              (>= emacs-minor-version (if (featurep 'xemacs) 14 29)))
 228         (and (eq emacs-major-version 20)
 229              (< emacs-minor-version (if (featurep 'xemacs) 3 1))))
 230     (eval-after-load "enriched"
 231       '(if (fboundp 'si:enriched-encode)
 232            nil
 233          (fset 'si:enriched-encode (symbol-function 'enriched-encode))
 234          (defun enriched-encode (from to &optional orig-buf)
 235            (let* ((si:enriched-initial-annotation enriched-initial-annotation)
 236                   (enriched-initial-annotation
 237                    (if (stringp si:enriched-initial-annotation)
 238                        si:enriched-initial-annotation
 239                      (function
 240                       (lambda ()
 241                         (save-excursion
 242                           ;; Eval this in the buffer we are annotating.  This
 243                           ;; fixes a bug which was saving incorrect File-Width
 244                           ;; information, since we were looking at local
 245                           ;; variables in the wrong buffer.
 246                           (if orig-buf (set-buffer orig-buf))
 247                           (funcall si:enriched-initial-annotation)))))))
 248              (si::enriched-encode from to))))))
 249
 250
 251 ;;; @ end
 252 ;;;
 253
 254 (require 'product)
 255 (product-provide (provide 'emu) (require 'apel-ver))
 256
 257 ;;; emu.el ends here