This commit was generated by cvs2svn to compensate for changes in r52, which
authortomo <tomo>
Mon, 17 May 1999 09:41:48 +0000 (09:41 +0000)
committertomo <tomo>
Mon, 17 May 1999 09:41:48 +0000 (09:41 +0000)
included commits to RCS files with non-trunk default branches.

46 files changed:
INSTALL
PROBLEMS
README.packages
configure.usage
etc/BETA
etc/PACKAGES
lib-src/ChangeLog
lib-src/config.values.in
lib-src/update-autoloads.sh
lib-src/update-custom.sh
lisp/about.el
lisp/etags.el
lisp/menubar-items.el
lisp/mule/arabic.el [new file with mode: 0644]
lisp/mule/canna-leim.el [new file with mode: 0644]
lisp/mule/cyrillic.el [new file with mode: 0644]
lisp/mule/english.el [new file with mode: 0644]
lisp/mule/european.el [new file with mode: 0644]
lisp/mule/greek.el [new file with mode: 0644]
lisp/mule/hebrew.el [new file with mode: 0644]
lisp/mule/kinsoku.el [new file with mode: 0644]
lisp/mule/korean.el [new file with mode: 0644]
lisp/mule/mule-ccl.el [new file with mode: 0644]
lisp/mule/mule-help.el [new file with mode: 0644]
lisp/mule/mule-init.el [new file with mode: 0644]
lisp/mule/mule-misc.el [new file with mode: 0644]
lisp/mule/mule-tty-init.el [new file with mode: 0644]
lisp/mule/mule-x-init.el [new file with mode: 0644]
lisp/package-admin.el
lisp/paths.el
lisp/process.el
lisp/userlock.el
lwlib/lwlib.h
man/ChangeLog
nt/ChangeLog
src/console-tty.h
src/event-msw.c
src/event-stream.c
src/event-tty.c
src/glyphs-x.c
src/s/bsdos4.h [new file with mode: 0644]
src/s/cygwin32.h
src/xintrinsic.h
tests/ChangeLog
tests/automated/database-tests.el
version.sh

diff --git a/INSTALL b/INSTALL
index 2cef985..88a377f 100644 (file)
--- a/INSTALL
+++ b/INSTALL
@@ -396,16 +396,12 @@ variable gets by default!  Make sure you know what kind of value the
 variable should have.  If you don't pay attention to what you are
 doing, you'll make a mistake.
 
-Things may malfunction if the variable `directory-abbrev-alist' is not set
-up to translate "temporary" automounter mount points into the canonical
-form.  The default value of this variable contains the translation
-
-       ("^/tmp_mnt/" . "/")
-
-meaning translate "/tmp_mnt/net/FOO" into "/net/FOO", which is appropriate
-for the default configuration of the Sun automounter, but which may be
-inappropriate for different vendor's automounters, or if you have customized
-your mount-point names.
+Things may malfunction if the variable `directory-abbrev-alist' is not
+set up to translate "temporary" automounter mount points into the
+canonical form.  XEmacs tries to detect how your automounter is
+configured.  If you have an unusual automounter configuration that
+XEmacs cannot detect, you may need to change the value of
+`directory-abbrev-alist'.
 
 5) Put into `./lisp/site-init.el' or `./lisp/site-load.el' any Emacs
 Lisp code you want XEmacs to load before it is dumped out.  Use
index 448cc36..127ee47 100644 (file)
--- a/PROBLEMS
+++ b/PROBLEMS
@@ -119,6 +119,10 @@ libz.a in the X11 binary directory.
 ** AIX
 *** On AIX 4.3, you must specify --with-dialogs=athena with configure
 
+*** The libXt shipped with AIX 4.3 is broken.  This causes xemacs -nw
+    to fail in various ways.  The solution is to build against stock
+    X11R6.
+
 *** On AIX, you get this compiler error message:
 
     Processing include file ./XMenuInt.h
@@ -463,6 +467,61 @@ to take advantage of the keyboard map in emacskeys.sco.
 Note: Much of the above entry is probably not valid for XEmacs 21.0
 and later.
 
+** Cygwin
+*** In general use etc/check_cygwin_setup.sh to trap environment problems.
+
+The script etc/check_cygwin_setup.sh will attempt to detect whether
+you have a suitable environment for building. This script may not work
+correctly if you are using ash instead of bash (see below).
+
+*** X11 not detected.
+
+This is usually because xmkmf is not in your path or because you are
+using the default cygwin shell. The default cygwin shell (/bin/sh.exe)
+is ash which appears to work in most circumstances but has some wierd
+failure modes. I recommend replacing sh.exe with bash.exe, this will
+mean configure is slower but more reliable.
+
+*** Subprocesses do not work.
+
+You do not have "tty" in your CYGWIN32 (for b19) or CYGWIN (for b20)
+environment variable. This must be set in your autoexec.bat (win95) or
+the system properties (winnt) as it must be read before the cygwin dll
+initializes.
+
+*** ^G does not work on hung subprocesses.
+
+This is a known problem. It can be remedied with cygwin b20 or greater
+by defining BROKEN_SIGIO in src/s/cygwin32.h, however this currently
+leads to instability in XEmacs.
+
+*** The XEmacs executable crashes at startup.
+
+This can be caused by many things.  
+
+If you are running with X11 you need to have cygwin b19 or cygwin
+b20.1 or greater, cygwin b20 will not work.
+
+If you are running with cygwin b19 make sure you are using egcs 1.0.2
+rather than vanilla gcc. XEmacs builds by default with -O3 which does
+not work with the gcc that ships with b19. Alternatively use -O2.
+
+*** The info files will not build.
+
+makeinfo that ships with cygwin (all versions) is a noop. You need to
+obtain makeinfo from somewhere or build it yourself.
+
+*** I have no graphics.
+
+You need to obtain the various graphics libraries. Pre-built versions
+of these and the X libraries are located on the XEmacs website in
+ftp://ftp.xemacs.org/pub/aux/cygwin*.
+
+*** There are no images in the toolbar buttons.
+
+You need version 4.71 of commctrl.dll which does not ship with windows
+95. You can get this by installing IE 4.0 or downloading it from the
+microsoft website.
 
 
 * Problems with running XEmacs
index 2d3f904..014eb00 100644 (file)
@@ -74,16 +74,16 @@ The Sumo Tarball
 
 Those with little time, cheap connections and plenty of disk space can
 install all packages at once using the sumo tarballs.
-Download the files
+Download the file
 
-xemacs-sumo-<date>.tar.gz if you have a latin-1 XEmacs.
+xemacs-sumo-<date>.tar.gz 
 
-or
+For an XEmacs compiled with Mule you also need
 
-xemacs-mule-sumo-<date>.tar.gz if you have a MULE XEmacs.
+xemacs-mule-sumo-<date>.tar.gz
 
-N.B. There are called 'Sumo Tarballs' for good reason. They are
-currently 15MB and 23MB (gzipped) respectively.
+N.B. They are called 'Sumo Tarballs' for good reason. They are
+currently about 15MB and 2.3MB (gzipped) respectively.
 
 Install them by
 
@@ -120,7 +120,7 @@ XEmacs comes with some tools to make the periodic updating and
 installing easier. It will notice if new packages or versions are
 available and will fetch them from the ftp site.
 
-Unfortunately this requires that a few packages are alreadyin place. 
+Unfortunately this requires that a few packages are already in place. 
 You will have to install them by hand as above or use a SUMO tarball. 
 This requirement will hopefully go away in the future. The packages
 you need are:
index b5154f6..d612b90 100644 (file)
@@ -204,6 +204,8 @@ Debugging options:
                         int, for the fundamental Lisp_Object type; this
                         provides stricter type-checking.  Only works with
                         some systems and compilers.
+--with-quantify         Add support for performance debugging using Quantify.
+--with-purify           Add support for memory debugging using Purify.
 
 
 Other options:
@@ -214,15 +216,13 @@ Other options:
 --with-dlmalloc         Control usage of Doug Lea malloc on systems that have
                         it in the standard C library (default is to use it if
                         it is available).
+--with-system-malloc    Force use of the system malloc, rather than GNU malloc.
+--with-debug-malloc     Use the debugging malloc package.
 --with-clash-detection  Use lock files to detect multiple edits of the same
                         file.  The default is to not do clash detection.
 --lockdir=DIR           The directory to put clash detection files in, such as
                         `/var/lock/emacs'.
                         Defaults to `${statedir}/xemacs/lock'.
---with-system-malloc    Force use of the system malloc, rather than GNU malloc.
---with-debug-malloc     Use the debugging malloc package.
---with-quantify         Add support for performance debugging using Quantify.
---with-purify           Add support for memory debugging using Purify.
 
 You may also specify any of the `path' variables found in Makefile.in,
 including --bindir, --libdir, --lispdir, --sitelispdir, --datadir,
index a6658c1..b5babd1 100644 (file)
--- a/etc/BETA
+++ b/etc/BETA
@@ -224,6 +224,10 @@ Patches to XEmacs should be mailed to <xemacs-patches@xemacs.org>.
 Each patch will be reviewed by the patches review board, and will be
 acked and added to the distribution, or rejected with an explanation.
 
+Patches to XEmacs Lisp packages should be sent to the maintainer of
+the package.  If the maintainer is listed as `XEmacs Development Team'
+patches should be sent to <xemacs-patches@xemacs.org>.
+
 Emailed patches should preferably be sent in MIME format and quoted
 printable encoding (if necessary).
 
index 598c097..138ea65 100644 (file)
@@ -1,7 +1,7 @@
 * Description of available packages by category
 ===============================================
 
-This data is up-to-date as of 13 January 1998.
+This data is up-to-date as of 10 February 1999.
 
 ** Library Packages (libs)
 ==========================
@@ -12,8 +12,7 @@ when adding new files there as it is required by almost everything.
 
 *** Sun
 
-Support for Sparcworks.  Must be installed prior to XEmacs build to be 
-effective.
+Support for Sparcworks.
 
 *** apel
 
@@ -38,8 +37,7 @@ Fundamental lisp files for providing email support.
 
 *** tooltalk
 
-Support for building with Tooltalk.  Must be installed prior to XEmacs 
-build to be effective.
+Support for building with Tooltalk.
 
 *** xemacs-base
 
@@ -101,7 +99,7 @@ Emacs MIME support.
 
 *** vm
 
-An Emacs mailer.  This package must be installed prior to building XEmacs.
+An Emacs mailer.
 
 *** w3
 
@@ -280,8 +278,7 @@ Support for editing shell scripts.
 
 *** vc
 
-Version Control for Free systems.  This package must be installed
-prior to building XEmacs.
+Version Control for Free systems.
 
 *** vc-cc
 
index a2d2860..581ff01 100644 (file)
@@ -1,3 +1,21 @@
+1999-03-01  XEmacs Build Bot <builds@cvs.xemacs.org>
+
+       * XEmacs 21.2.11 is released
+
+1999-02-17  SL Baur  <steve@xemacs.org>
+
+       * update-elc.sh (ignore_dirs): Ignore lisp/mule subdirectory when
+       running latin-1 XEmacs.  Eliminate 20.4 bundled kludges.
+       * update-custom.sh (ignore_dirs): Ditto.
+
+1999-02-15  Martin Buchholz  <martin@xemacs.org>
+
+       * update-elc.sh:
+       * update-autoloads.sh:
+       * update-custom.sh:
+       - improved automounter tmp directory support.
+       - support 4 (!) empirically discovered automounter conventions
+
 1999-02-05  XEmacs Build Bot <builds@cvs.xemacs.org>
 
        * XEmacs 21.2.10 is released
index 6e2c24b..a816455 100644 (file)
@@ -43,6 +43,8 @@ LN_S "@LN_S@"
 LOCKDIR "@LOCKDIR@"
 LOCKDIR_USER_DEFINED "@LOCKDIR_USER_DEFINED@"
 MAKE_SUBDIR "@MAKE_SUBDIR@"
+MODULEDIR "@MODULEDIR@"
+MODULEDIR_USER_DEFINED "@MODULEDIR_USER_DEFINED@"
 PACKAGE_PATH "@PACKAGE_PATH@"
 PACKAGE_PATH_USER_DEFINED "@PACKAGE_PATH_USER_DEFINED@"
 PREFIX "@PREFIX@"
@@ -50,8 +52,13 @@ PROGNAME "@PROGNAME@"
 RANLIB "@RANLIB@"
 RECURSIVE_MAKE "@RECURSIVE_MAKE@"
 SET_MAKE "@SET_MAKE@"
+SITELISPDIR "@SITELISPDIR@"
+SITELISPDIR_USER_DEFINED "@SITELISPDIR_USER_DEFINED@"
+SITEMODULEDIR "@SITEMODULEDIR@"
+SITEMODULEDIR_USER_DEFINED "@SITEMODULEDIR_USER_DEFINED@"
 SRC_SUBDIR_DEPS "@SRC_SUBDIR_DEPS@"
 SUBDIR_MAKEFILES "@SUBDIR_MAKEFILES@"
+XEMACS_CC "@XEMACS_CC@"
 X_CFLAGS "@X_CFLAGS@"
 X_EXTRA_LIBS "@X_EXTRA_LIBS@"
 X_LIBS "@X_LIBS@"
@@ -70,8 +77,9 @@ configure_input "@configure_input@"
 datadir "@datadir@"
 dll_cflags "@dll_cflags@"
 dll_ld "@dll_ld@"
-dll_lflags "@dll_lflags@"
-dll_oflags "@dll_oflags@"
+dll_ldflags "@dll_ldflags@"
+dll_ldo "@dll_ldo@"
+dll_post "@dll_post@"
 dnd_objs "@dnd_objs@"
 docdir "@docdir@"
 dynodump_arch "@dynodump_arch@"
@@ -102,6 +110,7 @@ lockdir "@lockdir@"
 lwlib_objs "@lwlib_objs@"
 machfile "@machfile@"
 mandir "@mandir@"
+moduledir "@moduledir@"
 native_sound_lib "@native_sound_lib@"
 oldincludedir "@oldincludedir@"
 opsysfile "@opsysfile@"
@@ -111,6 +120,8 @@ prefix "@prefix@"
 program_transform_name "@program_transform_name@"
 sbindir "@sbindir@"
 sharedstatedir "@sharedstatedir@"
+sitelispdir "@sitelispdir@"
+sitemoduledir "@sitemoduledir@"
 sound_cflags "@sound_cflags@"
 srcdir "@srcdir@"
 start_files "@start_files@"
index 6af202c..ee56e65 100644 (file)
@@ -43,14 +43,24 @@ echo " (using $EMACS)"
 
 export EMACS
 
-REAL=`cd \`dirname $EMACS\` ; pwd | sed 's|^/tmp_mnt||'`/`basename $EMACS`
+EMACS_DIR=`cd \`dirname $EMACS\` && pwd`;
+CANON_PWD=`pwd`
+# Account for various system automounter configurations
+if test -d "/net"; then
+  if test -d "/tmp_mnt/net"; then tdir="/tmp_mnt/net"; else tdir="/tmp_mnt"; fi
+  EMACS_DIR=`echo "$EMACS_DIR" | \
+   sed -e "s|^${tdir}/|/net/|" -e "s|^/a/|/net/|" -e "s|^/amd/|/net/|"`
+  CANON_PWD=`echo "$CANON_PWD" | \
+   sed -e "s|^${tdir}/|/net/|" -e "s|^/a/|/net/|" -e "s|^/amd/|/net/|"`
+fi
+REAL="$EMACS_DIR/`basename $EMACS`"
 
-echo "Rebuilding autoloads in `pwd|sed 's|^/tmp_mnt||'`"
+echo "Rebuilding autoloads in $CANON_PWD"
 echo "          with $REAL..."
 
 if [ "`uname -r | sed 's/\(.\).*/\1/'`" -gt 4 ]; then
   echon()
-  {    
+  {
     /bin/echo $* '\c'
   }
 else
index 7e0a2ea..dd62a86 100755 (executable)
@@ -45,13 +45,20 @@ echo " (using $EMACS)"
 
 export EMACS
 
-REAL=`cd \`dirname $EMACS\` ; pwd | sed 's|^/tmp_mnt||'`/`basename $EMACS`
+EMACS_DIR=`cd \`dirname $EMACS\` && pwd`;
+# Account for various system automounter configurations
+if test -d "/net"; then
+  if test -d "/tmp_mnt/net"; then tdir="/tmp_mnt/net"; else tdir="/tmp_mnt"; fi
+  EMACS_DIR=`echo "$EMACS_DIR" | \
+   sed -e "s|^${tdir}/|/net/|" -e "s|^/a/|/net/|" -e "s|^/amd/|/net/|"`
+fi
+REAL="$EMACS_DIR/`basename $EMACS`"
 
 echo "Rebuilding custom-loads with $REAL..."
 
 if [ "`uname -r | sed 's/\(.\).*/\1/'`" -gt 4 ]; then
   echon()
-  {    
+  {
     /bin/echo $* '\c'
   }
 else
@@ -62,12 +69,7 @@ else
 fi
 
 # Compute patterns to ignore when searching for files
-# These directories don't have customizations, or are partially broken.
-# If some of the packages listed here are customized, don't forget to
-#  remove the directory!
-ignore_dirs="cl egg eos its language locale sunpro term \
-tooltalk iso electric \
-hm--html-menus gnats pcl-cvs vm"
+ignore_dirs=""
 
 # Only use Mule XEmacs to build Mule-specific autoloads & custom-loads.
 echon "Checking for Mule support..."
@@ -75,7 +77,7 @@ lisp_prog='(princ (featurep (quote mule)))'
 mule_p="`$EMACS -batch -q -no-site-file -eval \"$lisp_prog\"`"
 if test "$mule_p" = nil ; then
        echo No
-       ignore_dirs="$ignore_dirs mule leim skk"
+       ignore_dirs="$ignore_dirs mule"
 else
        echo Yes
 fi
index 9f5d27b..959887e 100644 (file)
@@ -283,7 +283,7 @@ developers responsible for this release are:\n\n")
                             :value who)
              (widget-insert (format "  <%s>\n" address)))))
       ;; Setup persons responsible for this release.
