included commits to RCS files with non-trunk default branches.
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
** 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
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
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
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:
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:
--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,
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).
* 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)
==========================
*** Sun
-Support for Sparcworks. Must be installed prior to XEmacs build to be
-effective.
+Support for Sparcworks.
*** apel
*** tooltalk
-Support for building with Tooltalk. Must be installed prior to XEmacs
-build to be effective.
+Support for building with Tooltalk.
*** xemacs-base
*** vm
-An Emacs mailer. This package must be installed prior to building XEmacs.
+An Emacs mailer.
*** w3
*** vc
-Version Control for Free systems. This package must be installed
-prior to building XEmacs.
+Version Control for Free systems.
*** vc-cc
+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
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@"
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@"
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@"
lwlib_objs "@lwlib_objs@"
machfile "@machfile@"
mandir "@mandir@"
+moduledir "@moduledir@"
native_sound_lib "@native_sound_lib@"
oldincludedir "@oldincludedir@"
opsysfile "@opsysfile@"
program_transform_name "@program_transform_name@"
sbindir "@sbindir@"
sharedstatedir "@sharedstatedir@"
+sitelispdir "@sitelispdir@"
+sitemoduledir "@sitemoduledir@"
sound_cflags "@sound_cflags@"
srcdir "@srcdir@"
start_files "@start_files@"
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
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
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..."
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
: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
;;;###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.
\f
(provide 'etags)
(provide 'tags)
+
+;;; etags.el ends here
:active (fboundp 'gnus)]
["Browse the Web" w3
:active (fboundp 'w3)]
- ["Gopher" gopher
- :active (fboundp 'gopher)]
"----"
["Spell-Check Buffer" ispell-buffer
:active (fboundp 'ispell-buffer)]
--- /dev/null
+;;; 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
--- /dev/null
+;;; 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
--- /dev/null
+;;; 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
--- /dev/null
+;;; 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
--- /dev/null
+;;; 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
--- /dev/null
+;;; 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
--- /dev/null
+;;; 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
--- /dev/null
+;; 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))))
--- /dev/null
+;;; 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
--- /dev/null
+;;; 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
--- /dev/null
+;;; 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
--- /dev/null
+;; 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
--- /dev/null
+;; 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
--- /dev/null
+;;; 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
--- /dev/null
+;;; 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)))
;; 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)))))))
(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
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/")
;; 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))
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)
(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
(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
#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
+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
+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
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_ */
#include "events-mod.h"
#ifdef HAVE_MSG_SELECT
#include "sysfile.h"
+#include "console-tty.h"
#elif defined(__CYGWIN32__)
typedef unsigned int SOCKET;
#endif
/* 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 */
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)
{
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++)
{
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
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
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"))
{
/* 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 ();
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;
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))
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;
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)
{
--- /dev/null
+#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 */
#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
#include <X11/Intrinsic.h>
-#define CONST const
+#ifdef CONST_IS_LOSING
+# define CONST
+#else
+# define CONST const
+#endif
+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
(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)))))
#!/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