-      (mapc 'setup-person '(slb hniksic kyle martin))
+      (mapc 'setup-person '(slb hniksic kyle martin piper))
       (widget-insert "\n\t* ")
       (widget-create 'link :help-echo "A legion of XEmacs hackers"
                     :action 'about-hackers
index f00f8fa..00180d6 100644 (file)
@@ -1189,6 +1189,7 @@ and `\\[pop-tag-mark]'."
 
 ;;;###autoload (define-key esc-map "*" 'pop-tag-mark)
 
+;;;###autoload
 (defun pop-tag-mark (arg)
   "Go to last tag position.
 `find-tag' maintains a mark-stack seperate from the \\[set-mark-command] mark-stack.
@@ -1203,3 +1204,5 @@ This function pops (and moves to) the tag at the top of this stack."
 \f
 (provide 'etags)
 (provide 'tags)
+
+;;; etags.el ends here
index 7879ea0..462aea8 100644 (file)
        :active (fboundp 'gnus)]
       ["Browse the Web" w3
        :active (fboundp 'w3)]
-      ["Gopher" gopher
-       :active (fboundp 'gopher)]
       "----"
       ["Spell-Check Buffer" ispell-buffer
        :active (fboundp 'ispell-buffer)]
diff --git a/lisp/mule/arabic.el b/lisp/mule/arabic.el
new file mode 100644 (file)
index 0000000..c9c82b0
--- /dev/null
@@ -0,0 +1,67 @@
+;;; arabic.el --- pre-loaded support for Arabic.
+
+;; Copyright (C) 1992,93,94,95 Free Software Foundation, Inc.
+;; Copyright (C) 1995 Amdahl Corporation.
+;; Copyright (C) 1995 Sun Microsystems.
+
+;; This file is part of XEmacs.
+
+;; XEmacs is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; XEmacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with XEmacs; see the file COPYING.  If not, write to the 
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Synched up with: Mule 2.3.
+
+;;; Code:
+
+;; Three character sets for Arabic
+(make-charset 'arabic-digit "Arabic digits"
+             '(registry "MuleArabic-0"
+               dimension 1
+               chars 94
+               final ?2
+               graphic 0
+               direction l2r
+               ))
+
+(make-charset 'arabic-1-column "Arabic 1-column"
+             '(registry "MuleArabic-1"
+               dimension 1
+               chars 94
+               final ?3
+               graphic 0
+               direction r2l
+               ))
+
+(make-charset 'arabic-2-column "Arabic 2-column"
+             '(registry "MuleArabic-2"
+               dimension 1
+               chars 94
+               final ?4
+               graphic 0
+               direction r2l
+               ))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; ARABIC
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; (define-language-environment 'arabic
+;;   "Arabic"
+;;   (lambda ()
+;;     (require 'arabic)))
+
+;;; arabic.el ends here
diff --git a/lisp/mule/canna-leim.el b/lisp/mule/canna-leim.el
new file mode 100644 (file)
index 0000000..2754c51
--- /dev/null
@@ -0,0 +1,55 @@
+;;; canna-leim.el --- Canna-related code for LEIM
+;; Copyright (C) 1997  Stephen Turnbull <turnbull@sk.tsukuba.ac.jp>
+;; Copyright (C) 1997 Free Software Foundation, Inc.
+;;
+;; Shamelessly ripped off from
+;;
+;; skk-leim.el --- SKK related code for LEIM
+;; Copyright (C) 1997
+;; Murata Shuuichirou <mrt@mickey.ai.kyutech.ac.jp>
+;;
+;; Author: Stephen Turnbull <turnbull@sk.tsukuba.ac.jp>
+;; Version: canna-leim.el,v 1.2 1997/10/27 10:08:49 steve Exp
+;; Keywords: japanese, input method, LEIM
+;; Last Modified: 1997/10/27 10:08:49
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either versions 2, or (at your option)
+;; any later version.
+
+;; This program is distributed in the hope that it will be useful
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with XEmacs, see the file COPYING.  If not, write to the Free
+;; Software Foundation Inc., 59 Temple Place - Suite 330, Boston,
+;; MA 02111-1307, USA.
+
+;;; TODO
+;;
+;;  Add pointers to Canna documentation in LEIM format
+
+(defun canna-activate (&optional name)
+  (if (featurep 'CANNA)
+      (require 'canna)
+    (error "Canna is not built into this XEmacs"))
+  (setq inactivate-current-input-method-function 'canna-inactivate)
+  (unless (featurep 'leim-canna-initialized)
+    (canna)
+    (provide 'leim-canna-initialized))
+  (canna-toggle-japanese-mode))
+
+(defun canna-inactivate ()
+  (cond (canna:*japanese-mode* (canna-toggle-japanese-mode))) )
+
+(register-input-method
+ 'japanese-canna "Japanese"
+ 'canna-activate nil
+ "Canna - a kana to kanji conversion program" )
+
+(provide 'canna-leim)
+
+;;; canna-leim.el ends here
diff --git a/lisp/mule/cyrillic.el b/lisp/mule/cyrillic.el
new file mode 100644 (file)
index 0000000..24322f8
--- /dev/null
@@ -0,0 +1,294 @@
+;;; cyrillic.el --- Support for languages which use Cyrillic characters
+
+;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
+;; Licensed to the Free Software Foundation.
+;; Copyright (C) 1997 MORIOKA Tomohiko
+
+;; Keywords: multilingual, Cyrillic
+
+;; This file is part of XEmacs.
+
+;; XEmacs is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; XEmacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with XEmacs; see the file COPYING.  If not, write to the Free
+;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;; 02111-1307, USA.
+
+;;; Commentary:
+
+;; The character set ISO8859-5 is supported.  KOI-8 and ALTERNATIVNYJ
+;; are converted to ISO8859-5 internally.
+
+;;; Code:
+
+;; For syntax of Cyrillic
+(modify-syntax-entry 'cyrillic-iso8859-5 "w")
+(modify-syntax-entry ?\e,L-\e(B ".")
+(modify-syntax-entry ?\e,Lp\e(B ".")
+(modify-syntax-entry ?\e,L}\e(B ".")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; CYRILLIC
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; (define-prefix-command 'describe-cyrillic-environment-map)
+;; (define-key-after describe-language-environment-map [Cyrillic]
+;;   '("Cyrillic" . describe-cyrillic-environment-map)
+;;   t)
+
+;; (define-prefix-command 'setup-cyrillic-environment-map)
+;; (define-key-after setup-language-environment-map [Cyrillic]
+;;   '("Cyrillic" . setup-cyrillic-environment-map)
+;;   t)
+
+\f
+;; ISO-8859-5 staff
+
+;; (make-coding-system
+;;  'cyrillic-iso-8bit 2 ?5
+;;  "ISO 2022 based 8-bit encoding for Cyrillic script (MIME:ISO-8859-5)"
+;;  '((ascii t) (cyrillic-iso8859-5 t) nil nil
+;;    nil ascii-eol ascii-cntl nil nil nil nil))
+
+;; (define-coding-system-alias 'iso-8859-5 'cyrillic-iso-8bit)
+
+(make-coding-system
+ 'iso-8859-5 'iso2022
+ "MIME ISO-8859-5"
+ '(charset-g0 ascii
+   charset-g1 cyrillic-iso8859-5
+   charset-g2 t
+   charset-g3 t
+   mnemonic "ISO8/Cyr"
+   ))
+
+(set-language-info-alist
+ "Cyrillic-ISO" '((setup-function . (setup-cyrillic-iso-environment
+                                    . setup-cyrillic-environment-map))
+                 (charset . (cyrillic-iso8859-5))
+                 (tutorial . "TUTORIAL.ru")
+                 (coding-system . (iso-8859-5))
+                 (sample-text . "Russian (\e,L@caaZXY\e(B)       \e,L7T`PRabRcYbU\e(B!")
+                 (documentation . ("Support for Cyrillic ISO-8859-5."
+                                   . describe-cyrillic-environment-map))))
+
+;; KOI-8 staff
+
+(define-ccl-program ccl-decode-koi8
+  '(3
+    ((read r0)
+     (loop
+       (write-read-repeat
+       r0
+       [0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
+          16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31
+          32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47
+          48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63
+          64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79
+          80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95
+          96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111
+          112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127
+          128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143
+          144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159
+           32  32  32 ?\e,Lq\e(B   32  32  32  32  32  32  32  32  32  32  32  32
+           32  32  32 ?\e,L!\e(B   32  32  32  32  32  32  32  32  32  32  32  32
+          ?\e,Ln\e(B  ?\e,LP\e(B  ?\e,LQ\e(B  ?\e,Lf\e(B  ?\e,LT\e(B  ?\e,LU\e(B  ?\e,Ld\e(B  ?\e,LS\e(B  ?\e,Le\e(B  ?\e,LX\e(B  ?\e,LY\e(B  ?\e,LZ\e(B  ?\e,L[\e(B  ?\e,L\\e(B  ?\e,L]\e(B  ?\e,L^\e(B 
+          ?\e,L_\e(B  ?\e,Lo\e(B  ?\e,L`\e(B  ?\e,La\e(B  ?\e,Lb\e(B  ?\e,Lc\e(B  ?\e,LV\e(B  ?\e,LR\e(B  ?\e,Ll\e(B  ?\e,Lk\e(B  ?\e,LW\e(B  ?\e,Lh\e(B  ?\e,Lm\e(B  ?\e,Li\e(B  ?\e,Lg\e(B  ?\e,Lj\e(B 
+          ?\e,LN\e(B  ?\e,L0\e(B  ?\e,L1\e(B  ?\e,LF\e(B  ?\e,L4\e(B  ?\e,L5\e(B  ?\e,LD\e(B  ?\e,L3\e(B  ?\e,LE\e(B  ?\e,L8\e(B  ?\e,L9\e(B  ?\e,L:\e(B  ?\e,L;\e(B  ?\e,L<\e(B  ?\e,L=\e(B  ?\e,L>\e(B 
+          ?\e,L?\e(B  ?\e,LO\e(B  ?\e,L@\e(B  ?\e,LA\e(B  ?\e,LB\e(B  ?\e,LC\e(B  ?\e,L6\e(B  ?\e,L2\e(B  ?\e,LL\e(B  ?\e,LK\e(B  ?\e,L7\e(B  ?\e,LH\e(B  ?\e,LM\e(B  ?\e,LI\e(B  ?\e,LG\e(B  ?\e,LJ\e(B ]))))
+  "CCL program to decode KOI8.")
+
+(define-ccl-program ccl-encode-koi8
+  `(1
+    ((read r0)
+     (loop
+       (if (r0 != ,(charset-id 'cyrillic-iso8859-5))
+          (write-read-repeat r0)
+        ((read r0)
+         (r0 -= 160)
+         (write-read-repeat
+          r0
+          [ 32 179  32  32  32  32  32  32  32  32  32  32  32  32  32  32
+               225 226 247 231 228 229 246 250 233 234 235 236 237 238 239 240
+               242 243 244 245 230 232 227 254 251 253 255 249 248 252 224 241
+               193 194 215 199 196 197 214 218 201 202 203 204 205 206 207 208
+               210 211 212 213 198 200 195 222 219 221 223 217 216 220 192 209
+               32 163  32  32  32  32  32  32  32  32  32  32  32  32  32  32])
+         )))))
+  "CCL program to encode KOI8.")
+
+;(make-coding-system
+;  'cyrillic-koi8 4
+;  ;; We used to use ?K.  It is true that ?K is more strictly correct,
+;  ;; but it is also used for Korean.
+;  ;; So people who use koi8 for languages other than Russian
+;  ;; will have to forgive us.
+;  ?R "KOI8 8-bit encoding for Cyrillic (MIME: KOI8-R)"
+;  (cons ccl-decode-koi8 ccl-encode-koi8))
+
+;(define-coding-system-alias 'koi8-r 'cyrillic-koi8)
+;(define-coding-system-alias 'koi8 'cyrillic-koi8)
+
+(make-coding-system
+ 'koi8-r 'ccl
+ "Coding-system used for KOI8-R."
+ `(decode ,ccl-decode-koi8
+   encode ,ccl-encode-koi8
+   mnemonic "KOI8"))
+
+;(define-coding-system-alias 'koi8-r 'koi8)
+
+;; (define-ccl-program ccl-encode-koi8-font
+;;   '(0
+;;     ((r1 -= 160)
+;;      (r1 = r1
+;;          [ 32 179  32  32  32  32  32  32  32  32  32  32  32  32  32  32
+;;               225 226 247 231 228 229 246 250 233 234 235 236 237 238 239 240
+;;               242 243 244 245 230 232 227 254 251 253 255 249 248 252 224 241
+;;               193 194 215 199 196 197 214 218 201 202 203 204 205 206 207 208
+;;               210 211 212 213 198 200 195 222 219 221 223 217 216 220 192 209
+;;               32 163  32  32  32  32  32  32  32  32  32  32  32  32  32  32])
+;;      ))
+;;   "CCL program to encode Cyrillic chars to KOI font.")
+
+;; (setq font-ccl-encoder-alist
+;;       (cons (cons "koi8" ccl-encode-koi8-font) font-ccl-encoder-alist))
+
+(set-language-info-alist
+ "Cyrillic-KOI8" '((setup-function . (setup-cyrillic-koi8-environment
+                                     . setup-cyrillic-environment-map))
+                  (charset . (cyrillic-iso8859-5))
+                  (coding-system . (koi8-r))
+                  (tutorial . "TUTORIAL.ru")
+                  (sample-text . "Russian (\e,L@caaZXY\e(B)      \e,L7T`PRabRcYbU\e(B!")
+                  (documentation . ("Support for Cyrillic KOI-8."
+                                    . describe-cyrillic-environment-map))))
+
+;;; ALTERNATIVNYJ staff
+
+(define-ccl-program ccl-decode-alternativnyj
+  '(3
+    ((read r0)
+     (loop
+       (write-read-repeat
+       r0
+       [  0   1   2   3   4   5   6   7   8   9  10  11  12  13  14  15
+              16  17  18  19  20  21  22  23  24  25  26  27  28  29  30  31
+              32  33  34  35  36  37  38  39  40  41  42  43  44  45  46  47
+              48  49  50  51  52  53  54  55  56  57  58  59  60  61  62  63
+              64  65  66  67  68  69  70  71  72  73  74  75  76  77  78  79
+              80  81  82  83  84  85  86  87  88  89  90  91  92  93  94  95
+              96  97  98  99 100 101 102 103 104 105 106 107 108 109 110 111
+              112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127
+              ?\e,L0\e(B  ?\e,L1\e(B  ?\e,L2\e(B  ?\e,L3\e(B  ?\e,L4\e(B  ?\e,L5\e(B  ?\e,L6\e(B  ?\e,L7\e(B  ?\e,L8\e(B  ?\e,L9\e(B  ?\e,L:\e(B  ?\e,L;\e(B  ?\e,L<\e(B  ?\e,L=\e(B  ?\e,L>\e(B  ?\e,L?\e(B
+              ?\e,L@\e(B  ?\e,LA\e(B  ?\e,LB\e(B  ?\e,LC\e(B  ?\e,LD\e(B  ?\e,LE\e(B  ?\e,LF\e(B  ?\e,LG\e(B  ?\e,LH\e(B  ?\e,LI\e(B  ?\e,LJ\e(B  ?\e,LK\e(B  ?\e,LL\e(B  ?\e,LM\e(B  ?\e,LN\e(B  ?\e,LO\e(B
+              ?\e,LP\e(B  ?\e,LQ\e(B  ?\e,LR\e(B  ?\e,LS\e(B  ?\e,LT\e(B  ?\e,LU\e(B  ?\e,LV\e(B  ?\e,LW\e(B  ?\e,LX\e(B  ?\e,LY\e(B  ?\e,LZ\e(B  ?\e,L[\e(B  ?\e,L\\e(B  ?\e,L]\e(B  ?\e,L^\e(B  ?\e,L_\e(B
+              32  32  32  32  32  32  32  32  32  32  32  32  32  32  32  32
+              32  32  32  32  32  32  32  32  32  32  32  32  32  32  32  32
+              32  32  32  32  32  32  32  32  32  32  32  32  32  32  32  32
+              ?\e,L`\e(B  ?\e,La\e(B  ?\e,Lb\e(B  ?\e,Lc\e(B  ?\e,Ld\e(B  ?\e,Le\e(B  ?\e,Lf\e(B  ?\e,Lg\e(B  ?\e,Lh\e(B  ?\e,Li\e(B  ?\e,Lj\e(B  ?\e,Lk\e(B  ?\e,Ll\e(B  ?\e,Lm\e(B  ?\e,Ln\e(B  ?\e,Lo\e(B
+              ?\e,L!\e(B  ?\e,Lq\e(B   32  32  32  32  32  32  32  32  32  32  32  32  32 ?\e,Lp\e(B]))))
+  "CCL program to decode Alternativnyj.")
+
+(define-ccl-program ccl-encode-alternativnyj
+  `(1
+    ((read r0)
+     (loop
+       (if (r0 != ,(charset-id 'cyrillic-iso8859-5))
+          (write-read-repeat r0)
+        ((read r0)
+         (r0 -= 160)
+         (write-read-repeat
+          r0
+          [ 32 240  32  32  32  32  32  32  32  32  32  32  32  32  32  32
+               128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143
+               144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159
+               160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175
+               224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239
+               255 241  32  32  32  32  32  32  32  32  32  32  32  32  32  32])
+         )))))
+  "CCL program to encode Alternativnyj.")
+
+;; (make-coding-system
+;;  'alternativnyj 4
+;;  ?A "Coding-system used for Alternativnyj"
+;;  (cons ccl-decode-alternativnyj ccl-encode-alternativnyj))
+
+(make-coding-system
+ 'alternativnyj 'ccl
+ "Coding-system used for Alternativnyj"
+ `(decode ,ccl-decode-alternativnyj
+   encode ,ccl-encode-alternativnyj
+   mnemonic "Cy.Alt"))
+
+;; (define-ccl-program ccl-encode-alternativnyj-font
+;;   '(0
+;;     ((r1 -= 160)
+;;      (r1 = r1
+;;       [ 32 240  32  32  32  32  32  32  32  32  32  32  32  32  32  32
+;;        128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143
+;;        144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159
+;;        160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175
+;;        224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239
+;;        255 241  32  32  32  32  32  32  32  32  32  32  32  32  32  32])
+;;      ))
+;;   "CCL program to encode Cyrillic chars to Alternativnyj font.")
+
+;; (setq font-ccl-encoder-alist
+;;       (cons (cons "alternativnyj" ccl-encode-alternativnyj-font)
+;;             font-ccl-encoder-alist))
+
+(set-language-info-alist
+ "Cyrillic-ALT" '((setup-function . (setup-cyrillic-alternativnyj-environment
+                                    . setup-cyrillic-environment-map))
+                 (charset . (cyrillic-iso8859-5))
+                 (coding-system . (alternativnyj))
+                 (tutorial . "TUTORIAL.ru")
+                 (sample-text . "Russian (\e,L@caaZXY\e(B)       \e,L7T`PRabRcYbU\e(B!")
+                 (documentation . ("Support for Cyrillic ALTERNATIVNYJ."
+                                   . describe-cyrillic-environment-map))))
+
+;;; GENERAL
+
+(defun setup-cyrillic-environment ()
+  "Setup multilingual environment for Cyrillic users."
+  (interactive)
+  (setq primary-language "Cyrillic")
+
+  (setq coding-category-iso-8-1 'iso-8859-5)
+
+  (set-coding-priority
+   '(coding-category-iso-7
+     coding-category-iso-8-1))
+
+  (setq-default buffer-file-coding-system 'iso-8859-5)
+  (set-terminal-coding-system 'iso-8859-5)
+  (set-keyboard-coding-system 'iso-8859-5)
+
+  (setq default-input-method '("Cyrillic" . "quail-yawerty"))
+  )
+
+(defun describe-cyrillic-support ()
+  "Describe how Emacs support Cyrillic."
+  (interactive)
+  (describe-language-support-internal "Cyrillic"))
+
+(set-language-info-alist
+ "Cyrillic" '((setup-function . setup-cyrillic-environment)
+              (describe-function . describe-cyrillic-support)
+              (charset . (cyrillic-iso8859-5))
+             (tutorial . "TUTORIAL.ru")
+              (coding-system . (iso-8859-5 koi8-r alternativnyj))
+              (sample-text . "Russian (\e,L@caaZXY\e(B) \e,L7T`PRabRcYbU\e(B!")
+              (documentation . nil)))
+
+;;; cyrillic.el ends here
diff --git a/lisp/mule/english.el b/lisp/mule/english.el
new file mode 100644 (file)
index 0000000..60731be
--- /dev/null
@@ -0,0 +1,125 @@
+;;; english.el --- English support
+
+;; Copyright (C) 1997 Electrotechnical Laboratory, JAPAN.
+;; Licensed to the Free Software Foundation.
+;; Copyright (C) 1997 MORIOKA Tomohiko
+
+;; Keywords: multibyte character, character set, syntax, category
+
+;; This file is part of XEmacs.
+
+;; XEmacs is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; XEmacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with XEmacs; see the file COPYING.  If not, write to the Free
+;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;; 02111-1307, USA.
+
+;;; Commentary:
+
+;; We need nothing special to support English on Emacs.  Selecting
+;; English as a language environment is one of the ways to reset
+;; various multilingual environment to the original settting.
+
+;; modified for XEmacs by MORIOKA Tomohiko
+
+;;; Code
+
+(defun setup-english-environment ()
+  "Reset multilingual environment of Emacs to the default status.
+The default status is as follows.
+
+  The default value of enable-multibyte-characters is t.
+
+  The default value of buffer-file-coding-system is nil.
+  The coding system for terminal output is nil.
+  The coding system for keyboard input is nil.
+
+  The order of priorities of coding categories and the coding system
+  bound to each category are as follows
+       coding category                 coding system
+       --------------------------------------------------
+       coding-category-iso-7           iso-2022-7bit
+       coding-category-iso-8-1         iso-8859-1
+       coding-category-iso-8-2         iso-8859-1
+       coding-category-iso-7-else      iso-2022-7bit-lock
+       coding-category-iso-8-else      iso-2022-8bit-ss2
+       coding-category-emacs-mule      no-conversion
+       coding-category-sjis            japanese-shift-jis
+       coding-category-big5            chinese-big5
+       coding-category-binarry         no-conversion
+"
+  (interactive)
+  ;; (setq-default enable-multibyte-characters t)
+
+  ;; (setq coding-category-iso-7           'iso-2022-7bit
+  ;;       coding-category-iso-8-1         'iso-8859-1
+  ;;       coding-category-iso-8-2         'iso-8859-1
+  ;;       coding-category-iso-7-else      'iso-2022-7bit-lock
+  ;;       coding-category-iso-8-else      'iso-2022-8bit-ss2
+  ;;       coding-category-emacs-mule      'no-conversion
+  ;;       coding-category-sjis            'japanese-shift-jis
+  ;;       coding-category-big5            'chinese-big5
+  ;;       coding-category-binary          'binary)
+  (set-coding-category-system 'iso-7           'iso-2022-7bit)
+  (set-coding-category-system 'iso-8-1         'iso-8859-1)
+  (set-coding-category-system 'iso-8-2         'iso-8859-1)
+  (set-coding-category-system 'iso-lock-shift  'iso-2022-lock)
+  (set-coding-category-system 'iso-8-designate 'ctext)
+  (set-coding-category-system 'no-conversion   'no-conversion)
+  (set-coding-category-system 'shift-jis       'shift_jis)
+  (set-coding-category-system 'big5            'big5)
+  
+  ;; (set-coding-priority
+  ;;  '(coding-category-iso-7
+  ;;    coding-category-iso-8-2
+  ;;    coding-category-iso-8-1
+  ;;    coding-category-iso-7-else
+  ;;    coding-category-iso-8-else
+  ;;    coding-category-emacs-mule 
+  ;;    coding-category-raw-text
+  ;;    coding-category-sjis
+  ;;    coding-category-big5
+  ;;    coding-category-binary))
+  (set-coding-priority-list
+   '(iso-7
+     iso-8-2
+     iso-8-1
+     iso-8-designate
+     iso-lock-shift
+     no-conversion
+     shift-jis
+     big5))
+  
+  (set-default-coding-systems nil)
+  ;; Don't alter the terminal and keyboard coding systems here.
+  ;; The terminal still supports the same coding system
+  ;; that it supported a minute ago.
+;;;  (set-terminal-coding-system-internal nil)
+;;;  (set-keyboard-coding-system-internal nil)
+
+  ;;(setq nonascii-insert-offset 0)
+  )
+
+(set-language-info-alist
+ "English" '((setup-function . setup-english-environment)
+            (tutorial . "TUTORIAL")
+            (charset . (ascii))
+            (sample-text . "Hello!, Hi!, How are you?")
+            (documentation . "\
+Nothing special is needed to handle English.")
+            ))
+
+;; Make "ASCII" an alias of "English" language environment.
+(set-language-info-alist
+ "ASCII" (cdr (assoc "English" language-info-alist)))
+
+;;; english.el ends here
diff --git a/lisp/mule/european.el b/lisp/mule/european.el
new file mode 100644 (file)
index 0000000..7feb4e4
--- /dev/null
@@ -0,0 +1,386 @@
+;;; european.el --- Support for European languages
+
+;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
+;; Licensed to the Free Software Foundation.
+;; Copyright (C) 1997 MORIOKA Tomohiko
+
+;; Keywords: multilingual, European
+
+;; This file is part of XEmacs.
+
+;; XEmacs is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; XEmacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with XEmacs; see the file COPYING.  If not, write to the Free
+;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;; 02111-1307, USA.
+
+;;; Commentary:
+
+;; For Europeans, five character sets ISO8859-1,2,3,4,9 are supported.
+
+;;; Code:
+
+;; For syntax of Latin-1 characters.
+(loop for c from 64 to 127              ; from '\e,A@\e(B' to '\e,A\7f\e(B'
+      do (modify-syntax-entry (make-char 'latin-iso8859-1 c) "w"))
+
+(modify-syntax-entry (make-char 'latin-iso8859-1 32) "w") ; no-break space
+(modify-syntax-entry ?\e,AW\e(B "_")
+(modify-syntax-entry ?\e,Aw\e(B "_")
+
+;; For syntax of Latin-2
+(loop for c in '(?\e,B!\e(B ?\e,B#\e(B ?\e,B%\e(B ?\e,B&\e(B ?\e,B)\e(B ?\e,B*\e(B ?\e,B+\e(B ?\e,B,\e(B ?\e,B.\e(B ?\e,B/\e(B ?\e,B1\e(B ?\e,B3\e(B ?\e,B5\e(B ?\e,B6\e(B ?\e,B9\e(B ?\e,B:\e(B ?\e,B;\e(B ?\e,B<\e(B)
+      do (modify-syntax-entry c "w"))
+
+(loop for c from 62 to 126
+      do (modify-syntax-entry (make-char 'latin-iso8859-2 c) "w"))
+
+(modify-syntax-entry (make-char 'latin-iso8859-2 32) "w") ; no-break space
+(modify-syntax-entry ?\e,BW\e(B ".")
+(modify-syntax-entry ?\e,Bw\e(B ".")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; EUROPEANS
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; (define-prefix-command 'describe-european-environment-map)
+;; (define-key-after describe-language-environment-map [European]
+;;   '("European" . describe-european-environment-map)
+;;   t)
+
+;; (define-prefix-command 'setup-european-environment-map)
+;; (define-key-after setup-language-environment-map [European]
+;;   '("European" . setup-european-environment-map)
+;;   t)
+
+;; Setup for LANGAUGE which uses one-byte 8-bit CHARSET, one-byte
+;; 8-bit CODING-SYSTEM, and INPUT-METHOD.
+(defun setup-8-bit-environment (language charset coding-system input-method)
+  (setup-english-environment)
+  (set-default-coding-systems coding-system)
+  ;; (setq coding-category-iso-8-1 coding-system
+  ;;       coding-category-iso-8-2 coding-system)
+  (set-coding-category-system 'iso-8-1 coding-system)
+  (set-coding-category-system 'iso-8-2 coding-system)
+
+  ;; (if charset
+  ;;     (let ((nonascii-offset (- (make-char charset) 128)))
+  ;;       ;; Set up for insertion of characters in this character set
+  ;;       ;; when codes 0200 - 0377 are typed in.
+  ;;       (setq nonascii-insert-offset nonascii-offset)))
+
+  (if input-method
+      (setq default-input-method input-method))
+
+  ;; If this is a Latin-N character set, set up syntax for it in
+  ;; single-byte mode.  We can't use require because the file
+  ;; must be eval'd each time in case we change from one Latin-N to another.
+  ;; (if (string-match "^Latin-\\([1-9]\\)$" language)
+  ;;     (load (downcase language) nil t))
+  )
+\f
+;; Latin-1 (ISO-8859-1)
+
+;; (make-coding-system
+;;  'iso-latin-1 2 ?1
+;;  "ISO 2022 based 8-bit encoding (MIME:ISO-8859-1, Compound Text Encoding)"
+;;  '((ascii t) (latin-iso8859-1 t) nil nil
+;;    nil ascii-eol ascii-cntl nil nil nil nil nil nil nil nil nil t))
+
+;; (define-coding-system-alias 'iso-8859-1 'iso-latin-1)
+;; (define-coding-system-alias 'latin-1 'iso-latin-1)
+;; (define-coding-system-alias 'ctext 'iso-latin-1)
+
+(defun setup-latin1-environment ()
+  "Set up multilingual environment (MULE) for European Latin-1 users."
+  (interactive)
+  (setup-8-bit-environment "Latin-1" 'latin-iso8859-1 'iso-8859-1
+                          "latin-1-prefix"))
+
+(set-language-info-alist
+ "Latin-1" '((setup-function . (setup-latin1-environment
+                               . setup-european-environment-map))
+            (charset . (ascii latin-iso8859-1))
+            (coding-system . (iso-8859-1))
+            (sample-text
+             . "Hello, Hej, Tere, Hei, Bonjour, Gr\e,A|_\e(B Gott, Ciao, \e,A!\e(BHola!")
+            (documentation . ("\
+These languages are supported with the Latin-1 (ISO-8859-1) character set:
+ Danish, Dutch, English, Faeroese, Finnish, French, German, Icelandic,
+ Irish, Italian, Norwegian, Portuguese, Spanish, and Swedish.
+" . describe-european-environment-map))
+            ))
+
+(set-language-info-alist
+ "German" '((setup-function . (setup-latin1-environment
+                               . setup-european-environment-map))
+            (charset . (ascii latin-iso8859-1))
+            (coding-system . (iso-8859-1))
+            (tutorial . "TUTORIAL.de")
+            (sample-text
+             . "Hello, Hej, Tere, Hei, Bonjour, Gr\e,A|_\e(B Gott, Ciao, \e,A!\e(BHola!")
+            (documentation . ("\
+These languages are supported with the Latin-1 (ISO-8859-1) character set:
+ Danish, Dutch, English, Faeroese, Finnish, French, German, Icelandic,
+ Irish, Italian, Norwegian, Portuguese, Spanish, and Swedish.
+" . describe-european-environment-map))
+            ))
+
+(set-language-info-alist
+ "French" '((setup-function . (setup-latin1-environment
+                               . setup-european-environment-map))
+            (charset . (ascii latin-iso8859-1))
+            (coding-system . (iso-8859-1))
+            (tutorial . "TUTORIAL.fr")
+            (sample-text
+             . "Hello, Hej, Tere, Hei, Bonjour, Gr\e,A|_\e(B Gott, Ciao, \e,A!\e(BHola!")
+            (documentation . ("\
+These languages are supported with the Latin-1 (ISO-8859-1) character set:
+ Danish, Dutch, English, Faeroese, Finnish, French, German, Icelandic,
+ Irish, Italian, Norwegian, Portuguese, Spanish, and Swedish.
+" . describe-european-environment-map))
+            ))
+
+(set-language-info-alist
+ "Norwegian" '((setup-function . (setup-latin1-environment
+                               . setup-european-environment-map))
+            (charset . (ascii latin-iso8859-1))
+            (coding-system . (iso-8859-1))
+            (tutorial . "TUTORIAL.no")
+            (sample-text
+             . "Hello, Hej, Tere, Hei, Bonjour, Gr\e,A|_\e(B Gott, Ciao, \e,A!\e(BHola!")
+            (documentation . ("\
+These languages are supported with the Latin-1 (ISO-8859-1) character set:
+ Danish, Dutch, English, Faeroese, Finnish, French, German, Icelandic,
+ Irish, Italian, Norwegian, Portuguese, Spanish, and Swedish.
+" . describe-european-environment-map))
+            ))
+\f
+;; Latin-2 (ISO-8859-2)
+
+;; (make-coding-system
+;;  'iso-latin-2 2 ?2
+;;  "ISO 2022 based 8-bit encoding (MIME:ISO-8859-2)"
+;;  '((ascii t) (latin-iso8859-2 t) nil nil
+;;    nil ascii-eol ascii-cntl nil nil nil nil))
+
+;; (define-coding-system-alias 'iso-8859-2 'iso-latin-2)
+;; (define-coding-system-alias 'latin-2 'iso-latin-2)
+
+(make-coding-system
+ 'iso-8859-2 'iso2022 "MIME ISO-8859-2"
+ '(charset-g0 ascii
+   charset-g1 latin-iso8859-2
+   charset-g2 t
+   charset-g3 t
+   mnemonic "MIME/Ltn-2"
+   ))
+
+(defun setup-latin2-environment ()
+  "Set up multilingual environment (MULE) for European Latin-2 users."
+  (interactive)
+  (setup-8-bit-environment "Latin-2" 'latin-iso8859-2 'iso-8859-2
+                          "latin-2-prefix"))
+
+(set-language-info-alist
+ "Latin-2" '((setup-function . (setup-latin2-environment
+                               . setup-european-environment-map))
+            (charset . (ascii latin-iso8859-2))
+            (coding-system . (iso-8859-2))
+            (documentation . ("\
+These languages are supported with the Latin-2 (ISO-8859-2) character set:
+ Albanian, Czech, English, German, Hungarian, Polish, Romanian,
+ Serbian, Croatian, Slovak, Slovene, and Swedish.
+" . describe-european-environment-map))
+            ))
+
+(set-language-info-alist
+ "Croatian" '((setup-function . (setup-latin2-environment
+                               . setup-european-environment-map))
+             (charset . (ascii latin-iso8859-2))
+             (tutorial . "TUTORIAL.hr")
+             (coding-system . (iso-8859-2))
+             (documentation . ("\
+These languages are supported with the Latin-2 (ISO-8859-2) character set:
+ Albanian, Czech, English, German, Hungarian, Polish, Romanian,
+ Serbian, Croatian, Slovak, Slovene, and Swedish.
+" . describe-european-environment-map))
+             ))
+
+(set-language-info-alist
+ "Polish" '((setup-function . (setup-latin2-environment
+                               . setup-european-environment-map))
+             (charset . (ascii latin-iso8859-2))
+             (tutorial . "TUTORIAL.pl")
+             (coding-system . (iso-8859-2))
+             (documentation . ("\
+These languages are supported with the Latin-2 (ISO-8859-2) character set:
+ Albanian, Czech, English, German, Hungarian, Polish, Romanian,
+ Serbian, Croatian, Slovak, Slovene, and Swedish.
+" . describe-european-environment-map))
+             ))
+
+(set-language-info-alist
+ "Romanian" '((setup-function . (setup-latin2-environment
+                                . setup-european-environment-map))
+             (charset . (ascii latin-iso8859-2))
+             (tutorial . "TUTORIAL.ro")
+             (coding-system . (iso-8859-2))
+             (documentation . ("\
+These languages are supported with the Latin-2 (ISO-8859-2) character set:
+ Albanian, Czech, English, German, Hungarian, Polish, Romanian,
+ Serbian, Croatian, Slovak, Slovene, and Swedish.
+" . describe-european-environment-map))
+             ))
+\f
+;; Latin-3 (ISO-8859-3)
+
+;; (make-coding-system
+;;  'iso-latin-3 2 ?3
+;;  "ISO 2022 based 8-bit encoding (MIME:ISO-8859-3)"
+;;  '((ascii t) (latin-iso8859-3 t) nil nil
+;;    nil ascii-eol ascii-cntl nil nil nil nil))
+
+;; (define-coding-system-alias 'iso-8859-3 'iso-latin-3)
+;; (define-coding-system-alias 'latin-3 'iso-latin-3)
+
+(make-coding-system
+ 'iso-8859-3 'iso2022 "MIME ISO-8859-3"
+ '(charset-g0 ascii
+   charset-g1 latin-iso8859-3
+   charset-g2 t
+   charset-g3 t
+   mnemonic "MIME/Ltn-3"
+   ))
+
+(defun setup-latin3-environment ()
+  "Set up multilingual environment (MULE) for European Latin-3 users."
+  (interactive)
+  (setup-8-bit-environment "Latin-3" 'latin-iso8859-3 'iso-8859-3
+                          "latin-3-prefix"))
+
+(set-language-info-alist
+ "Latin-3" '((setup-function . (setup-latin3-environment
+                               . setup-european-environment-map))
+            (charset . (ascii latin-iso8859-3))
+            (coding-system . (iso-8859-3))
+            (documentation . ("\
+These languages are supported with the Latin-3 (ISO-8859-3) character set:
+ Afrikaans, Catalan, Dutch, English, Esperanto, French, Galician,
+ German, Italian, Maltese, Spanish, and Turkish.
+" . describe-european-environment-map))
+            ))
+\f
+;; Latin-4 (ISO-8859-4)
+
+;; (make-coding-system
+;;  'iso-latin-4 2 ?4
+;;  "ISO 2022 based 8-bit encoding (MIME:ISO-8859-4)"
+;;  '((ascii t) (latin-iso8859-4 t) nil nil
+;;    nil ascii-eol ascii-cntl nil nil nil nil))
+
+;; (define-coding-system-alias 'iso-8859-4 'iso-latin-4)
+;; (define-coding-system-alias 'latin-4 'iso-latin-4)
+
+(make-coding-system
+ 'iso-8859-4 'iso2022 "MIME ISO-8859-4"
+ '(charset-g0 ascii
+   charset-g1 latin-iso8859-4
+   charset-g2 t
+   charset-g3 t
+   mnemonic "MIME/Ltn-4"
+   ))
+
+(defun setup-latin4-environment ()
+  "Set up multilingual environment (MULE) for European Latin-4 users."
+  (interactive)
+  (setup-8-bit-environment "Latin-4" 'latin-iso8859-4 'iso-8859-4
+                          "latin-4-prefix"))
+
+(set-language-info-alist
+ "Latin-4" '((setup-function . (setup-latin4-environment
+                               . setup-european-environment-map))
+            (charset . (ascii latin-iso8859-4))
+            (coding-system . (iso-8859-4))
+            (documentation . ("\
+These languages are supported with the Latin-4 (ISO-8859-4) character set:
+ Danish, English, Estonian, Finnish, German, Greenlandic, Lappish,
+ Latvian, Lithuanian, and Norwegian.
+" . describe-european-environment-map))
+            ))
+\f
+;; Latin-5 (ISO-8859-9)
+
+;; (make-coding-system
+;;  'iso-latin-5 2 ?9
+;;  "ISO 2022 based 8-bit encoding (MIME:ISO-8859-9)"
+;;  '((ascii t) (latin-iso8859-9 t) nil nil
+;;    nil ascii-eol ascii-cntl nil nil nil nil))
+
+;; (define-coding-system-alias 'iso-8859-9 'iso-latin-5)
+;; (define-coding-system-alias 'latin-5 'iso-latin-5)
+
+(make-coding-system
+ 'iso-8859-9 'iso2022 "MIME ISO-8859-9"
+ '(charset-g0 ascii
+   charset-g1 latin-iso8859-9
+   charset-g2 t
+   charset-g3 t
+   mnemonic "MIME/Ltn-5"
+   ))
+
+(defun setup-latin5-environment ()
+  "Set up multilingual environment (MULE) for European Latin-5 users."
+  (interactive)
+  (setup-8-bit-environment "Latin-5" 'latin-iso8859-9 'iso-8859-5
+                          "latin-5-prefix"))
+
+(set-language-info-alist
+ "Latin-5" '((setup-function . (setup-latin5-environment
+                               . setup-european-environment-map))
+            (charset . (ascii latin-iso8859-9))
+            (coding-system . (iso-8859-5))
+            (documentation . ("\
+These languages are supported with the Latin-5 (ISO-8859-9) character set.
+" . describe-european-environment-map))
+            ))
+
+;; (defun setup-european-environment ()
+;;   "Setup multilingual environment (MULE) for European languages users.
+;; It actually reset MULE to the default status, and
+;; set quail-latin-1 as the default input method to be selected.
+;; See also the documentation of setup-english-environment."
+;;   (setup-english-environment)
+;;   (setq default-input-method '("European" . "quail-latin-1")))
+
+;; (defun describe-european-support ()
+;;   "Describe how Emacs support European languages."
+;;   (interactive)
+;;   (describe-language-support-internal "European"))
+
+;; (set-language-info-alist
+;;  "European" '((setup-function . setup-european-environment)
+;;               (describe-function . describe-european-support)
+;;               (charset . (ascii latin-iso8859-1 latin-iso8859-2
+;;                           latin-iso8859-3 latin-iso8859-4 latin-iso8859-9))
+;;               (coding-system . (iso-8859-1 iso-8859-2 iso-8859-3
+;;                                 iso-8859-4 iso-8859-9))
+;;               (sample-text
+;;                . "Hello, Hej, Tere, Hei, Bonjour, Gr\e,A|_\e(B Gott, Ciao, \e,A!\e(BHola!")
+;;               (documentation . "\
+;; Almost all of European languages are supported by the character sets and
+;; coding systems listed below.
+;; To input them, LEIM (Libraries for Emacs Input Methods) should have been
+;; installed.")
+;;               ))
+
+;;; european.el ends here
diff --git a/lisp/mule/greek.el b/lisp/mule/greek.el
new file mode 100644 (file)
index 0000000..b878c67
--- /dev/null
@@ -0,0 +1,84 @@
+;;; greek.el --- Support for Greek
+
+;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
+;; Licensed to the Free Software Foundation.
+;; Copyright (C) 1997 MORIOKA Tomohiko
+
+;; Keywords: multilingual, Greek
+
+;; This file is part of XEmacs.
+
+;; XEmacs is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; XEmacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with XEmacs; see the file COPYING.  If not, write to the Free
+;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;; 02111-1307, USA.
+
+;;; Commentary:
+
+;; For Greek, the character set ISO8859-7 is supported.
+
+;;; Code:
+
+;; For syntax of Greek
+(loop for c from 54 to 126
+      do (modify-syntax-entry (make-char 'greek-iso8859-7 c) "w"))
+(modify-syntax-entry (make-char 'greek-iso8859-7 32) "w") ; no-break space
+(modify-syntax-entry ?\e,F7\e(B ".")
+(modify-syntax-entry ?\e,F;\e(B ".")
+(modify-syntax-entry ?\e,F=\e(B ".")
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; GREEK
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; (define-language-environment 'greek
+;;   "Greek"
+;;   (lambda ()
+;;     (set-coding-category-system 'iso-8-designate 'iso-8859-7)
+;;     (set-coding-priority-list '(iso-8-designate iso-8-1))
+;;     (set-default-buffer-file-coding-system 'iso-8859-7)
+;;     (setq terminal-coding-system 'iso-8859-7)
+;;     (setq keyboard-coding-system 'iso-8859-7)
+;;     ;; (setq-default quail-current-package
+;;     ;;               (assoc "greek" quail-package-alist))
+;;     ))
+\f
+;; (make-coding-system
+;;  'iso-8859-7 2 ?7 "MIME ISO-8859-7"
+;;  '((ascii t) (greek-iso8859-7 t) nil nil
+;;    nil ascii-eol ascii-cntl nil nil nil nil))
+
+(make-coding-system
+ 'iso-8859-7 'iso2022 "MIME ISO-8859-7"
+ '(charset-g0 ascii
+   charset-g1 greek-iso8859-7
+   charset-g2 t
+   charset-g3 t
+   mnemonic "Grk"
+   ))
+
+(defun setup-greek-environment ()
+  "Setup multilingual environment (MULE) for Greek."
+  (interactive)
+  (setup-8-bit-environment "Greek" 'greek-iso8859-7 'iso-8859-7 "greek")
+  )
+
+(set-language-info-alist
+ "Greek" '((setup-function . setup-greek-environment)
+          (charset . (greek-iso8859-7))
+          (coding-system . (iso-8859-7))
+          (sample-text . "Greek (\e,FGkk]mija\e(B)       \e,FCei\\e(B \e,Fsar\e(B")
+          (documentation . t)))
+
+;;; greek.el ends here
diff --git a/lisp/mule/hebrew.el b/lisp/mule/hebrew.el
new file mode 100644 (file)
index 0000000..767fc0a
--- /dev/null
@@ -0,0 +1,93 @@
+;;; hebrew.el --- Support for Hebrew
+
+;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
+;; Licensed to the Free Software Foundation.
+
+;; Keywords: multilingual, Hebrew
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; For Hebrew, the character sets ISO8859-8 is supported.
+
+;;; Code:
+
+;; Syntax of Hebrew characters
+(loop for c from 96 to 122
+      do (modify-syntax-entry (make-char 'hebrew-iso8859-8 c) "w"))
+(modify-syntax-entry (make-char 'hebrew-iso8859-8 32) "w") ; no-break space
+
+\f
+;; (make-coding-system
+;;  'hebrew-iso-8bit 2 ?8
+;;  "ISO 2022 based 8-bit encoding for Hebrew (MIME:ISO-8859-8)"
+;;  '((ascii t) (hebrew-iso8859-8 t) nil nil
+;;    nil ascii-eol ascii-cntl nil nil nil nil nil t))
+
+;; (define-coding-system-alias 'iso-8859-8 'hebrew-iso-8bit)
+
+(make-coding-system
+ 'iso-8859-8 'iso2022
+ "MIME ISO-8859-8"
+ '(charset-g0 ascii
+   charset-g1 hebrew-iso8859-8
+   charset-g2 t
+   charset-g3 t
+   no-iso6429 t
+   mnemonic "MIME/Hbrw"
+))
+
+(make-coding-system
+ 'ctext-hebrew 'iso2022
+ "Coding-system of Hebrew."
+ '(charset-g0 ascii
+   charset-g1 hebrew-iso8859-8
+   charset-g2 t
+   charset-g3 t
+   mnemonic "CText/Hbrw"
+   ))
+
+(defun setup-hebrew-environment ()
+  "Setup multilingual environment (MULE) for Hebrew.
+But, please note that right-to-left writing is not yet supported."
+  (interactive)
+  (setup-8-bit-environment "Hebrew" 'hebrew-iso8859-8 'iso-8859-8
+                          "hebrew")
+  (set-coding-category-system 'iso-8-designate 'iso-8859-8)
+  (set-coding-priority-list
+   '(iso-8-designate
+     iso-8-1
+     iso-7
+     iso-8-2
+     iso-lock-shift
+     no-conversion
+     shift-jis
+     big5))
+  )
+
+(set-language-info-alist
+ "Hebrew" '((setup-function . setup-hebrew-environment)
+           (describe-function . describe-hebrew-support)
+           (charset . (hebrew-iso8859-8))
+           (coding-system . (iso-8859-8))
+           (sample-text . "Hebrew      \e,Hylem\e(B")
+           (documentation . "Right-to-left writing is not yet supported.")
+           ))
+
+;;; hebrew.el ends here
diff --git a/lisp/mule/kinsoku.el b/lisp/mule/kinsoku.el
new file mode 100644 (file)
index 0000000..94cf414
--- /dev/null
@@ -0,0 +1,285 @@
+;; kinsoku.el -- Kinsoku (line wrap) processing for XEmacs/Mule
+
+;; Copyright (C) 1997 Free Software Foundation, Inc.
+;; This file is part of Mule (MULtilingual Enhancement of XEmacs).
+;; This file contains Japanese and Chinese characters.
+
+;; XEmacs is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; XEmacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with XEmacs; see the file COPYING.  If not, write to the 
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;; Written by Jareth Hein (jhod@po.iijnet.or.jp) based off of
+;; code by S.Tomura, Electrotechnical Lab. (tomura@etl.go.jp) from
+;; Mule-2.3
+
+;;;    Special characters for JIS code
+;;;     "\e$B!!!"!#!$!%!&!'!'!(!)!*!+!,!-!.!/\e(B"
+;;;   "\e$B!0!1!2!3!4!5!6!7!8!9!:!;!<!=!>!?\e(B"
+;;;   "\e$B!@!A!B!C!D!E!F!G!H!I!J!K!L!M!N!O\e(B"
+;;;   "\e$B!P!Q!R!S!T!U!V!W!X!Y!Z![!\!]!^!_\e(B"
+;;;   "\e$B!`!a!b!c!d!e!f!g!h!i!j!k!l!m!n!o\e(B"
+;;;   "\e$B!p!q!r!s!t!u!v!w!x!y!z!{!|!}!~\e(B"
+;;;     "\e$B"!"""#"$"%"&"'"(")"*"+","-".\e(B "
+;;;     "\e$B&!&"&#&$&%&&&'&(&)&*&+&,&-&.&/\e(B"
+;;;   "\e$B&0&1&2&3&4&5&6&7&8\e(B"
+;;;     "\e$B&A&B&C&D&E&F&G&H&I&J&K&L&M&N&O\e(B"
+;;;   "\e$B&P&Q&R&S&T&U&V&W&X\e(B"
+;;;     "\e$B'!'"'#'$'%'&'''(')'*'+','-'.'/\e(B"
+;;;   "\e$B'0'1'2'3'4'5'6'7'8'9':';'<'='>'?\e(B"
+;;;   "\e$B'@'A\e(B"
+;;;     "\e$B'Q'R'S'T'U'V'W'X'Y'Z'['\']'^'_!I\e(B
+;;;   "\e$B'`'a'b'c'd'e'f'g'h'i'j'k'l'm'n'o\e(B"
+;;;   "\e$B'p'q\e(B"
+;;;    \e$B#0#1#2#3#4#5#6#7#8#9#A#B#C#D#E#F\e(B
+;;;   "\e$B$!$#$%$'$)$C$c$e$g$n\e(B"
+;;;   "\e$B%!%#%%%'%)%C%c%e%g%n%u%v\e(B"
+
+;;; Special characters for GB
+;;;
+;;;  \e$A!!!"!#!$!%!&!'!(!)!*!+!,!-!.!/\e(B
+;;;\e$A!0!1!2!3!4!5!6!7!8!9!:!;!<!=!>!?\e(B
+;;;\e$A!@!A!B!C!D!E!F!G!H!I!J!K!L!M!N!O\e(B
+;;;\e$A!P!Q!R!S!T!U!V!W!X!Y!Z![!\!]!^!_\e(B
+;;;\e$A!`!a!b!c!d!e!f!g!h!i!j!k!l!m!n!o\e(B
+;;;\e$A!p!q!r!s!t!u!v!w!x!y!z!{!|!}!~\e(B
+;;;  \e$A"1"2"3"4"5"6"7"8"9":";"<"=">"?\e(B
+;;;\e$A"@"A"B"C"D"E"F"G"H"I"J"K"L"M"N"O\e(B
+;;;\e$A"P"Q"R"S"T"U"V"W"X"Y"Z"["\"]"^"_\e(B
+;;;\e$A"`"a"b"c"d"e"f"g"h"i"j"k"l"m"n"o\e(B
+;;;\e$A"p"q"r"s"t"u"v"w"x"y"z"{"|"}"~\e(B
+;;;  \e$A#!#"###$#%#&#'#(#)#*#+#,#-#.#/\e(B
+;;;\e$A#0#1#2#3#4#5#6#7#8#9#:#;#<#=#>#?\e(B
+;;;\e$A#@#A#B#C#D#E#F#G#H#I#J#K#L#M#N#O\e(B
+;;;\e$A#P#Q#R#S#T#U#V#W#X#Y#Z#[#\#]#^#_\e(B
+;;;\e$A#`#a#b#c#d#e#f#g#h#i#j#k#l#m#n#o\e(B
+;;;\e$A#p#q#r#s#t#u#v#w#x#y#z#{#|#}#~\e(B
+;;;  \e$A$!$"$#$$$%$&$'$($)$*$+$,$-$.$/\e(B
+;;;\e$A$0$1$2$3$4$5$6$7$8$9$:$;$<$=$>$?\e(B
+;;;\e$A$@$A$B$C$D$E$F$G$H$I$J$K$L$M$N$O\e(B
+;;;\e$A$P$Q$R$S$T$U$V$W$X$Y$Z$[$\$]$^$_\e(B
+;;;\e$A$`$a$b$c$d$e$f$g$h$i$j$k$l$m$n$o\e(B
+;;;\e$A$p$q$r$s$t$u$v$w$x$y$z${$|$}$~\e(B
+;;;  \e$A%!%"%#%$%%%&%'%(%)%*%+%,%-%.%/\e(B
+;;;\e$A%0%1%2%3%4%5%6%7%8%9%:%;%<%=%>%?\e(B
+;;;\e$A%@%A%B%C%D%E%F%G%H%I%J%K%L%M%N%O\e(B
+;;;\e$A%P%Q%R%S%T%U%V%W%X%Y%Z%[%\%]%^%_\e(B
+;;;\e$A%`%a%b%c%d%e%f%g%h%i%j%k%l%m%n%o\e(B
+;;;\e$A%p%q%r%s%t%u%v%w%x%y%z%{%|%}%~\e(B
+;;;  \e$A&!&"&#&$&%&&&'&(&)&*&+&,&-&.&/\e(B
+;;;\e$A&0&1&2&3&4&5&6&7&8&9&:&;&<&=&>&?\e(B
+;;;\e$A&@&A&B&C&D&E&F&G&H&I&J&K&L&M&N&O\e(B
+;;;\e$A&P&Q&R&S&T&U&V&W&X&Y&Z&[&\&]&^&_\e(B
+;;;\e$A&`&a&b&c&d&e&f&g&h&i&j&k&l&m&n&o\e(B
+;;;\e$A&p&q&r&s&t&u&v&w&x&y&z&{&|&}&~\e(B
+;;;  \e$A'!'"'#'$'%'&'''(')'*'+','-'.'/\e(B
+;;;\e$A'0'1'2'3'4'5'6'7'8'9':';'<'='>'?\e(B
+;;;\e$A'@'A'B'C'D'E'F'G'H'I'J'K'L'M'N'O\e(B
+;;;\e$A'P'Q'R'S'T'U'V'W'X'Y'Z'['\']'^'_\e(B
+;;;\e$A'`'a'b'c'd'e'f'g'h'i'j'k'l'm'n'o\e(B
+;;;\e$A'p'q'r's't'u'v'w'x'y'z'{'|'}'~\e(B
+;;;  \e$A(!("(#($(%(&('((()(*(+(,(-(.(/\e(B
+;;;\e$A(0(1(2(3(4(5(6(7(8(9(:(;(<(=(>(?\e(B
+;;;\e$A(@(A(B(C(D(E(F(G(H(I(J(K(L(M(N(O\e(B
+;;;\e$A(P(Q(R(S(T(U(V(W(X(Y(Z([(\(](^(_\e(B
+;;;\e$A(`(a(b(c(d(e(f(g(h(i(j(k(l(m(n(o\e(B
+
+;;; Special characters for BIG5
+;;;
+;;;  \e$(0!!!"!#!$!%!&!'!(!)!*!+!,!-!.!/\e(B
+;;;\e$(0!0!1!2!3!4!5!6!7!8!9!:!;!<!=!>!?\e(B
+;;;\e$(0!@!A!B!C!D!E!F!G!H!I!J!K!L!M!N!O\e(B
+;;;\e$(0!P!Q!R!S!T!U!V!W!X!Y!Z![!\!]!^!_\e(B
+;;;\e$(0!`!a!b!c!d!e!f!g!h!i!j!k!l!m!n!o\e(B
+;;;\e$(0!p!q!r!s!t!u!v!w!x!y!z!{!|!}!~\e(B
+;;;  \e$(0"!"""#"$"%"&"'"(")"*"+","-"."/\e(B
+;;;\e$(0"0"1"2"3"4"5"6"7"8"9":";"<"=">"?\e(B
+;;;\e$(0"@"A"B"C"D"E"F"G"H"I"J"K"L"M"N"O\e(B
+;;;\e$(0"P"Q"R"S"T"U"V"W"X"Y"Z"["\"]"^"_\e(B
+;;;\e$(0"`"a"b"c"d"e"f"g"h"i"j"k"l"m"n"o\e(B
+;;;\e$(0"p"q"r"s"t"u"v"w"x"y"z"{"|"}"~\e(B
+;;;  \e$(0#!#"###$#%#&#'#(#)#*#+#,#-#.#/\e(B
+;;;\e$(0#0#1#2#3#4#5#6#7#8#9#:#;#<#=#>#?\e(B
+;;;\e$(0#@#A#B#C#D#E#F#G#H#I#J#K#L#M#N#O\e(B
+;;;\e$(0#P#Q#R#S#T#U#V#W#X#Y#Z#[#\#]#^#_\e(B
+;;;\e$(0#`#a#b#c#d#e#f#g#h#i#j#k#l#m#n#o\e(B
+;;;\e$(0#p#q#r#s#t#u#v#w#x#y#z#{#|#}#~\e(B
+;;;  \e$(0$!$"$#$$$%$&$'$($)$*$+$,$-$.$/\e(B
+;;;\e$(0$0$1$2$3$4$5$6$7$8$9$:$;$<$=$>$?\e(B
+;;;\e$(0$@$A$B$C$D$E$F$G$H$I$J$K$L$M$N$O\e(B
+;;;\e$(0$P$Q$R$S$T$U$V$W$X$Y$Z$[$\$]$^$_\e(B
+;;;\e$(0$`$a$b$c$d$e$f$g$h$i$j$k$l$m$n$o\e(B
+;;;\e$(0$p$q$r$s$t$u$v$w$x$y$z${$|$}$~\e(B
+;;;  \e$(0%!%"%#%$%%%&%'%(%)%*%+%,%-%.%/\e(B
+;;;\e$(0%0%1%2%3%4%5%6%7%8%9%:%;%<%=%>%?\e(B
+
+(defvar kinsoku-ascii nil "Do kinsoku-processing for ASCII.")
+(make-variable-buffer-local 'kinsoku-ascii)
+(set-default 'kinsoku-ascii nil)
+(defvar kinsoku-jis t "Do kinsoku-processing for JISX0208.")
+(make-variable-buffer-local 'kinsoku-jis)
+(set-default 'kinsoku-jis t)
+(defvar kinsoku-gb t "Do kinsoku-processing for GB2312.")
+(make-variable-buffer-local 'kinsoku-gb)
+(set-default 'kinsoku-gb t)
+(defvar kinsoku-big5 t "Do kinsoku-processing for Big5..")
+(make-variable-buffer-local 'kinsoku-big5)
+(set-default 'kinsoku-big5 t)
+
+(defvar kinsoku-ascii-bol "!)-_~}]:;',.?" "BOL kinsoku for ASCII.")
+(defvar kinsoku-ascii-eol "({[" "EOL kinsoku for ASCII.")
+(defvar kinsoku-jis-bol
+  (concat  "\e$B!"!#!$!%!&!'!(!)!*!+!,!-!.!/!0!1!2!3!4!5!6!7!8!9!:!;!<!=!>\e(B"
+          "\e$B!?!@!A!B!C!D!E!G!I!K!M!O!Q!S!U!W!Y![!k!l!m!n\e(B"
+          "\e$B$!$#$%$'$)$C$c$e$g$n%!%#%%%'%)%C%c%e%g%n%u%v\e(B")
+  "BOL kinsoku for JISX0208.")
+(defvar kinsoku-jis-eol
+  "\e$B!F!H!J!L!N!P!R!T!V!X!Z!k!l!m!n!w!x\e(B"
+  "EOL kinsoku for JISX0208.")
+(defvar kinsoku-gb-bol
+  (concat  "\e$A!"!##.#,!$!%!&!'!(!)!*!+!,!-!/!1#)!3!5!7!9!;!=\e(B"
+          "\e$A!?#;#:#?#!!@!A!B!C!c!d!e!f#/#\#"#_#~#|(e\e(B")
+  "BOL kinsoku for GB2312.")
+(defvar kinsoku-gb-eol
+  (concat "\e$A!.!0#"#(!2!4!6!8!:!<!>!c!d!e#@!f!l\e(B"
+         "\e$A(E(F(G(H(I(J(K(L(M(N(O(P(Q(R(S(T(U(V(W(X(Y(h\e(B")
+  "EOL kinsoku for GB2312.")
+(defvar kinsoku-big5-bol
+  (concat  "\e$(0!"!#!$!%!&!'!(!)!*!+!,!-!.!/!0!1!2\e(B"
+          "\e$(0!3!4!5!6!7!8!9!:!;!<!=!?!A!C!E!G!I!K\e(B"
+          "\e$(0!M!O!Q\e(B       \e$(0!S!U!W!Y![!]!_!a!c!e!g!i!k!q\e(B"
+          "\e$(0"#"$"%"&"'"(")"*"+","2"3"4"j"k"l"x%7\e(B")
+  "BOL kinsoku for BIG5.")
+(defvar kinsoku-big5-eol
+  (concat "\e$(0!>!@!B!D!F!H!J!L!N!P!R!T!V!X!Z!\!^!`!b\e(B"
+         "\e$(0!d!f!h!j!k!q!p"i"j"k"n"x$u$v$w$x$y$z${\e(B"
+         "\e$(0$|$}$~%!%"%#%$%%%&%'%(%)%*%+%:\e(B")
+  "EOL kinsoku for BIG5.")
+
+(define-category ?s "Kinsoku forbidden start of line characters")
+(define-category ?e "Kinsoku forbidden end of line characters")
+
+;; kinsoku ascii
+(loop for char in (string-to-char-list kinsoku-ascii-bol)
+      do (modify-category-entry char ?s))
+(loop for char in kinsoku-ascii-eol
+      do (modify-category-entry char ?e))
+;; kinsoku-jis
+(loop for char in (string-to-char-list kinsoku-jis-bol)
+      do (modify-category-entry char ?s))
+(loop for char in (string-to-char-list kinsoku-jis-eol)
+      do (modify-category-entry char ?e))
+;; kinsoku-gb
+(loop for char in kinsoku-gb-bol
+      do (modify-category-entry char ?s))
+(loop for char in kinsoku-gb-eol
+      do (modify-category-entry char ?e))
+;; kinsoku-big5
+(loop for char in kinsoku-big5-bol
+      do (modify-category-entry char ?s))
+(loop for char in kinsoku-big5-eol
+      do (modify-category-entry char ?e))
+
+(defun kinsoku-bol-p ()
+  "Check if point would break forbidden beginning-of-line rules
+Uses category \'s\' to check.
+point\e$B$G2~9T$9$k$H9TF,6XB'$K?($l$k$+$I$&$+$r$+$($9!#\e(B
+\e$B9TF,6XB'J8;z$O\e(B\'s\'\e$B$N\e(Bcategory\e$B$G;XDj$9$k!#\e(B"
+  (let ((ch (char-after)))
+    (if (and ch
+            (or
+             (and kinsoku-ascii (char-in-category-p ch ?a))
+             (and kinsoku-jis (char-in-category-p ch ?j))
+             (and kinsoku-gb (char-in-category-p ch ?c))
+             (and kinsoku-big5 (char-in-category-p ch ?t))))
+       (char-in-category-p ch ?s)
+      nil)))
+
+(defun kinsoku-eol-p ()
+  "Check if point would break forbidden end-of-line rules
+Uses category \'e\' to check.
+point\e$B$G2~9T$9$k$H9TKv6XB'$K?($l$k$+$I$&$+$r$+$($9!#\e(B
+\e$B9TKv6XB'J8;z$O\e(B\'s\'\e$B$N\e(Bcategory\e$B$G;XDj$9$k!#\e(B"
+  (let ((ch (char-before)))
+    (if (and ch
+            (or
+             (and kinsoku-ascii (char-in-category-p ch ?a))
+             (and kinsoku-jis (char-in-category-p ch ?j))
+             (and kinsoku-gb (char-in-category-p ch ?c))
+             (and kinsoku-big5 (char-in-category-p ch ?t))))
+       (char-in-category-p ch ?e)
+      nil)))
+
+(defvar kinsoku-extend-limit nil
+  "Defines how many characters kinsoku will search forward before giving up.
+A value of nil equates to infinity.
+\e$B6XB'=hM}$G9T$r?-$P$7$FNI$$H>3QJ8;z?t$r;XDj$9$k!#\e(B
+\e$BHsIi@0?t0J30$N>l9g$OL58BBg$r0UL#$9$k!#\e(B")
+
+(defun kinsoku-process ()
+  "Move to a point that will not break forbidden line break rules.
+\e$B6XB'$K?($l$J$$E@$X0\F0$9$k!#\e(B
+point\e$B$,9TF,6XB'$K?($l$k>l9g$O9T$r?-$P$7$F!"6XB'$K?($l$J$$E@$rC5$9!#\e(B
+point\e$B$,9TKv6XB'$K?($l$k>l9g$O9T$r=L$a$F!"6XB'$K?($l$J$$E@$rC5$9!#\e(B
+\e$B$?$@$7!"9T?-$P$7H>3QJ8;z?t$,\e(Bkinsoku-extend-limit\e$B$r1[$($k$H!"\e(B
+\e$B9T$r=L$a$F6XB'$K?($l$J$$E@$rC5$9!#\e(B"
+  (let ((bol-kin nil) (eol-kin nil))
+    (if (and (not (bolp))
+            (not (eolp))
+            (or (setq bol-kin (kinsoku-bol-p))
+                (setq eol-kin (kinsoku-eol-p))))
+       (cond(bol-kin (kinsoku-process-extend))
+            (eol-kin (kinsoku-process-shrink))))))
+
+(defun kinsoku-process-extend ()
+  "Move point forward to a permissable for line-breaking.
+\e$B9T$r?-$P$7$F6XB'$K?($l$J$$E@$X0\F0$9$k!#\e(B"
+  (let ((max-column (+ fill-column 
+                      (if (and (numberp kinsoku-extend-limit)
+                               (>= kinsoku-extend-limit 0))
+                          kinsoku-extend-limit
+                        10000)))  ;;; 10000 is deliberatly unreasonably large
+       ch1 ch2)
+    (while (and (setq ch1 (char-after))
+               (<= (+ (current-column)
+                      (char-width ch1 ))
+                   max-column)
+               (not (bolp))
+               (not (eolp))
+               (or (kinsoku-eol-p)
+                   (kinsoku-bol-p)
+                   ;;; don't break in the middle of an English word
+                   (and (char-in-category-p ch1 ?a)
+                        (setq ch2 (char-before))
+                        (char-in-category-p ch2 ?a)
+                        (= ?w (char-syntax ch2))
+                        (= ?w (char-syntax ch1)))))
+      (forward-char))
+    (if (or (kinsoku-eol-p) (kinsoku-bol-p))
+       (kinsoku-process-shrink))))
+
+(defun kinsoku-process-shrink ()
+  "Move point backward to a point permissable for line-breaking.
+\e$B9T$r=L$a$F6XB'$K?($l$J$$E@$X0\F0$9$k!#\e(B"
+  (let (ch1 ch2)
+    (while (and (not (bolp))
+               (not (eolp))
+               (or (kinsoku-bol-p)
+                   (kinsoku-eol-p)
+               ;;; don't break in the middle of an English word
+                   (and
+                    (char-in-category-p (setq ch1 (following-char)) ?a)
+                    (char-in-category-p (setq ch2 (preceding-char)) ?a)
+                    (= ?w (char-syntax ch2))
+                    (= ?w (char-syntax ch1)))))
+      (backward-char))))
diff --git a/lisp/mule/korean.el b/lisp/mule/korean.el
new file mode 100644 (file)
index 0000000..2763262
--- /dev/null
@@ -0,0 +1,149 @@
+;;; korean.el --- Support for Korean
+
+;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
+;; Licensed to the Free Software Foundation.
+;; Copyright (C) 1997 MORIOKA Tomohiko
+
+;; Keywords: multilingual, Korean
+
+;; This file is part of XEmacs.
+
+;; XEmacs is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; XEmacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with XEmacs; see the file COPYING.  If not, write to the Free
+;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;; 02111-1307, USA.
+
+;;; Commentary:
+
+;; For Korean, the character set KSC5601 is supported.
+
+;;; Code:
+
+;; Syntax of Korean characters.
+(loop for row from 33 to  34 do
+      (modify-syntax-entry `[korean-ksc5601 ,row] "."))
+(loop for row from 35 to  37 do
+      (modify-syntax-entry `[korean-ksc5601 ,row] "w"))
+(loop for row from 38 to  41 do
+      (modify-syntax-entry `[korean-ksc5601 ,row] "."))
+(loop for row from 42 to 126 do
+      (modify-syntax-entry `[korean-ksc5601 ,row] "w"))
+
+;; Setting for coding-system and quail were moved to
+;; language/korean.el.
+
+(make-coding-system
+ 'iso-2022-int-1 'iso2022
+ "ISO-2022-INT-1"
+ '(charset-g0 ascii
+   charset-g1 korean-ksc5601
+   short t
+   seven t
+   lock-shift t
+   mnemonic "INT-1"))
+
+;; EGG specific setup
+(define-egg-environment 'korean
+  "Korean settings for egg"
+  (lambda ()
+    (when (not (featurep 'egg-kor))
+      (load "its-hangul")
+      (setq its:*standard-modes*
+           (cons (its:get-mode-map "hangul") its:*standard-modes*))
+      (provide 'egg-kor))
+    (setq wnn-server-type 'kserver)
+    (setq egg-default-startup-file "eggrc-wnn")
+    (setq-default its:*current-map* (its:get-mode-map "hangul"))))
+\f
+;; (make-coding-system
+;;  'euc-kr 2 ?K
+;;  "Coding-system of Korean EUC (Extended Unix Code)."
+;;  '((ascii t) korean-ksc5601 nil nil
+;;    nil ascii-eol ascii-cntl))
+
+(make-coding-system
+ 'euc-kr 'iso2022
+ "Coding-system of Korean EUC (Extended Unix Code)."
+ '(charset-g0 ascii
+   charset-g1 korean-ksc5601
+   mnemonic "ko/EUC"
+   eol-type nil))
+
+;;(define-coding-system-alias 'euc-kr 'euc-korea)
+
+(copy-coding-system 'euc-kr 'korean-euc)
+
+;; (make-coding-system
+;;  'iso-2022-kr 2 ?k
+;;  "MIME ISO-2022-KR"
+;;  '(ascii (nil korean-ksc5601) nil nil
+;;          nil ascii-eol ascii-cntl seven locking-shift nil nil nil nil nil
+;;          designation-bol))
+
+(make-coding-system
+ 'iso-2022-kr 'iso2022
+ "Coding-System used for communication with mail in Korea."
+ '(charset-g0 ascii
+   charset-g1 korean-ksc5601
+   force-g1-on-output t
+   seven t
+   lock-shift t
+   mnemonic "Ko/7bit"
+   eol-type lf))
+
+(defun setup-korean-environment ()
+  "Setup multilingual environment (MULE) for Korean."
+  (interactive)
+  (setup-english-environment)
+  ;; (setq coding-category-iso-8-2 'euc-kr)
+  (set-coding-category-system 'iso-8-2 'euc-kr)
+
+  ;; (set-coding-priority
+  ;;  '(coding-category-iso-7
+  ;;    coding-category-iso-8-2
+  ;;    coding-category-iso-8-1))
+  (set-coding-priority-list
+   '(iso-8-2
+     iso-7
+     iso-8-1
+     iso-8-designate
+     iso-lock-shift
+     no-conversion
+     shift-jis
+     big5))
+
+  (set-default-coding-systems 'euc-kr)
+
+  ;; (when (eq 'x (device-type (selected-device)))
+  ;;   (x-use-halfwidth-roman-font 'korean-ksc5601 "ksc5636"))
+
+  ;; EGG specific setup 97.02.05 jhod
+  (when (featurep 'egg)
+    (when (not (featurep 'egg-kor))
+      (provide 'egg-kor)
+      (load "its-hangul")
+      (setq its:*standard-modes*
+           (cons (its:get-mode-map "hangul") its:*standard-modes*)))
+    (setq-default its:*current-map* (its:get-mode-map "hangul")))
+
+  (setq default-input-method "korean-hangul"))
+
+(set-language-info-alist
+ "Korean" '((setup-function . setup-korean-environment)
+           (tutorial . "TUTORIAL.ko")
+           (charset . (korean-ksc5601))
+           (coding-system . (iso-2022-kr euc-kr))
+           (sample-text . "Hangul (\e$(CGQ1[\e(B)        \e$(C>H3gGO<<?d\e(B, \e$(C>H3gGO=J4O1n\e(B")
+           (documentation . t)))
+
+;;; korean.el ends here
diff --git a/lisp/mule/mule-ccl.el b/lisp/mule/mule-ccl.el
new file mode 100644 (file)
index 0000000..7f28d19
--- /dev/null
@@ -0,0 +1,1110 @@
+;;; ccl.el --- CCL (Code Conversion Language) compiler
+
+;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
+;; Licensed to the Free Software Foundation.
+
+;; Keywords: CCL, mule, multilingual, character set, coding-system
+
+;; This file is part of X Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;; Synched up with: FSF 20.2
+
+;;; Commentary:
+
+;; CCL (Code Conversion Language) is a simple programming language to
+;; be used for various kind of code conversion.  CCL program is
+;; compiled to CCL code (vector of integers) and executed by CCL
+;; interpreter of Emacs.
+;;
+;; CCL is used for code conversion at process I/O and file I/O for
+;; non-standard coding-system.  In addition, it is used for
+;; calculating a code point of X's font from a character code.
+;; However, since CCL is designed as a powerful programming language,
+;; it can be used for more generic calculation.  For instance,
+;; combination of three or more arithmetic operations can be
+;; calculated faster than Emacs Lisp.
+;;
+;; Here's the syntax of CCL program in BNF notation.
+;;
+;; CCL_PROGRAM :=
+;;     (BUFFER_MAGNIFICATION
+;;      CCL_MAIN_BLOCK
+;;      [ CCL_EOF_BLOCK ])
+;;
+;; BUFFER_MAGNIFICATION := integer
+;; CCL_MAIN_BLOCK := CCL_BLOCK
+;; CCL_EOF_BLOCK := CCL_BLOCK
+;;
+;; CCL_BLOCK :=
+;;     STATEMENT | (STATEMENT [STATEMENT ...])
+;; STATEMENT :=
+;;     SET | IF | BRANCH | LOOP | REPEAT | BREAK | READ | WRITE | CALL
+;;
+;; SET :=
+;;     (REG = EXPRESSION)
+;;     | (REG ASSIGNMENT_OPERATOR EXPRESSION)
+;;     | integer
+;;
+;; EXPRESSION := ARG | (EXPRESSION OPERATOR ARG)
+;;
+;; IF := (if EXPRESSION CCL_BLOCK CCL_BLOCK)
+;; BRANCH := (branch EXPRESSION CCL_BLOCK [CCL_BLOCK ...])
+;; LOOP := (loop STATEMENT [STATEMENT ...])
+;; BREAK := (break)
+;; REPEAT :=
+;;     (repeat)
+;;     | (write-repeat [REG | integer | string])
+;;     | (write-read-repeat REG [integer | ARRAY])
+;; READ :=
+;;     (read REG ...)
+;;     | (read-if (REG OPERATOR ARG) CCL_BLOCK CCL_BLOCK)
+;;     | (read-branch REG CCL_BLOCK [CCL_BLOCK ...])
+;; WRITE :=
+;;     (write REG ...)
+;;     | (write EXPRESSION)
+;;     | (write integer) | (write string) | (write REG ARRAY)
+;;     | string
+;; CALL := (call ccl-program-name)
+;; END := (end)
+;;
+;; REG := r0 | r1 | r2 | r3 | r4 | r5 | r6 | r7
+;; ARG := REG | integer
+;; OPERATOR :=
+;;     + | - | * | / | % | & | '|' | ^ | << | >> | <8 | >8 | //
+;;     | < | > | == | <= | >= | != | de-sjis | en-sjis
+;; ASSIGNMENT_OPERATOR :=
+;;     += | -= | *= | /= | %= | &= | '|=' | ^= | <<= | >>=
+;; ARRAY := '[' interger ... ']'
+
+;;; Code:
+
+(defconst ccl-command-table
+  [if branch loop break repeat write-repeat write-read-repeat
+      read read-if read-branch write call end]
+  "*Vector of CCL commands (symbols).")
+
+;; Put a property to each symbol of CCL commands for the compiler.
+(let (op (i 0) (len (length ccl-command-table)))
+  (while (< i len)
+    (setq op (aref ccl-command-table i))
+    (put op 'ccl-compile-function (intern (format "ccl-compile-%s" op)))
+    (setq i (1+ i))))
+
+(defconst ccl-code-table
+  [set-register
+   set-short-const
+   set-const
+   set-array
+   jump
+   jump-cond
+   write-register-jump
+   write-register-read-jump
+   write-const-jump
+   write-const-read-jump
+   write-string-jump
+   write-array-read-jump
+   read-jump
+   branch
+   read-register
+   write-expr-const
+   read-branch
+   write-register
+   write-expr-register
+   call
+   write-const-string
+   write-array
+   end
+   set-assign-expr-const
+   set-assign-expr-register
+   set-expr-const
+   set-expr-register
+   jump-cond-expr-const
+   jump-cond-expr-register
+   read-jump-cond-expr-const
+   read-jump-cond-expr-register
+   ]
+  "*Vector of CCL compiled codes (symbols).")
+
+;; Put a property to each symbol of CCL codes for the disassembler.
+(let (code (i 0) (len (length ccl-code-table)))
+  (while (< i len)
+    (setq code (aref ccl-code-table i))
+    (put code 'ccl-code i)
+    (put code 'ccl-dump-function (intern (format "ccl-dump-%s" code)))
+    (setq i (1+ i))))
+
+(defconst ccl-jump-code-list
+  '(jump jump-cond write-register-jump write-register-read-jump
+    write-const-jump write-const-read-jump write-string-jump
+    write-array-read-jump read-jump))
+
+;; Put a property `jump-flag' to each CCL code which execute jump in
+;; some way.
+(let ((l ccl-jump-code-list))
+  (while l
+    (put (car l) 'jump-flag t)
+    (setq l (cdr l))))
+
+(defconst ccl-register-table
+  [r0 r1 r2 r3 r4 r5 r6 r7]
+  "*Vector of CCL registers (symbols).")
+
+;; Put a property to indicate register number to each symbol of CCL.
+;; registers.
+(let (reg (i 0) (len (length ccl-register-table)))
+  (while (< i len)
+    (setq reg (aref ccl-register-table i))
+    (put reg 'ccl-register-number i)
+    (setq i (1+ i))))
+
+(defconst ccl-arith-table
+  [+ - * / % & | ^ << >> <8 >8 // nil nil nil
+   < > == <= >= != de-sjis en-sjis]
+  "*Vector of CCL arithmetic/logical operators (symbols).")
+
+;; Put a property to each symbol of CCL operators for the compiler.
+(let (arith (i 0) (len (length ccl-arith-table)))
+  (while (< i len)
+    (setq arith (aref ccl-arith-table i))
+    (if arith (put arith 'ccl-arith-code i))
+    (setq i (1+ i))))
+
+(defconst ccl-assign-arith-table
+  [+= -= *= /= %= &= |= ^= <<= >>= <8= >8= //=]
+  "*Vector of CCL assignment operators (symbols).")
+
+;; Put a property to each symbol of CCL assignment operators for the compiler.
+(let (arith (i 0) (len (length ccl-assign-arith-table)))
+  (while (< i len)
+    (setq arith (aref ccl-assign-arith-table i))
+    (put arith 'ccl-self-arith-code i)
+    (setq i (1+ i))))
+
+(defvar ccl-program-vector nil
+  "Working vector of CCL codes produced by CCL compiler.")
+(defvar ccl-current-ic 0
+  "The current index for `ccl-program-vector'.")
+
+;; Embed integer DATA in `ccl-program-vector' at `ccl-current-ic' and
+;; increment it.  If IC is specified, embed DATA at IC.
+(defun ccl-embed-data (data &optional ic)
+  (let ((val (if (characterp data) (char-int data) data)))
+    (if ic
+       (aset ccl-program-vector ic val)
+      (aset ccl-program-vector ccl-current-ic val)
+      (setq ccl-current-ic (1+ ccl-current-ic)))))
+
+;; Embed string STR of length LEN in `ccl-program-vector' at
+;; `ccl-current-ic'.
+(defun ccl-embed-string (len str)
+  (let ((i 0))
+    (while (< i len)
+      (ccl-embed-data (logior (ash (aref str i) 16)
+                              (if (< (1+ i) len)
+                                  (ash (aref str (1+ i)) 8)
+                                0)
+                              (if (< (+ i 2) len)
+                                  (aref str (+ i 2))
+                                0)))
+      (setq i (+ i 3)))))
+
+;; Embed a relative jump address to `ccl-current-ic' in
+;; `ccl-program-vector' at IC without altering the other bit field.
+(defun ccl-embed-current-address (ic)
+  (let ((relative (- ccl-current-ic (1+ ic))))
+    (aset ccl-program-vector ic
+         (logior (aref ccl-program-vector ic) (ash relative 8)))))
+
+;; Embed CCL code for the operation OP and arguments REG and DATA in
+;; `ccl-program-vector' at `ccl-current-ic' in the following format.
+;;     |----------------- integer (28-bit) ------------------|
+;;     |------------ 20-bit ------------|- 3-bit --|- 5-bit -|
+;;     |------------- DATA -------------|-- REG ---|-- OP ---|
+;; If REG2 is specified, embed a code in the following format.
+;;     |------- 17-bit ------|- 3-bit --|- 3-bit --|- 5-bit -|
+;;     |-------- DATA -------|-- REG2 --|-- REG ---|-- OP ---|
+
+;; If REG is a CCL register symbol (e.g. r0, r1...), the register
+;; number is embedded.  If OP is one of unconditional jumps, DATA is
+;; changed to an relative jump address.
+
+(defun ccl-embed-code (op reg data &optional reg2)
+  (if (and (> data 0) (get op 'jump-flag))
+      ;; DATA is an absolute jump address.  Make it relative to the
+      ;; next of jump code.
+      (setq data (- data (1+ ccl-current-ic))))
+  (let ((code (logior (get op 'ccl-code)
+                     (ash
+                      (if (symbolp reg) (get reg 'ccl-register-number) reg) 5)
+                     (if reg2
+                         (logior (ash (get reg2 'ccl-register-number) 8)
+                                 (ash data 11))
+                       (ash data 8)))))
+    (aset ccl-program-vector ccl-current-ic code)
+    (setq ccl-current-ic (1+ ccl-current-ic))))
+
+;; Just advance `ccl-current-ic' by INC.
+(defun ccl-increment-ic (inc)
+  (setq ccl-current-ic (+ ccl-current-ic inc)))
+
+;;;###autoload
+(defun ccl-program-p (obj)
+  "T if OBJECT is a valid CCL compiled code."
+  (and (vectorp obj)
+       (let ((i 0) (len (length obj)) (flag t))
+        (if (> len 1)
+            (progn
+              (while (and flag (< i len))
+                (setq flag (integerp (aref obj i)))
+                (setq i (1+ i)))
+              flag)))))
+
+;; If non-nil, index of the start of the current loop.
+(defvar ccl-loop-head nil)
+;; If non-nil, list of absolute addresses of the breaking points of
+;; the current loop.
+(defvar ccl-breaks nil)
+
+;;;###autoload
+(defun ccl-compile (ccl-program)
+  "Return a compiled code of CCL-PROGRAM as a vector of integer."
+  (if (or (null (consp ccl-program))
+         (null (integer-or-char-p (car ccl-program)))
+         (null (listp (car (cdr ccl-program)))))
+      (error "CCL: Invalid CCL program: %s" ccl-program))
+  (if (null (vectorp ccl-program-vector))
+      (setq ccl-program-vector (make-vector 8192 0)))
+  (setq ccl-loop-head nil ccl-breaks nil)
+  (setq ccl-current-ic 0)
+
+  ;; The first element is the buffer magnification.
+  (ccl-embed-data (car ccl-program))
+
+  ;; The second element is the address of the start CCL code for
+  ;; processing end of input buffer (we call it eof-processor).  We
+  ;; set it later.
+  (ccl-increment-ic 1)
+
+  ;; Compile the main body of the CCL program.
+  (ccl-compile-1 (car (cdr ccl-program)))
+
+  ;; Embed the address of eof-processor.
+  (ccl-embed-data ccl-current-ic 1)
+
+  ;; Then compile eof-processor.
+  (if (nth 2 ccl-program)
+      (ccl-compile-1 (nth 2 ccl-program)))
+
+  ;; At last, embed termination code.
+  (ccl-embed-code 'end 0 0)
+
+  (let ((vec (make-vector ccl-current-ic 0))
+       (i 0))
+    (while (< i ccl-current-ic)
+      (aset vec i (aref ccl-program-vector i))
+      (setq i (1+ i)))
+    vec))
+
+;; Signal syntax error.
+(defun ccl-syntax-error (cmd)
+  (error "CCL: Syntax error: %s" cmd))
+
+;; Check if ARG is a valid CCL register.
+(defun ccl-check-register (arg cmd)
+  (if (get arg 'ccl-register-number)
+      arg
+    (error "CCL: Invalid register %s in %s." arg cmd)))
+
+;; Check if ARG is a valid CCL command.
+(defun ccl-check-compile-function (arg cmd)
+  (or (get arg 'ccl-compile-function)
+      (error "CCL: Invalid command: %s" cmd)))
+
+;; In the following code, most ccl-compile-XXXX functions return t if
+;; they end with unconditional jump, else return nil.
+
+;; Compile CCL-BLOCK (see the syntax above).
+(defun ccl-compile-1 (ccl-block)
+  (let (unconditional-jump
+       cmd)
+    (if (or (integer-or-char-p ccl-block)
+           (stringp ccl-block)
+           (and ccl-block (symbolp (car ccl-block))))
+       ;; This block consists of single statement.
+       (setq ccl-block (list ccl-block)))
+
+    ;; Now CCL-BLOCK is a list of statements.  Compile them one by
+    ;; one.
+    (while ccl-block
+      (setq cmd (car ccl-block))
+      (setq unconditional-jump
+           (cond ((integer-or-char-p cmd)
+                  ;; SET statement for the register 0.
+                  (ccl-compile-set (list 'r0 '= cmd)))
+
+                 ((stringp cmd)
+                  ;; WRITE statement of string argument.
+                  (ccl-compile-write-string cmd))
+
+                 ((listp cmd)
+                  ;; The other statements.
+                  (cond ((eq (nth 1 cmd) '=)
+                         ;; SET statement of the form `(REG = EXPRESSION)'.
+                         (ccl-compile-set cmd))
+
+                        ((and (symbolp (nth 1 cmd))
+                              (get (nth 1 cmd) 'ccl-self-arith-code))
+                         ;; SET statement with an assignment operation.
+                         (ccl-compile-self-set cmd))
+
+                        (t
+                         (funcall (ccl-check-compile-function (car cmd) cmd)
+                                  cmd))))
+
+                 (t
+                  (ccl-syntax-error cmd))))
+      (setq ccl-block (cdr ccl-block)))
+    unconditional-jump))
+
+(defconst ccl-max-short-const (ash 1 19))
+(defconst ccl-min-short-const (ash -1 19))
+
+;; Compile SET statement.
+(defun ccl-compile-set (cmd)
+  (let ((rrr (ccl-check-register (car cmd) cmd))
+       (right (nth 2 cmd)))
+    (cond ((listp right)
+          ;; CMD has the form `(RRR = (XXX OP YYY))'.
+          (ccl-compile-expression rrr right))
+
+         ((integer-or-char-p right)
+          ;; CMD has the form `(RRR = integer)'.
+          (if (and (<= right ccl-max-short-const)
+                   (>= right ccl-min-short-const))
+              (ccl-embed-code 'set-short-const rrr right)
+            (ccl-embed-code 'set-const rrr 0)
+            (ccl-embed-data right)))
+
+         (t
+          ;; CMD has the form `(RRR = rrr [ array ])'.
+          (ccl-check-register right cmd)
+          (let ((ary (nth 3 cmd)))
+            (if (vectorp ary)
+                (let ((i 0) (len (length ary)))
+                  (ccl-embed-code 'set-array rrr len right)
+                  (while (< i len)
+                    (ccl-embed-data (aref ary i))
+                    (setq i (1+ i))))
+              (ccl-embed-code 'set-register rrr 0 right))))))
+  nil)
+
+;; Compile SET statement with ASSIGNMENT_OPERATOR.
+(defun ccl-compile-self-set (cmd)
+  (let ((rrr (ccl-check-register (car cmd) cmd))
+       (right (nth 2 cmd)))
+    (if (listp right)
+       ;; CMD has the form `(RRR ASSIGN_OP (XXX OP YYY))', compile
+       ;; the right hand part as `(r7 = (XXX OP YYY))' (note: the
+       ;; register 7 can be used for storing temporary value).
+       (progn
+         (ccl-compile-expression 'r7 right)
+         (setq right 'r7)))
+    ;; Now CMD has the form `(RRR ASSIGN_OP ARG)'.  Compile it as
+    ;; `(RRR = (RRR OP ARG))'.
+    (ccl-compile-expression
+     rrr
+     (list rrr (intern (substring (symbol-name (nth 1 cmd)) 0 -1)) right)))
+  nil)
+
+;; Compile SET statement of the form `(RRR = EXPR)'.
+(defun ccl-compile-expression (rrr expr)
+  (let ((left (car expr))
+       (op (get (nth 1 expr) 'ccl-arith-code))
+       (right (nth 2 expr)))
+    (if (listp left)
+       (progn
+         ;; EXPR has the form `((EXPR2 OP2 ARG) OP RIGHT)'.  Compile
+         ;; the first term as `(r7 = (EXPR2 OP2 ARG)).'
+         (ccl-compile-expression 'r7 left)
+         (setq left 'r7)))
+
+    ;; Now EXPR has the form (LEFT OP RIGHT).
+    (if (eq rrr left)
+       ;; Compile this SET statement as `(RRR OP= RIGHT)'.
+       (if (integer-or-char-p right)
+           (progn
+             (ccl-embed-code 'set-assign-expr-const rrr (ash op 3) 'r0)
+             (ccl-embed-data right))
+         (ccl-check-register right expr)
+         (ccl-embed-code 'set-assign-expr-register rrr (ash op 3) right))
+
+      ;; Compile this SET statement as `(RRR = (LEFT OP RIGHT))'.
+      (if (integer-or-char-p right)
+         (progn
+           (ccl-embed-code 'set-expr-const rrr (ash op 3) left)
+           (ccl-embed-data right))
+       (ccl-check-register right expr)
+       (ccl-embed-code 'set-expr-register
+                       rrr
+                       (logior (ash op 3) (get right 'ccl-register-number))
+                       left)))))
+
+;; Compile WRITE statement with string argument.
+(defun ccl-compile-write-string (str)
+  (let ((len (length str)))
+    (ccl-embed-code 'write-const-string 1 len)
+    (ccl-embed-string len str))
+  nil)
+
+;; Compile IF statement of the form `(if CONDITION TRUE-PART FALSE-PART)'.
+;; If READ-FLAG is non-nil, this statement has the form
+;; `(read-if (REG OPERATOR ARG) TRUE-PART FALSE-PART)'.
+(defun ccl-compile-if (cmd &optional read-flag)
+  (if (and (/= (length cmd) 3) (/= (length cmd) 4))
+      (error "CCL: Invalid number of arguments: %s" cmd))
+  (let ((condition (nth 1 cmd))
+       (true-cmds (nth 2 cmd))
+       (false-cmds (nth 3 cmd))
+       jump-cond-address
+       false-ic)
+    (if (and (listp condition)
+            (listp (car condition)))
+       ;; If CONDITION is a nested expression, the inner expression
+       ;; should be compiled at first as SET statement, i.e.:
+       ;; `(if ((X OP2 Y) OP Z) ...)' is compiled into two statements:
+       ;; `(r7 = (X OP2 Y)) (if (r7 OP Z) ...)'.
+       (progn
+         (ccl-compile-expression 'r7 (car condition))
+         (setq condition (cons 'r7 (cdr condition)))
+         (setq cmd (cons (car cmd)
+                         (cons condition (cdr (cdr cmd)))))))
+
+    (setq jump-cond-address ccl-current-ic)
+    ;; Compile CONDITION.
+    (if (symbolp condition)
+       ;; CONDITION is a register.
+       (progn
+         (ccl-check-register condition cmd)
+         (ccl-embed-code 'jump-cond condition 0))
+      ;; CONDITION is a simple expression of the form (RRR OP ARG).
+      (let ((rrr (car condition))
+           (op (get (nth 1 condition) 'ccl-arith-code))
+           (arg (nth 2 condition)))
+       (ccl-check-register rrr cmd)
+       (if (integer-or-char-p arg)
+           (progn
+             (ccl-embed-code (if read-flag 'read-jump-cond-expr-const
+                               'jump-cond-expr-const)
+                             rrr 0)
+             (ccl-embed-data op)
+             (ccl-embed-data arg))
+         (ccl-check-register arg cmd)
+         (ccl-embed-code (if read-flag 'read-jump-cond-expr-register 
+                           'jump-cond-expr-register)
+                         rrr 0)
+         (ccl-embed-data op)
+         (ccl-embed-data (get arg 'ccl-register-number)))))
+
+    ;; Compile TRUE-PART.
+    (let ((unconditional-jump (ccl-compile-1 true-cmds)))
+      (if (null false-cmds)
+         ;; This is the place to jump to if condition is false.
+         (ccl-embed-current-address jump-cond-address)
+       (let (end-true-part-address)
+         (if (not unconditional-jump)
+             (progn
+               ;; If TRUE-PART does not end with unconditional jump, we
+               ;; have to jump to the end of FALSE-PART from here.
+               (setq end-true-part-address ccl-current-ic)
+               (ccl-embed-code 'jump 0 0)))
+         ;; This is the place to jump to if CONDITION is false.
+         (ccl-embed-current-address jump-cond-address)
+         ;; Compile FALSE-PART.
+         (setq unconditional-jump
+               (and (ccl-compile-1 false-cmds) unconditional-jump))
+         (if end-true-part-address
+             ;; This is the place to jump to after the end of TRUE-PART.
+             (ccl-embed-current-address end-true-part-address))))
+      unconditional-jump)))
+
+;; Compile BRANCH statement.
+(defun ccl-compile-branch (cmd)
+  (if (< (length cmd) 3)
+      (error "CCL: Invalid number of arguments: %s" cmd))
+  (ccl-compile-branch-blocks 'branch
+                            (ccl-compile-branch-expression (nth 1 cmd) cmd)
+                            (cdr (cdr cmd))))
+
+;; Compile READ statement of the form `(read-branch EXPR BLOCK0 BLOCK1 ...)'.
+(defun ccl-compile-read-branch (cmd)
+  (if (< (length cmd) 3)
+      (error "CCL: Invalid number of arguments: %s" cmd))
+  (ccl-compile-branch-blocks 'read-branch
+                            (ccl-compile-branch-expression (nth 1 cmd) cmd)
+                            (cdr (cdr cmd))))
+
+;; Compile EXPRESSION part of BRANCH statement and return register
+;; which holds a value of the expression.
+(defun ccl-compile-branch-expression (expr cmd)
+  (if (listp expr)
+      ;; EXPR has the form `(EXPR2 OP ARG)'.  Compile it as SET
+      ;; statement of the form `(r7 = (EXPR2 OP ARG))'.
+      (progn
+       (ccl-compile-expression 'r7 expr)
+       'r7)
+    (ccl-check-register expr cmd)))
+
+;; Compile BLOCKs of BRANCH statement.  CODE is 'branch or 'read-branch.
+;; REG is a register which holds a value of EXPRESSION part.  BLOCKs
+;; is a list of CCL-BLOCKs.
+(defun ccl-compile-branch-blocks (code rrr blocks)
+  (let ((branches (length blocks))
+       branch-idx
+       jump-table-head-address
+       empty-block-indexes
+       block-tail-addresses
+       block-unconditional-jump)
+    (ccl-embed-code code rrr branches)
+    (setq jump-table-head-address ccl-current-ic)
+    ;; The size of jump table is the number of blocks plus 1 (for the
+    ;; case RRR is out of range).
+    (ccl-increment-ic (1+ branches))
+    (setq empty-block-indexes (list branches))
+    ;; Compile each block.
+    (setq branch-idx 0)
+    (while blocks
+      (if (null (car blocks))
+         ;; This block is empty.
+         (setq empty-block-indexes (cons branch-idx empty-block-indexes)
+               block-unconditional-jump t)
+       ;; This block is not empty.
+       (ccl-embed-data (- ccl-current-ic jump-table-head-address)
+                       (+ jump-table-head-address branch-idx))
+       (setq block-unconditional-jump (ccl-compile-1 (car blocks)))
+       (if (not block-unconditional-jump)
+           (progn
+             ;; Jump address of the end of branches are embedded later.
+             ;; For the moment, just remember where to embed them.
+             (setq block-tail-addresses
+                   (cons ccl-current-ic block-tail-addresses))
+             (ccl-embed-code 'jump 0 0))))
+      (setq branch-idx (1+ branch-idx))
+      (setq blocks (cdr blocks)))
+    (if (not block-unconditional-jump)
+       ;; We don't need jump code at the end of the last block.
+       (setq block-tail-addresses (cdr block-tail-addresses)
+             ccl-current-ic (1- ccl-current-ic)))
+    ;; Embed jump address at the tailing jump commands of blocks.
+    (while block-tail-addresses
+      (ccl-embed-current-address (car block-tail-addresses))
+      (setq block-tail-addresses (cdr block-tail-addresses)))
+    ;; For empty blocks, make entries in the jump table point directly here.
+    (while empty-block-indexes
+      (ccl-embed-data (- ccl-current-ic jump-table-head-address)
+                     (+ jump-table-head-address (car empty-block-indexes)))
+      (setq empty-block-indexes (cdr empty-block-indexes))))
+  ;; Branch command ends by unconditional jump if RRR is out of range.
+  nil)
+
+;; Compile LOOP statement.
+(defun ccl-compile-loop (cmd)
+  (if (< (length cmd) 2)
+      (error "CCL: Invalid number of arguments: %s" cmd))
+  (let* ((ccl-loop-head ccl-current-ic)
+        (ccl-breaks nil)
+        unconditional-jump)
+    (setq cmd (cdr cmd))
+    (if cmd
+       (progn
+         (setq unconditional-jump t)
+         (while cmd
+           (setq unconditional-jump
+                 (and (ccl-compile-1 (car cmd)) unconditional-jump))
+           (setq cmd (cdr cmd)))
+         (if (not ccl-breaks)
+             unconditional-jump
+           ;; Embed jump address for break statements encountered in
+           ;; this loop.
+           (while ccl-breaks
+             (ccl-embed-current-address (car ccl-breaks))
+             (setq ccl-breaks (cdr ccl-breaks))))
+         nil))))
+
+;; Compile BREAK statement.
+(defun ccl-compile-break (cmd)
+  (if (/= (length cmd) 1)
+      (error "CCL: Invalid number of arguments: %s" cmd))
+  (if (null ccl-loop-head)
+      (error "CCL: No outer loop: %s" cmd))
+  (setq ccl-breaks (cons ccl-current-ic ccl-breaks))
+  (ccl-embed-code 'jump 0 0)
+  t)
+
+;; Compile REPEAT statement.
+(defun ccl-compile-repeat (cmd)
+  (if (/= (length cmd) 1)
+      (error "CCL: Invalid number of arguments: %s" cmd))
+  (if (null ccl-loop-head)
+      (error "CCL: No outer loop: %s" cmd))
+  (ccl-embed-code 'jump 0 ccl-loop-head)
+  t)
+
+;; Compile WRITE-REPEAT statement.
+(defun ccl-compile-write-repeat (cmd)
+  (if (/= (length cmd) 2)
+      (error "CCL: Invalid number of arguments: %s" cmd))
+  (if (null ccl-loop-head)
+      (error "CCL: No outer loop: %s" cmd))
+  (let ((arg (nth 1 cmd)))
+    (cond ((integer-or-char-p arg)
+          (ccl-embed-code 'write-const-jump 0 ccl-loop-head)
+          (ccl-embed-data arg))
+         ((stringp arg)
+          (let ((len (length arg))
+                (i 0))
+            (ccl-embed-code 'write-string-jump 0 ccl-loop-head)
+            (ccl-embed-data len)
+            (ccl-embed-string len arg)))
+         (t
+          (ccl-check-register arg cmd)
+          (ccl-embed-code 'write-register-jump arg ccl-loop-head))))
+  t)
+
+;; Compile WRITE-READ-REPEAT statement.
+(defun ccl-compile-write-read-repeat (cmd)
+  (if (or (< (length cmd) 2) (> (length cmd) 3))
+      (error "CCL: Invalid number of arguments: %s" cmd))
+  (if (null ccl-loop-head)
+      (error "CCL: No outer loop: %s" cmd))
+  (let ((rrr (ccl-check-register (nth 1 cmd) cmd))
+       (arg (nth 2 cmd)))
+    (cond ((null arg)
+          (ccl-embed-code 'write-register-read-jump rrr ccl-loop-head))
+         ((integer-or-char-p arg)
+          (ccl-embed-code 'write-const-read-jump rrr arg ccl-loop-head))
+         ((vectorp arg)
+          (let ((len (length arg))
+                (i 0))
+            (ccl-embed-code 'write-array-read-jump rrr ccl-loop-head)
+            (ccl-embed-data len)
+            (while (< i len)
+              (ccl-embed-data (aref arg i))
+              (setq i (1+ i)))))
+         (t
+          (error "CCL: Invalid argument %s: %s" arg cmd)))
+    (ccl-embed-code 'read-jump rrr ccl-loop-head))
+  t)
+                           
+;; Compile READ statement.
+(defun ccl-compile-read (cmd)
+  (if (< (length cmd) 2)
+      (error "CCL: Invalid number of arguments: %s" cmd))
+  (let* ((args (cdr cmd))
+        (i (1- (length args))))
+    (while args
+      (let ((rrr (ccl-check-register (car args) cmd)))
+       (ccl-embed-code 'read-register rrr i)
+       (setq args (cdr args) i (1- i)))))
+  nil)
+
+;; Compile READ-IF statement.
+(defun ccl-compile-read-if (cmd)
+  (ccl-compile-if cmd 'read))
+
+;; Compile WRITE statement.
+(defun ccl-compile-write (cmd)
+  (if (< (length cmd) 2)
+      (error "CCL: Invalid number of arguments: %s" cmd))
+  (let ((rrr (nth 1 cmd)))
+    (cond ((integer-or-char-p rrr)
+          (ccl-embed-code 'write-const-string 0 rrr))
+         ((stringp rrr)
+          (ccl-compile-write-string rrr))
+         ((and (symbolp rrr) (vectorp (nth 2 cmd)))
+          (ccl-check-register rrr cmd)
+          ;; CMD has the form `(write REG ARRAY)'.
+          (let* ((arg (nth 2 cmd))
+                 (len (length arg))
+                 (i 0))
+            (ccl-embed-code 'write-array rrr len)
+            (while (< i len)
+              (if (not (integer-or-char-p (aref arg i)))
+                  (error "CCL: Invalid argument %s: %s" arg cmd))
+              (ccl-embed-data (aref arg i))
+              (setq i (1+ i)))))
+
+         ((symbolp rrr)
+          ;; CMD has the form `(write REG ...)'.
+          (let* ((args (cdr cmd))
+                 (i (1- (length args))))
+            (while args
+              (setq rrr (ccl-check-register (car args) cmd))
+              (ccl-embed-code 'write-register rrr i)
+              (setq args (cdr args) i (1- i)))))
+
+         ((listp rrr)
+          ;; CMD has the form `(write (LEFT OP RIGHT))'.
+          (let ((left (car rrr))
+                (op (get (nth 1 rrr) 'ccl-arith-code))
+                (right (nth 2 rrr)))
+            (if (listp left)
+                (progn
+                  ;; RRR has the form `((EXPR OP2 ARG) OP RIGHT)'.
+                  ;; Compile the first term as `(r7 = (EXPR OP2 ARG))'.
+                  (ccl-compile-expression 'r7 left)
+                  (setq left 'r7)))
+            ;; Now RRR has the form `(ARG OP RIGHT)'.
+            (if (integer-or-char-p right)
+                (progn
+                  (ccl-embed-code 'write-expr-const 0 (ash op 3) left)
+                  (ccl-embed-data right))
+              (ccl-check-register right rrr)
+              (ccl-embed-code 'write-expr-register 0
+                              (logior (ash op 3)
+                                      (get right 'ccl-register-number))))))
+
+         (t
+          (error "CCL: Invalid argument: %s" cmd))))
+  nil)
+
+;; Compile CALL statement.
+(defun ccl-compile-call (cmd)
+  (if (/= (length cmd) 2)
+      (error "CCL: Invalid number of arguments: %s" cmd))
+  (if (not (symbolp (nth 1 cmd)))
+      (error "CCL: Subroutine should be a symbol: %s" cmd))
+  (let* ((name (nth 1 cmd))
+        (idx (get name 'ccl-program-idx)))
+    (if (not idx)
+       (error "CCL: Unknown subroutine name: %s" name))
+    (ccl-embed-code 'call 0 idx))
+  nil)
+
+;; Compile END statement.
+(defun ccl-compile-end (cmd)
+  (if (/= (length cmd) 1)
+      (error "CCL: Invalid number of arguments: %s" cmd))
+  (ccl-embed-code 'end 0 0)
+  t)
+
+;;; CCL dump staffs
+
+;; To avoid byte-compiler warning.
+(defvar ccl-code)
+
+;;;###autoload
+(defun ccl-dump (ccl-code)
+  "Disassemble compiled CCL-CODE."
+  (let ((len (length ccl-code))
+       (buffer-mag (aref ccl-code 0)))
+    (cond ((= buffer-mag 0)
+          (insert "Don't output anything.\n"))
+         ((= buffer-mag 1)
+          (insert "Out-buffer must be as large as in-buffer.\n"))
+         (t
+          (insert
+           (format "Out-buffer must be %d times bigger than in-buffer.\n"
+                   buffer-mag))))
+    (insert "Main-body:\n")
+    (setq ccl-current-ic 2)
+    (if (> (aref ccl-code 1) 0)
+       (progn
+         (while (< ccl-current-ic (aref ccl-code 1))
+           (ccl-dump-1))
+         (insert "At EOF:\n")))
+    (while (< ccl-current-ic len)
+      (ccl-dump-1))
+    ))
+
+;; Return a CCL code in `ccl-code' at `ccl-current-ic'.
+(defun ccl-get-next-code ()
+  (prog1
+      (aref ccl-code ccl-current-ic)
+    (setq ccl-current-ic (1+ ccl-current-ic))))
+
+(defun ccl-dump-1 ()
+  (let* ((code (ccl-get-next-code))
+        (cmd (aref ccl-code-table (logand code 31)))
+        (rrr (ash (logand code 255) -5))
+        (cc (ash code -8)))
+    (insert (format "%5d:[%s] " (1- ccl-current-ic) cmd))
+    (funcall (get cmd 'ccl-dump-function) rrr cc))) 
+
+(defun ccl-dump-set-register (rrr cc)
+  (insert (format "r%d = r%d\n" rrr cc)))
+
+(defun ccl-dump-set-short-const (rrr cc)
+  (insert (format "r%d = %d\n" rrr cc)))
+
+(defun ccl-dump-set-const (rrr ignore)
+  (insert (format "r%d = %d\n" rrr (ccl-get-next-code))))
+
+(defun ccl-dump-set-array (rrr cc)
+  (let ((rrr2 (logand cc 7))
+       (len (ash cc -3))
+       (i 0))
+    (insert (format "r%d = array[r%d] of length %d\n\t"
+                   rrr rrr2 len))
+    (while (< i len)
+      (insert (format "%d " (ccl-get-next-code)))
+      (setq i (1+ i)))
+    (insert "\n")))
+
+(defun ccl-dump-jump (ignore cc &optional address)
+  (insert (format "jump to %d(" (+ (or address ccl-current-ic) cc)))
+  (if (>= cc 0)
+      (insert "+"))
+  (insert (format "%d)\n" (1+ cc))))
+
+(defun ccl-dump-jump-cond (rrr cc)
+  (insert (format "if (r%d == 0), " rrr))
+  (ccl-dump-jump nil cc))
+
+(defun ccl-dump-write-register-jump (rrr cc)
+  (insert (format "write r%d, " rrr))
+  (ccl-dump-jump nil cc))
+
+(defun ccl-dump-write-register-read-jump (rrr cc)
+  (insert (format "write r%d, read r%d, " rrr rrr))
+  (ccl-dump-jump nil cc)
+  (ccl-get-next-code)                  ; Skip dummy READ-JUMP
+  )
+
+(defun ccl-extract-arith-op (cc)
+  (aref ccl-arith-table (ash cc -6)))
+
+(defun ccl-dump-write-expr-const (ignore cc)
+  (insert (format "write (r%d %s %d)\n"
+                 (logand cc 7)
+                 (ccl-extract-arith-op cc)
+                 (ccl-get-next-code))))
+
+(defun ccl-dump-write-expr-register (ignore cc)
+  (insert (format "write (r%d %s r%d)\n"
+                 (logand cc 7)
+                 (ccl-extract-arith-op cc)
+                 (logand (ash cc -3) 7))))
+
+(defun ccl-dump-insert-char (cc)
+  (cond ((= cc ?\t) (insert " \"^I\""))
+       ((= cc ?\n) (insert " \"^J\""))
+       (t (insert (format " \"%c\"" cc)))))
+
+(defun ccl-dump-write-const-jump (ignore cc)
+  (let ((address ccl-current-ic))
+    (insert "write char")
+    (ccl-dump-insert-char (ccl-get-next-code))
+    (insert ", ")
+    (ccl-dump-jump nil cc address)))
+
+(defun ccl-dump-write-const-read-jump (rrr cc)
+  (let ((address ccl-current-ic))
+    (insert "write char")
+    (ccl-dump-insert-char (ccl-get-next-code))
+    (insert (format ", read r%d, " rrr))
+    (ccl-dump-jump cc address)
+    (ccl-get-next-code)                        ; Skip dummy READ-JUMP
+    ))
+
+(defun ccl-dump-write-string-jump (ignore cc)
+  (let ((address ccl-current-ic)
+       (len (ccl-get-next-code))
+       (i 0))
+    (insert "write \"")
+    (while (< i len)
+      (let ((code (ccl-get-next-code)))
+       (insert (ash code -16))
+       (if (< (1+ i) len) (insert (logand (ash code -8) 255)))
+       (if (< (+ i 2) len) (insert (logand code 255))))
+      (setq i (+ i 3)))
+    (insert "\", ")
+    (ccl-dump-jump nil cc address)))
+
+(defun ccl-dump-write-array-read-jump (rrr cc)
+  (let ((address ccl-current-ic)
+       (len (ccl-get-next-code))
+       (i 0))
+    (insert (format "write array[r%d] of length %d,\n\t" rrr len))
+    (while (< i len)
+      (ccl-dump-insert-char (ccl-get-next-code))
+      (setq i (1+ i)))
+    (insert (format "\n\tthen read r%d, " rrr))
+    (ccl-dump-jump nil cc address)
+    (ccl-get-next-code)                        ; Skip dummy READ-JUMP.
+    ))
+
+(defun ccl-dump-read-jump (rrr cc)
+  (insert (format "read r%d, " rrr))
+  (ccl-dump-jump nil cc))
+
+(defun ccl-dump-branch (rrr len)
+  (let ((jump-table-head ccl-current-ic)
+       (i 0))
+    (insert (format "jump to array[r%d] of length %d\n\t" rrr len))
+    (while (<= i len)
+      (insert (format "%d " (+ jump-table-head (ccl-get-next-code))))
+      (setq i (1+ i)))
+    (insert "\n")))
+
+(defun ccl-dump-read-register (rrr cc)
+  (insert (format "read r%d (%d remaining)\n" rrr cc)))
+
+(defun ccl-dump-read-branch (rrr len)
+  (insert (format "read r%d, " rrr))
+  (ccl-dump-branch rrr len))
+
+(defun ccl-dump-write-register (rrr cc)
+  (insert (format "write r%d (%d remaining)\n" rrr cc)))
+
+(defun ccl-dump-call (ignore cc)
+  (insert (format "call subroutine #%d\n" cc)))
+
+(defun ccl-dump-write-const-string (rrr cc)
+  (if (= rrr 0)
+      (progn
+       (insert "write char")
+       (ccl-dump-insert-char cc)
+       (newline))
+    (let ((len cc)
+         (i 0))
+      (insert "write \"")
+      (while (< i len)
+       (let ((code (ccl-get-next-code)))
+         (insert (format "%c" (lsh code -16)))
+         (if (< (1+ i) len)
+             (insert (format "%c" (logand (lsh code -8) 255))))
+         (if (< (+ i 2) len)
+             (insert (format "%c" (logand code 255))))
+         (setq i (+ i 3))))
+      (insert "\"\n"))))
+
+(defun ccl-dump-write-array (rrr cc)
+  (let ((i 0))
+    (insert (format "write array[r%d] of length %d\n\t" rrr cc))
+    (while (< i cc)
+      (ccl-dump-insert-char (ccl-get-next-code))
+      (setq i (1+ i)))
+    (insert "\n")))
+
+(defun ccl-dump-end (&rest ignore)
+  (insert "end\n"))
+
+(defun ccl-dump-set-assign-expr-const (rrr cc)
+  (insert (format "r%d %s= %d\n"
+                 rrr
+                 (ccl-extract-arith-op cc)
+                 (ccl-get-next-code))))
+
+(defun ccl-dump-set-assign-expr-register (rrr cc)
+  (insert (format "r%d %s= r%d\n"
+                 rrr
+                 (ccl-extract-arith-op cc)
+                 (logand cc 7))))
+
+(defun ccl-dump-set-expr-const (rrr cc)
+  (insert (format "r%d = r%d %s %d\n"
+                 rrr
+                 (logand cc 7)
+                 (ccl-extract-arith-op cc)
+                 (ccl-get-next-code))))
+
+(defun ccl-dump-set-expr-register (rrr cc)
+  (insert (format "r%d = r%d %s r%d\n"
+                 rrr
+                 (logand cc 7)
+                 (ccl-extract-arith-op cc)
+                 (logand (ash cc -3) 7))))
+
+(defun ccl-dump-jump-cond-expr-const (rrr cc)
+  (let ((address ccl-current-ic))
+    (insert (format "if !(r%d %s %d), "
+                   rrr
+                   (aref ccl-arith-table (ccl-get-next-code))
+                   (ccl-get-next-code)))
+    (ccl-dump-jump nil cc address)))
+
+(defun ccl-dump-jump-cond-expr-register (rrr cc)
+  (let ((address ccl-current-ic))
+    (insert (format "if !(r%d %s r%d), "
+                   rrr
+                   (aref ccl-arith-table (ccl-get-next-code))
+                   (ccl-get-next-code)))
+    (ccl-dump-jump nil cc address)))
+
+(defun ccl-dump-read-jump-cond-expr-const (rrr cc)
+  (insert (format "read r%d, " rrr))
+  (ccl-dump-jump-cond-expr-const rrr cc))
+
+(defun ccl-dump-read-jump-cond-expr-register (rrr cc)
+  (insert (format "read r%d, " rrr))
+  (ccl-dump-jump-cond-expr-register rrr cc))
+
+(defun ccl-dump-binary (ccl-code)
+  (let ((len (length ccl-code))
+       (i 2))
+    (while (< i len)
+      (let ((code (aref ccl-code i))
+           (j 27))
+       (while (>= j 0)
+         (insert (if (= (logand code (ash 1 j)) 0) ?0 ?1))
+         (setq j (1- j)))
+       (setq code (logand code 31))
+       (if (< code (length ccl-code-table))
+           (insert (format ":%s" (aref ccl-code-table code))))
+       (insert "\n"))
+      (setq i (1+ i)))))
+
+;; CCL emulation staffs 
+
+;; Not yet implemented.
+\f
+;;;###autoload
+(defmacro declare-ccl-program (name)
+  "Declare NAME as a name of CCL program.
+
+To compile a CCL program which calls another CCL program not yet
+defined, it must be declared as a CCL program in advance."
+  `(put ',name 'ccl-program-idx (register-ccl-program ',name nil)))
+
+;;;###autoload
+(defmacro define-ccl-program (name ccl-program &optional doc)
+  "Set NAME the compiled code of CCL-PROGRAM.
+CCL-PROGRAM is `eval'ed before being handed to the CCL compiler `ccl-compile'.
+The compiled code is a vector of integers."
+  `(let ((prog ,(ccl-compile (eval ccl-program))))
+     (defconst ,name prog ,doc)
+     (put ',name 'ccl-program-idx (register-ccl-program ',name prog))
+     nil))
+
+;;;###autoload
+(defun ccl-execute-with-args (ccl-prog &rest args)
+  "Execute CCL-PROGRAM with registers initialized by the remaining args.
+The return value is a vector of resulting CCL registeres."
+  (let ((reg (make-vector 8 0))
+       (i 0))
+    (while (and args (< i 8))
+      (if (not (integerp (car args)))
+         (error "Arguments should be integer"))
+      (aset reg i (car args))
+      (setq args (cdr args) i (1+ i)))
+    (ccl-execute ccl-prog reg)
+    reg))
+
+(provide 'ccl)
+
+;; ccl.el ends here
diff --git a/lisp/mule/mule-help.el b/lisp/mule/mule-help.el
new file mode 100644 (file)
index 0000000..0a330cd
--- /dev/null
@@ -0,0 +1,86 @@
+;;; mule-help.el --- Mule-ized Help functions 
+
+;; Copyright (C) 1997 by Free Software Foundation, Inc.
+
+;; Author: SL Baur <steve@altair.xemacs.org>
+;; Keywords: help, internal
+
+;; This file is part of XEmacs.
+
+;; XEmacs is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; XEmacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with XEmacs; see the file COPYING.  If not, write to the Free
+;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;; 02111-1307, USA.
+
+;;; Synched up with: Emacs 20.1
+
+;;; Commentary:
+
+;; 
+
+;;; Code:
+
+;; TUTORIAL arg is XEmacs addition
+(defun help-with-tutorial (&optional arg tutorial)
+  "Select the XEmacs learn-by-doing tutorial.
+If there is a tutorial version written in the language
+of the selected language environment, that version is used.
+If there's no tutorial in that language, `TUTORIAL' is selected.
+With arg, you are asked to select which language."
+  (interactive "P")
+  (let (lang filename file)
+    (if arg
+       (or (setq lang (read-language-name 'tutorial "Language: "))
+           (error "No tutorial file of the specified language"))
+      (setq lang current-language-environment))
+    ;; The menubar buttons call this function like this:
+    ;; (help-with-tutorial nil "tutorial.lang")
+    (setq filename (if (and (not arg) tutorial)
+                      tutorial
+                    (or (get-language-info lang 'tutorial)
+                        (or tutorial "TUTORIAL"))))
+    (setq file (expand-file-name (concat "~/" filename)))
+    (delete-other-windows)
+    (if (get-file-buffer file)
+       (switch-to-buffer (get-file-buffer file))
+      (switch-to-buffer (create-file-buffer file))
+      (setq buffer-file-name file)
+      (setq default-directory (expand-file-name "~/"))
+      (setq buffer-auto-save-file-name nil)
+      (insert-file-contents (locate-data-file filename))
+      (goto-char (point-min))
+      ;; The 'didactic' blank lines: Possibly insert blank lines
+      ;; around <<nya nya nya>>, and change << >> to [ ].
+      (if (re-search-forward "^<<.+>>" nil t)
+         (let ((n (- (window-height (selected-window))
+                     (count-lines (point-min) (point-at-bol))
+                     6)))
+           (if (< n 12)
+               (progn (beginning-of-line) (kill-line))
+             ;; Some people get confused by the large gap
+             (delete-backward-char 2)
+             (insert "]")
+             (beginning-of-line)
+             (save-excursion
+               (delete-char 2)
+               (insert "["))
+             (newline (/ n 2))
+             (next-line 1)
+             (newline (- n (/ n 2))))))
+      (goto-char (point-min))
+      (set-buffer-modified-p nil))))
+
+
+(provide 'mule-help)
+
+;;; mule-help.el ends here
\ No newline at end of file
diff --git a/lisp/mule/mule-init.el b/lisp/mule/mule-init.el
new file mode 100644 (file)
index 0000000..baf9c57
--- /dev/null
@@ -0,0 +1,132 @@
+;; Mule default configuration file
+
+;; This file is part of XEmacs.
+
+;; XEmacs is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; XEmacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with XEmacs; see the file COPYING.  If not, write to the 
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; 87.6.9   created by K.handa
+;;; (Note: following comment obsolete -- mrb)
+
+;;; IMPORTANT NOTICE -- DON'T EDIT THIS FILE!!!
+;;;  Keep this file unmodified for further patches being applied successfully.
+;;;  All language specific basic environments are defined here.
+;;;  By default, Japanese is set as the primary environment.
+;;;  You can change primary environment in `./lisp/site-init.el by
+;;;  `set-primary-environment'.  For instance,
+;;;    (set-primary-environment 'chinese)
+;;;  makes Chinese the primary environment.
+;;;  If you are still not satisfied with the settings, you can
+;;;  override them after the above line.  For instance,
+;;;    (set-default-buffer-file-coding-system 'big5)
+;;;  makes big5 be used for file I/O by default.
+;;;  If you are not satisfied with other default settings in this file,
+;;;  override any of them also in `./lisp/site-init.el'.  For instance,
+;;;    (define-program-coding-system nil ".*mail.*" 'iso-8859-1)
+;;;  makes the coding-system 'iso-8859-1 be used in mail.
+
+
+;;;; GLOBAL ENVIRONMENT SETUP
+(require 'cl)
+
+\f
+;; (setq language-environment-list
+;;       (sort (language-environment-list) 'string-lessp))
+
+;; MULE keymap codes were moved to mule-cmds.el.
+
+;; Alternative key definitions
+;; Original mapping will be altered by set-keyboard-coding-system.
+(define-key global-map [(meta \#)] 'ispell-word)       ;originally "$"
+;; (define-key global-map [(meta {)] 'insert-parentheses) ;originally "("
+
+;; Following line isn't mule-specific --mrb
+;;(setq-default modeline-buffer-identification '("XEmacs: %17b"))
+
+;; MULE keymap codes were moved to mule-cmds.el.
+
+;; (define-key help-map "T" 'help-with-tutorial-for-mule)
+
+;; (defvar help-with-tutorial-language-alist
+;;  '(("Japanese" . ".jp")
+;;    ("Korean"   . ".kr")
+;;    ("Thai"     . ".th")))
+
+;(defun help-with-tutorial-for-mule (language)
+;  "Select the Mule learn-by-doing tutorial."
+;  (interactive (list (let ((completion-ignore-case t)
+;                         lang)
+;                     (completing-read
+;                      "Language: "
+;                      help-with-tutorial-language-alist))))
+;  (setq language (cdr (assoc language help-with-tutorial-language-alist)))
+;  (help-with-tutorial (concat "mule/TUTORIAL" (or language ""))))
+
+(defvar auto-language-alist
+  '(("^ja" . "Japanese")
+    ("^zh" . "Chinese")
+    ("^ko" . "Korean"))
+  "Alist of LANG patterns vs. corresponding language environment.
+Each element looks like (REGEXP . LANGUAGE-ENVIRONMENT).
+It the value of the environment variable LANG matches the regexp REGEXP,
+then `set-language-environment' is called with LANGUAGE-ENVIRONMENT.")
+
+(defun init-mule ()
+  "Initialize MULE environment at startup.  Don't call this."
+  (let ((lang (or (getenv "LC_ALL") (getenv "LC_MESSAGES") (getenv "LANG"))))
+    (unless (or (null lang) (string-equal "C" lang))
+      (let ((case-fold-search t))
+       (loop for elt in auto-language-alist
+             if (string-match (car elt) lang)
+             return (progn
+                      (setq lang (substring lang 0 (match-end 0)))
+                      (set-language-environment (cdr elt))
+                      )))
+      ;; Load a (localizable) locale-specific init file, if it exists.
+      (load (format "%s%s/locale-start"
+                   (locate-data-directory "start-files")
+                   lang) t t)))
+  
+  (when current-language-environment
+    ;; Translate remaining args on command line using file-name-coding-system
+    (loop for arg in-ref command-line-args-left do
+         (setf arg (decode-coding-string arg file-name-coding-system)))
+    
+    ;; rman seems to be incompatible with encoded text
+    (setq Manual-use-rosetta-man nil)
+
+    ;; Make sure ls -l output is readable by dired and encoded using
+    ;; file-name-coding-system
+    (add-hook
+     'dired-mode-hook
+     (lambda ()
+       (make-local-variable 'process-environment)
+       (setenv "LC_MESSAGES" "C")
+       (setenv "LC_TIME"     "C"))))
+  
+  ;; Register avairable input methods by loading LEIM list file.
+  (load "leim-list.el" 'noerror 'nomessage 'nosuffix)
+  )
+
+(add-hook 'before-init-hook 'init-mule)
+
+;;;;; Enable the tm package by default
+;;(defun init-mule-tm ()
+;;  "Load MIME (TM) support for GNUS, VM, MH-E, and RMAIL."
+;;  (load "mime-setup"))
+
+;;(add-hook 'after-init-hook 'init-mule-tm)
+
+;;; mule-init.el ends here
diff --git a/lisp/mule/mule-misc.el b/lisp/mule/mule-misc.el
new file mode 100644 (file)
index 0000000..3488781
--- /dev/null
@@ -0,0 +1,295 @@
+;; mule-misc.el --- Miscellaneous Mule functions.
+
+;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
+;; Licensed to the Free Software Foundation.
+;; Copyright (C) 1992,93,94,95 Free Software Foundation, Inc.
+;; Copyright (C) 1995 Amdahl Corporation.
+;; Copyright (C) 1995 Sun Microsystems.
+
+;; This file is part of XEmacs.
+
+;; XEmacs is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; XEmacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with XEmacs; see the file COPYING.  If not, write to the 
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;;
+;;;  protect specified local variables from kill-all-local-variables
+;;;
+
+(defvar self-insert-after-hook nil
+  "Hook to run when extended self insertion command exits.  Should take
+two arguments START and END corresponding to character position.")
+
+(make-variable-buffer-local 'self-insert-after-hook)
+
+(defun toggle-display-direction ()
+  (interactive)
+  (setq display-direction (not display-direction))
+  (if (interactive-p) (redraw-display)))
+
+;;;
+;;; Utility functions for Mule
+;;;
+
+;(defun string-to-char-list (str)
+;  (let ((len (length str))
+;      (idx 0)
+;      c l)
+;    (while (< idx len)
+;      (setq c (sref str idx))
+;      (setq idx (+ idx (charset-dimension (char-charset c))))
+;      (setq l (cons c l)))
+;    (nreverse l)))
+
+(defun string-to-char-list (str)
+  (mapcar 'identity str))
+
+(defun string-width (string)
+  "Return number of columns STRING occupies when displayed.
+Uses the charset-columns attribute of the characters in STRING,
+which may not accurately represent the actual display width when
+using a window system."
+  (let ((col 0)
+       (len (length string))
+       (i 0))
+    (while (< i len)
+      (setq col (+ col (charset-columns (char-charset (aref string i)))))
+      (setq i (1+ i)))
+    col))
+
+(defalias 'string-columns 'string-width)
+(make-obsolete 'string-columns 'string-width)
+
+(defun delete-text-in-column (from to)
+  "Delete the text between column FROM and TO (exclusive) of the current line.
+Nil of FORM or TO means the current column.
+
+If there's a character across the borders, the character is replaced
+with the same width of spaces before deleting."
+  (save-excursion
+    (let (p1 p2)
+      (if from
+         (progn
+           (setq p1 (move-to-column from))
+           (if (> p1 from)
+               (progn
+                 (delete-char -1)
+                 (insert-char ?  (- p1 (current-column)))
+                 (forward-char (- from p1))))))
+      (setq p1 (point))
+      (if to
+         (progn
+           (setq p2 (move-to-column to))
+           (if (> p2 to)
+               (progn
+                 (delete-char -1)
+                 (insert-char ?  (- p2 (current-column)))
+                 (forward-char (- to p2))))))
+      (setq p2 (point))
+      (delete-region p1 p2))))
+
+;; #### Someone translate this!!
+
+(defun mc-normal-form-string (str)
+  "\e$BJ8;zNs\e(B STR \e$B$N4A;zI8=`7AJ8;zNs$rJV$9!%\e(B"
+  (let ((i 0))
+    (while (setq i (string-match "\n" str i))
+      (if (and (<= 1 i) (< i (1- (length str)))
+              (< (aref str (1- i)) 128)
+              (< (aref str (1+ i)) 128))
+         (aset str i ? ))
+      (setq i (1+ i)))
+    (if (string-match "\n" str 0)
+       (let ((c 0) (i 0) new)
+         (while (setq i (string-match "\n" str i))
+           (setq i (1+ i))
+           (setq c (1+ c)))
+         (setq new (make-string (- (length str) c) 0))
+         (setq i 0 c 0)
+         (while (< i (length str))
+           (cond((not (= (aref str i) ?\n ))
+                 (aset new c (aref str i))
+                 (setq c (1+ c))))
+
+           (setq i (1+ i))
+           )
+         new)
+      str)))
+
+
+(defun string-memq (str list)
+  "Returns non-nil if STR is an element of LIST.  Comparison done with string=.
+The value is actually the tail of LIST whose car is STR.
+If each element of LIST is not a string, it is converted to string
+ before comparison."
+  (let (find elm)
+    (while (and (not find) list)
+      (setq elm (car list))
+      (if (numberp elm) (setq elm (char-to-string elm)))
+      (if (string= str elm)
+         (setq find list)
+       (setq list (cdr list))))
+    find))
+
+(defun cancel-undo-boundary ()
+  "Cancel undo boundary."
+  (if (and (consp buffer-undo-list)
+          ;; if car is nil.
+          (null (car buffer-undo-list)) )
+      (setq buffer-undo-list (cdr buffer-undo-list)) ))
+
+
+;;; Common API emulation functions for GNU Emacs-merged Mule.
+;;; As suggested by MORIOKA Tomohiko
+
+;; Following definition were imported from Emacs/mule-delta.
+
+;; Function `truncate-string-to-width' was moved to mule-util.el.
+
+;; end of imported definition
+
+
+(defalias 'sref 'aref)
+(defalias 'map-char-concat 'mapcar)
+(defun char-bytes (character)
+  "Return number of length a CHARACTER occupies in a string or buffer.
+It returns only 1 in XEmacs.  It is for compatibility with MULE 2.3."
+  1)
+(defalias 'char-length 'char-bytes)
+
+(defun char-width (character)
+  "Return number of columns a CHARACTER occupies when displayed."
+  (charset-columns (char-charset character)))
+
+(defalias 'char-columns 'char-width)
+(make-obsolete 'char-columns 'char-width)
+
+(defalias 'charset-description 'charset-doc-string)
+
+(defalias 'find-charset-string 'charsets-in-string)
+(defalias 'find-charset-region 'charsets-in-region)
+
+(defun find-non-ascii-charset-string (string)
+  "Return a list of charsets in the STRING except ascii.
+It might be available for compatibility with Mule 2.3,
+because its `find-charset-string' ignores ASCII charset."
+  (delq 'ascii (charsets-in-string string)))
+
+(defun find-non-ascii-charset-region (start end)
+  "Return a list of charsets except ascii in the region between START and END.
+It might be available for compatibility with Mule 2.3,
+because its `find-charset-string' ignores ASCII charset."
+  (delq 'ascii (charsets-in-region start end)))
+
+(defun split-char (char)
+  "Return list of charset and one or two position-codes of CHAR."
+  (let ((charset (char-charset char)))
+    (if (eq charset 'ascii)
+       (list charset (char-int char))
+      (let ((i 0)
+           (len (charset-dimension charset))
+           (code (if (integerp char)
+                     char
+                   (char-int char)))
+           dest)
+       (while (< i len)
+         (setq dest (cons (logand code 127) dest)
+               code (lsh code -7)
+               i (1+ i)))
+       (cons charset dest)
+       ))))
+
+
+;;; Commands
+
+(defun set-buffer-process-coding-system (decoding encoding)
+  "Set coding systems for the process associated with the current buffer.
+DECODING is the coding system to be used to decode input from the process,
+ENCODING is the coding system to be used to encode output to the process.
+
+For a list of possible values of CODING-SYSTEM, use \\[list-coding-systems]."
+  (interactive
+   "zCoding-system for process input: \nzCoding-system for process output: ")
+  (let ((proc (get-buffer-process (current-buffer))))
+    (if (null proc)
+       (error "no process")
+      (check-coding-system decoding)
+      (check-coding-system encoding)
+      (set-process-coding-system proc decoding encoding)))
+  (force-mode-line-update))
+
+
+;;; Language environments
+
+;; (defvar current-language-environment nil)
+
+;; (defvar language-environment-list nil)
+
+;; (defun current-language-environment ()
+;;   "Return the current language environment as a symbol.
+;; Returns nil if `set-language-environment' has not been called."
+;;   current-language-environment)
+
+;; (defun language-environment-list ()
+;;   "Return a list of all currently defined language environments."
+;;   language-environment-list)
+
+;; (defun language-environment-p (sym)
+;;   "True if SYM names a defined language environment."
+;;   (memq sym (language-environment-list)))
+
+;; (defun set-language-environment (env)
+;;   "Set the current language environment to ENV."
+;;   (interactive
+;;    (list (intern (completing-read "Language environment: "
+;;                                   obarray 'language-environment-p
+;;                                   'require-match))))
+;;   (when (not (string= (charset-registry 'ascii) "iso8859-1"))
+;;     (set-charset-registry 'ascii "iso8859-1"))
+;;   (let ((func (get env 'set-lang-environ)))
+;;     (if (not (null func))
+;;         (funcall func)))
+;;   (setq current-language-environment env)
+;;   (if (featurep 'egg)
+;;       (egg-lang-switch-callback))
+;; ;;  (if (featurep 'quail)
+;; ;;      (quail-lang-switch-callback))
+;; )
+
+;; (defun define-language-environment (env-sym doc-string enable-function)
+;;   "Define a new language environment, named by ENV-SYM.
+;; DOC-STRING should be a string describing the environment.
+;; ENABLE-FUNCTION should be a function of no arguments that will be called
+;; when the language environment is made current."
+;;   (put env-sym 'lang-environ-doc-string doc-string)
+;;   (put env-sym 'set-lang-environ enable-function)
+;;   (setq language-environment-list (cons env-sym language-environment-list)))
+
+(defun define-egg-environment (env-sym doc-string enable-function)
+  "Define a new language environment for egg, named by ENV-SYM.
+DOC-STRING should be a string describing the environment.
+ENABLE-FUNCTION should be a function of no arguments that will be called
+when the language environment is made current."
+  (put env-sym 'egg-environ-doc-string doc-string)
+  (put env-sym 'set-egg-environ enable-function))
+
+;; (defun define-quail-environment (env-sym doc-string enable-function)
+;;   "Define a new language environment for quail, named by ENV-SYM.
+;; DOC-STRING should be a string describing the environment.
+;; ENABLE-FUNCTION should be a function of no arguments that will be called
+;; when the language environment is made current."
+;;   (put env-sym 'quail-environ-doc-string doc-string)
+;;   (put env-sym 'set-quail-environ enable-function))
+
+;;; mule-misc.el ends here
diff --git a/lisp/mule/mule-tty-init.el b/lisp/mule/mule-tty-init.el
new file mode 100644 (file)
index 0000000..40054d5
--- /dev/null
@@ -0,0 +1,47 @@
+;;; mule-tty-init.el --- Initialization code for console tty under MULE
+
+;; Copyright (C) 1998 Free Software Foundation, Inc.
+;; Copyright (C) 1998 Kazuyuki IENAGA <kazz@imasy.or.jp>
+
+;; Author: Kazuyuki IENAGA <kazz@imasy.or.jp>
+;; Keywords: mule, tty, console, dumped
+
+;; This file is part of XEmacs.
+;;
+;; XEmacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; XEmacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with XEmacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This file is dumped with XEmacs when Mule and TTY support are enabled.
+
+;;; Code:
+
+(defvar mule-tty-win-initted nil)
+
+(defun init-mule-tty-win ()
+  "Initialize TTY for MULE at startup. Don't call this."
+  (unless mule-tty-win-initted
+    (add-hook
+     'before-init-hook
+     (lambda ()
+       (when (eq (device-type) 'tty)
+        (when (string-match "^kterm" (getenv "TERM"))
+          (set-terminal-coding-system 'euc-jp)
+          (set-keyboard-coding-system 'euc-jp))
+        (set-console-tty-coding-system))))
+    (setq mule-tty-win-initted t)))
+
+;;; mule-tty-init.el ends here
diff --git a/lisp/mule/mule-x-init.el b/lisp/mule/mule-x-init.el
new file mode 100644 (file)
index 0000000..8bb351c
--- /dev/null
@@ -0,0 +1,126 @@
+;;; mule-x-init.el --- initialization code for X Windows under MULE
+;; Copyright (C) 1994 Free Software Foundation, Inc.
+;; Copyright (C) 1996 Ben Wing <wing@666.com>
+
+;; Author: various
+;; Keywords: mule X11
+
+;; This file is part of XEmacs.
+;;
+;; XEmacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; XEmacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with XEmacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+;;; Work around what is arguably a Sun CDE bug.
+
+(defun x-use-halfwidth-roman-font (fullwidth-charset roman-registry)
+  "Maybe set charset registry of the 'ascii charset to ROMAN-REGISTRY.
+
+Do this only if:
+ - the current display is an X device
+ - the displayed width of FULLWIDTH-CHARSET is twice the displayed
+   width of the 'ascii charset, but only when using ROMAN-REGISTRY.
+
+Traditionally, Asian characters have been displayed so that they
+occupy exactly twice the screen space of ASCII (`halfwidth')
+characters.  On many systems, e.g. Sun CDE systems, this can only be
+achieved by using a national variant roman font to display ASCII."
+  (let ((charset-font-width
+        (lambda (charset)
+          (font-instance-width
+           (face-font-instance 'default (selected-device) charset))))
+
+       (twice-as-wide
+        (lambda (cs1 cs2)
+          (let ((width1 (funcall charset-font-width cs1))
+                (width2 (funcall charset-font-width cs2)))
+            (and width1 width2 (eq (+ width1 width1) width2))))))
+
+    (when (eq 'x (device-type))
+      (condition-case nil
+         (unless (funcall twice-as-wide 'ascii fullwidth-charset)
+           (set-charset-registry 'ascii roman-registry)
+           (unless (funcall twice-as-wide 'ascii fullwidth-charset)
+             ;; Restore if roman-registry didn't help
+             (set-charset-registry 'ascii "iso8859-1")))
+       (error (set-charset-registry 'ascii "iso8859-1"))))))
+
+;;;;
+
+(defvar mule-x-win-initted nil)
+
+(defun init-mule-x-win ()
+  "Initialize X Windows for MULE at startup.  Don't call this."
+  (when (not mule-x-win-initted)
+    (define-specifier-tag 'mule-fonts
+      (lambda (device) (eq 'x (device-type device))))
+
+    (set-face-font
+     'default
+     '("-*-fixed-medium-r-*--16-*-iso8859-1"
+       "-*-fixed-medium-r-*--*-iso8859-1"
+       "-*-fixed-medium-r-*--*-iso8859-2"
+       "-*-fixed-medium-r-*--*-iso8859-3"
+       "-*-fixed-medium-r-*--*-iso8859-4"
+       "-*-fixed-medium-r-*--*-iso8859-7"
+       "-*-fixed-medium-r-*--*-iso8859-8"
+       "-*-fixed-medium-r-*--*-iso8859-5"
+       "-*-fixed-medium-r-*--*-iso8859-9"
+
+       ;; Following 3 fonts proposed by Teruhiko.Kurosaka@Japan.eng.sun
+       "-sun-gothic-medium-r-normal--14-120-75-75-c-60-jisx0201.1976-0"
+       "-sun-gothic-medium-r-normal--14-120-75-75-c-120-jisx0208.1983-0"
+       "-wadalab-gothic-medium-r-normal--14-120-75-75-c-120-jisx0212.1990-0"
+       ;; Other Japanese fonts
+       "-*-fixed-medium-r-*--*-jisx0201.1976-*"
+       "-*-fixed-medium-r-*--*-jisx0208.1983-*"
+       "-*-fixed-medium-r-*--*-jisx0212*-*"
+
+       ;; Chinese fonts
+       "-*-*-medium-r-*--*-gb2312.1980-*"
+       
+       ;; Use One font specification for CNS chinese
+       ;; Too many variations in font naming
+       "-*-fixed-medium-r-*--*-cns11643*-*"
+       ;; "-*-fixed-medium-r-*--*-cns11643*2"
+       ;; "-*-fixed-medium-r-*--*-cns11643*3"
+       ;; "-*-fixed-medium-r-*--*-cns11643*4"
+       ;; "-*-fixed-medium-r-*--*-cns11643.5-0"
+       ;; "-*-fixed-medium-r-*--*-cns11643.6-0"
+       ;; "-*-fixed-medium-r-*--*-cns11643.7-0"
+       
+       "-*-fixed-medium-r-*--*-big5*-*"
+       "-*-fixed-medium-r-*--*-sisheng_cwnn-0"
+
+       ;; Other fonts
+       
+       ;; "-*-fixed-medium-r-*--*-viscii1.1-1"
+       
+       ;; "-*-fixed-medium-r-*--*-mulearabic-0"
+       ;; "-*-fixed-medium-r-*--*-mulearabic-1"
+       ;; "-*-fixed-medium-r-*--*-mulearabic-2"
+
+       ;; "-*-fixed-medium-r-*--*-muleipa-1"
+       ;; "-*-fixed-medium-r-*--*-ethio-*"
+
+       "-*-mincho-medium-r-*--*-ksc5601.1987-*" ; Korean
+       "-*-fixed-medium-r-*--*-tis620.2529-1"   ; Thai
+       )
+     'global '(mule-fonts) 'append)
+
+    (setq mule-x-win-initted t)))
index 2c99440..d5603ec 100644 (file)
@@ -177,7 +177,9 @@ or return a location appropriate for the package otherwise."
        ;; Ok we need to guess
        (if mule-related
            (package-admin-get-install-dir 'mule-base nil nil)
-         (car (last late-packages)))))))
+         (if (eq package 'xemacs-base)
+             (car (last late-packages))
+           (package-admin-get-install-dir 'xemacs-base nil nil)))))))
          
 
 
index 5deff64..094087b 100644 (file)
@@ -129,28 +129,7 @@ the terminal-initialization file to be loaded.")
 (defconst abbrev-file-name (purecopy "~/.abbrev_defs")
   "*Default name of file to read abbrevs from.")
 
-(defconst directory-abbrev-alist
-  (list
-   ;;
-   ;; This matches the default Sun automounter temporary mount points.  These
-   ;; temporary mount points may go away, so it's important that we only try
-   ;; to read files under the "advertised" mount point, rather than the
-   ;; temporary one, or it will look like files have been deleted on us.
-   ;; Whoever came up with this design is clearly a moron of the first order,
-   ;; but now we're stuck with it, no doubt until the end of time.
-   ;;
-   ;; For best results, automounter junk should go near the front of this
-   ;; list, and other user translations should come after it.
-   ;;
-   ;; You may need to change this if you're not running the Sun automounter,
-   ;; if you're not running in the default configuration.  Because the
-   ;; designers (and I use that term loosely) of the automounters failed to
-   ;; provide any uniform way of disambiguating a pathname, emacs needs to
-   ;; have knowledge about exactly how the automounter mangles pathnames
-   ;; (and this knowledge is basically impossible to derive at run-time.)
-   ;;
-   (cons (purecopy "\\`/tmp_mnt/") (purecopy "/"))
-   ))
+(defconst directory-abbrev-alist nil)
 
 ;; Formerly, the values of these variables were computed once
 ;; (at dump time).  However, with the advent of pre-compiled binaries
@@ -203,7 +182,7 @@ Will not override settings in site-init.el or site-run.el."
      l 'rmail-spool-directory
      (cond ((string-match "^[^-]+-[^-]+-sco3.2v4" system-configuration)
            "/usr/spool/mail/")
-          ;; On The Bull DPX/2 /usr/spool/mail is used although 
+          ;; On The Bull DPX/2 /usr/spool/mail is used although
           ;; it is usg-unix-v.
           ((string-match "^m68k-bull-sysv3" system-configuration)
            "/usr/spool/mail/")
@@ -256,8 +235,42 @@ Will not override settings in site-init.el or site-run.el."
      ;; Solaris 2 has both of these files; prefer /usr/ucb/man
      ;; because the other has nonstandard argument conventions.
      (if (file-exists-p "/usr/ucb/man")
-        "/usr/ucb/man" "/usr/bin/man")))
-)
+        "/usr/ucb/man" "/usr/bin/man"))
+
+    (funcall
+     l 'directory-abbrev-alist
+     ;; Try to match various conventions for automounter temporary
+     ;; mount points.  These temporary mount points may go away, so
+     ;; it's important that we only try to read files under the
+     ;; "advertised" mount point, rather than the temporary one, or it
+     ;; will look like files have been deleted on us.  Whoever came up
+     ;; with this design is clearly a moron of the first order, but
+     ;; now we're stuck with it, no doubt until the end of time.
+     ;;
+     ;; For best results, automounter junk should go near the front of this
+     ;; list, and other user translations should come after it.
+     ;;
+     ;; Our code handles the following empirically observed conventions:
+     ;; /net is an actual directory! (some systems are not broken!)
+     ;; /net/HOST -> /tmp_mnt/net/HOST (`standard' old Sun automounter)
+     ;; /net/HOST -> /tmp_mnt/HOST (BSDI 4.0)
+     ;; /net/HOST -> /a/HOST (Freebsd 2.2.x)
+     ;; /net/HOST -> /amd/HOST (seen in amd sample config files)
+     ;;
+     ;; If your system has a different convention, you may have to change this.
+     ;; Don't forget to send in a patch!
+     (when (file-directory-p "/net")
+       (append
+       (when (file-directory-p "/tmp_mnt")
+         (if (file-directory-p "/tmp_mnt/net")
+             '(("\\`/tmp_mnt/net/" . "/net/"))
+           '(("\\`/tmp_mnt/" . "/net/"))))
+       (when (file-directory-p "/a")
+         '(("\\`/a/" . "/net/")))
+       (when (file-directory-p "/amd")
+         '(("\\`/amd/" . "/net/")))
+       )))
+))
 
 (if (running-temacs-p)
     (initialize-xemacs-paths))
index 0f3f64c..749f99d 100644 (file)
@@ -337,7 +337,7 @@ Fourth arg SERVICE is name of the service desired, or an integer
 process as a string"
   ;; by "William G. Dubuque" <wgd@zurich.ai.mit.edu>
   (with-output-to-string
-    (call-process shell-file-name nil t nil "-c" command)))
+    (call-process shell-file-name nil t nil shell-command-switch command)))
 
 (defalias 'shell-command-to-string 'exec-to-string)
 
index 55a5830..446c326 100644 (file)
@@ -154,6 +154,9 @@ to get the latest version of the file, then make the change again.")
                 (throw 'aual-done t))
                ((and (misc-user-event-p event) (eq (event-object event) 'yield))
                 (signal 'file-locked (list "File is locked" fn opponent)))
+               ((and (misc-user-event-p event)
+                     (eq (event-object event) 'menu-no-selection-hook))
+                (signal 'quit nil))
                ((button-release-event-p event) ;; don't beep twice
                 nil)
                (t
@@ -189,6 +192,9 @@ Do you really want to edit the buffer? " fn)
                 (revert-buffer nil t)
                 (signal 'file-supersession
                         (list fn "(reverted)")))
+               ((and (misc-user-event-p event)
+                     (eq (event-object event) 'menu-no-selection-hook))
+                (signal 'quit nil))
                ((button-release-event-p event) ;; don't beep twice
                 nil)
                (t
index 92c5cda..b770831 100644 (file)
@@ -1,8 +1,17 @@
 #ifndef LWLIB_H
 #define LWLIB_H
 
+#undef CONST
+
 #include <X11/Intrinsic.h>
 
+/* To eliminate use of `const' in the lwlib sources, define CONST_IS_LOSING. */
+#ifdef CONST_IS_LOSING
+# define CONST
+#else
+# define CONST const
+#endif
+
 #if defined (LWLIB_MENUBARS_LUCID) || defined (LWLIB_MENUBARS_MOTIF) || defined (LWLIB_MENUBARS_ATHENA)
 #define NEED_MENUBARS
 #endif
index 1bedbed..06b9a90 100644 (file)
@@ -1,3 +1,7 @@
+1999-03-01  XEmacs Build Bot <builds@cvs.xemacs.org>
+
+       * XEmacs 21.2.11 is released
+
 1999-02-05  XEmacs Build Bot <builds@cvs.xemacs.org>
 
        * XEmacs 21.2.10 is released
index 2c4a4ac..25bc2e2 100644 (file)
@@ -1,3 +1,7 @@
+1999-03-01  XEmacs Build Bot <builds@cvs.xemacs.org>
+
+       * XEmacs 21.2.11 is released
+
 1999-02-05  XEmacs Build Bot <builds@cvs.xemacs.org>
 
        * XEmacs 21.2.10 is released
index 3b88295..bc5aacd 100644 (file)
@@ -293,5 +293,6 @@ Lisp_Object tty_semi_canonicalize_device_connection (Lisp_Object connection,
                                                     Error_behavior errb);
 Lisp_Object tty_canonicalize_device_connection (Lisp_Object connection,
                                                Error_behavior errb);
+struct console * tty_find_console_from_fd (int fd);
 
 #endif /* _XEMACS_CONSOLE_TTY_H_ */
index cd67be2..4042366 100644 (file)
@@ -65,6 +65,7 @@ Boston, MA 02111-1307, USA.  */
 #include "events-mod.h"
 #ifdef HAVE_MSG_SELECT
 #include "sysfile.h"
+#include "console-tty.h"
 #elif defined(__CYGWIN32__)
 typedef unsigned int SOCKET;
 #endif
@@ -121,10 +122,10 @@ static Lisp_Object mswindows_s_dispatch_event_queue, mswindows_s_dispatch_event_
 /* The number of things we can wait on */
 #define MAX_WAITABLE (MAXIMUM_WAIT_OBJECTS - 1)
 
+#ifndef HAVE_MSG_SELECT
 /* List of mswindows waitable handles. */
 static HANDLE mswindows_waitable_handles[MAX_WAITABLE];
 
-#ifndef HAVE_MSG_SELECT
 /* Number of wait handles */
 static int mswindows_waitable_count=0;
 #endif /* HAVE_MSG_SELECT */
@@ -1322,28 +1323,6 @@ mswindows_need_event (int badly_p)
          pointer_to_this = &select_time_to_block;
        }
 
-      /* select() is slow and buggy so if we don't have any processes
-         just wait as normal */
-      if (memcmp (&process_only_mask, &zero_mask, sizeof(SELECT_TYPE))==0)
-       {
-         /* Now try getting a message or process event */
-         active = MsgWaitForMultipleObjects (0, mswindows_waitable_handles,
-                                             FALSE, badly_p ? INFINITE : 0,
-                                             QS_ALLINPUT);
-         
-         if (active == WAIT_TIMEOUT)
-           {
-             /* No luck trying - just return what we've already got */
-             return;
-           }
-         else if (active == WAIT_OBJECT_0)
-           {
-             /* Got your message, thanks */
-             mswindows_drain_windows_queue ();
-             continue;
-           }
-       }
-
       active = select (MAXDESC, &temp_mask, 0, 0, pointer_to_this);
       
       if (active == 0)
@@ -1356,7 +1335,28 @@ mswindows_need_event (int badly_p)
            {
              mswindows_drain_windows_queue ();
            }
-         
+#ifdef HAVE_TTY          
+         /* Look for a TTY event */
+         for (i = 0; i < MAXDESC-1; i++)
+           {
+             /* To avoid race conditions (among other things, an infinite
+                loop when called from Fdiscard_input()), we must return
+                user events ahead of process events. */
+             if (FD_ISSET (i, &temp_mask) && FD_ISSET (i, &tty_only_mask))
+               {
+                 struct console *c = tty_find_console_from_fd (i);
+                 Lisp_Object emacs_event = Fmake_event (Qnil, Qnil);
+                 struct Lisp_Event* event = XEVENT (emacs_event);
+                 
+                 assert (c);
+                 if (read_event_from_tty_or_stream_desc (event, c, i))
+                   {
+                     mswindows_enqueue_dispatch_event (emacs_event);
+                     return;
+                   }
+               }
+           }
+#endif
          /* Look for a process event */
          for (i = 0; i < MAXDESC-1; i++)
            {
@@ -1369,11 +1369,6 @@ mswindows_need_event (int badly_p)
                      
                      mswindows_enqueue_process_event (p);
                    }
-                 else if (FD_ISSET (i, &tty_only_mask))
-                   {
-                               /* do we care about tty events? Do we
-                                   ever get tty events? */
-                   }
                  else
                    {
                      /* We might get here when a fake event came
@@ -2674,11 +2669,23 @@ emacs_mswindows_unselect_process (struct Lisp_Process *process)
 static void
 emacs_mswindows_select_console (struct console *con)
 {
+#ifdef HAVE_MSG_SELECT
+  if (CONSOLE_MSWINDOWS_P (con))
+    return; /* mswindows consoles are automatically selected */
+
+  event_stream_unixoid_select_console (con);
+#endif
 }
 
 static void
 emacs_mswindows_unselect_console (struct console *con)
 {
+#ifdef HAVE_MSG_SELECT
+  if (CONSOLE_MSWINDOWS_P (con))
+    return; /* mswindows consoles are automatically selected */
+
+  event_stream_unixoid_unselect_console (con);
+#endif
 }
 
 static void
index 1829140..52e8006 100644 (file)
@@ -5374,8 +5374,7 @@ init_event_stream (void)
   if (initialized)
     {
 #ifdef HAVE_UNIXOID_EVENT_LOOP
-      /*      if (strcmp (display_use, "mswindows") != 0)*/
-       init_event_unixoid ();
+      init_event_unixoid ();
 #endif
 #ifdef HAVE_X_WINDOWS
       if (!strcmp (display_use, "x"))
@@ -5390,12 +5389,13 @@ init_event_stream (void)
          {
            /* For TTY's, use the Xt event loop if we can; it allows
               us to later open an X connection. */
-#if defined (HAVE_X_WINDOWS) && !defined (DEBUG_TTY_EVENT_STREAM)
+#if defined (HAVE_MS_WINDOWS) && defined (HAVE_MSG_SELECT) \
+           && !defined (DEBUG_TTY_EVENT_STREAM)
+           init_event_mswindows_late ();
+#elif defined (HAVE_X_WINDOWS) && !defined (DEBUG_TTY_EVENT_STREAM)
            init_event_Xt_late ();
 #elif defined (HAVE_TTY)
            init_event_tty_late ();
-#elif defined (HAVE_MS_WINDOWS)
-           init_event_mswindows_late ();
 #endif
          }
       init_interrupts_late ();
index 00dd49c..0e44cf4 100644 (file)
@@ -94,8 +94,8 @@ emacs_tty_event_pending_p (int user_p)
                             non_fake_input_wait_mask);
 }
 
-static struct console *
-find_console_from_fd (int fd)
+struct console *
+tty_find_console_from_fd (int fd)
 {
   Lisp_Object concons;
 
@@ -142,7 +142,7 @@ emacs_tty_next_event (struct Lisp_Event *emacs_event)
                 user events ahead of process events. */
              if (FD_ISSET (i, &temp_mask) && FD_ISSET (i, &tty_only_mask))
                {
-                 struct console *c = find_console_from_fd (i);
+                 struct console *c = tty_find_console_from_fd (i);
 
                  assert (c);
                  if (read_event_from_tty_or_stream_desc (emacs_event, c, i))
index aed51bf..6d5f750 100644 (file)
@@ -124,7 +124,7 @@ convert_EImage_to_XImage (Lisp_Object device, int width, int height,
   Colormap cmap;
   Visual *vis;
   XImage *outimg;
-  int depth, bitmap_pad, byte_cnt, i, j;
+  int depth, bitmap_pad, bits_per_pixel, byte_cnt, i, j;
   int rd,gr,bl,q;
   unsigned char *data, *ip, *dp;
   quant_table *qtable = 0;
@@ -149,13 +149,15 @@ convert_EImage_to_XImage (Lisp_Object device, int width, int height,
   bitmap_pad = ((depth > 16) ? 32 :
                (depth >  8) ? 16 :
                8);
-  byte_cnt = bitmap_pad >> 3;
 
   outimg = XCreateImage (dpy, vis,
                         depth, ZPixmap, 0, 0, width, height,
                         bitmap_pad, 0);
   if (!outimg) return NULL;
 
+  bits_per_pixel = outimg->bits_per_pixel;
+  byte_cnt = bits_per_pixel >> 3;
+
   data = (unsigned char *) xmalloc (outimg->bytes_per_line * height);
   if (!data)
     {
diff --git a/src/s/bsdos4.h b/src/s/bsdos4.h
new file mode 100644 (file)
index 0000000..a9dfe19
--- /dev/null
@@ -0,0 +1,10 @@
+#include "bsdos3.h"
+
+/* BSD/OS seems to have switched to ELF format for executables. */
+#ifdef __ELF__
+
+#undef ORDINARY_LINK
+#define ORDINARY_LINK 1
+#define UNEXEC unexelf.o
+
+#endif /* ELF */
index b3a423b..2e2148c 100644 (file)
@@ -127,7 +127,12 @@ extern long random();
 #define UNEXEC "unexcw.o"
 
 #ifdef CYGWIN_VERSION_DLL_MAJOR
+#if 0
+/* ### FIXME: although defining BROKEN_SIGIO is correct for proper ^G
+   behavior, bugs in cygwin mean that xemacs locks up frequently if
+   this is defined.  */
 #define BROKEN_SIGIO
+#endif
 #else
 #define PROCESS_IO_BLOCKING
 #endif
index 0baf968..8262613 100644 (file)
@@ -23,4 +23,8 @@ Boston, MA 02111-1307, USA.  */
 
 #include <X11/Intrinsic.h>
 
-#define CONST const
+#ifdef CONST_IS_LOSING
+# define CONST
+#else
+# define CONST const
+#endif
index d5825af..b440f1d 100644 (file)
@@ -1,3 +1,7 @@
+1999-03-01  XEmacs Build Bot <builds@cvs.xemacs.org>
+
+       * XEmacs 21.2.11 is released
+
 1999-02-05  XEmacs Build Bot <builds@cvs.xemacs.org>
 
        * XEmacs 21.2.10 is released
index 01d195a..62296e0 100644 (file)
      (push (file-name-directory load-file-name) load-path)
      (require 'test-harness))))
 
-(flet ((test-database
-       (db)
+(flet ((delete-database-files (filename)
+       (dolist (fn (list filename (concat filename ".db")))
+         (ignore-file-errors (delete-file fn))))
+
+       (test-database (db)
        (Assert (databasep db))
        (put-database "key1" "val1" db)
        (Assert (equal "val1" (get-database "key1" db)))
        (Assert (equal nil (get-database "key1" db)))
        (close-database db)
        (Assert (not (database-live-p db)))
-       (Assert (databasep db))
-       (let ((filename (database-file-name db)))
-         (dolist (fn (list filename (concat filename ".db")))
-           (condition-case nil (delete-file fn) (file-error nil))))))
+       (Assert (databasep db))))
 
   (let ((filename (expand-file-name "test-harness" (temp-directory))))
 
-    (dolist (fn (list filename (concat filename ".db")))
-      (ignore-file-errors (delete-file fn)))
-
     (dolist (db-type `(dbm berkeley-db))
       (when (featurep db-type)
        (princ "\n")
-       (test-database (open-database filename db-type))))
-    ))
+       (delete-database-files filename)
+       (test-database (open-database filename db-type))
+       (delete-database-files filename)))))
index d381b53..535a620 100644 (file)
@@ -1,8 +1,8 @@
 #!/bin/sh
 emacs_major_version=21
 emacs_minor_version=2
-emacs_beta_version=10
-xemacs_codename="Boreas"
+emacs_beta_version=11
+xemacs_codename="Calliope"
 infodock_major_version=4
 infodock_minor_version=0
 infodock_build_version=1