- Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
Free Software Foundation, Inc.
See the end of the file for license conditions.
paragraph-separate: "[ \f]*$"
end:
+Brief description of sub-directories:
+
+charsets scripts for generating charset map files
+ in ../etc/charsets
+unidata scripts for generating character property files
+ in ../lisp/international
+
# arch-tag: 812b9461-bc0a-46a7-925e-24bd41118463
dnl in the directory containing this script.
dnl
dnl Copyright (C) 1994, 1995, 1996, 1999, 2000, 2001, 2002, 2003,
- dnl 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ dnl 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
dnl
dnl This file is part of GNU Emacs.
dnl
EMACS_ARG_Y([tiff],[use -ltiff for displaying TIFF images])
EMACS_ARG_Y([gif],[use -lgif (or -lungif) for displaying GIF images])
EMACS_ARG_Y([png],[use -lpng for displaying PNG images])
+EMACS_ARG_Y([freetype],[use -lfreetype for local fonts support])
+EMACS_ARG_Y([xft],[use -lXft for anti aliased fonts])
EMACS_ARG_Y([gpm],[use -lgpm for mouse support on a GNU/Linux console])
EMACS_ARG_Y([rsvg],[use -lrsvg-2 for displaying SVG images])
EMACS_ARG_Y([gtk],[use GTK (same as --with-x-toolkit=gtk)])
EMACS_ARG_N([xim],[don't use X11 XIM])
EMACS_ARG_N([carbon],[don't use Carbon GUI on Mac OS X])
EMACS_ARG_Y([dbus],[use D-Bus])
+EMACS_ARG_N([libotf],[don't use libotf for OpenType font support])
+EMACS_ARG_N([m17n-flt],[don't use m17n-flt for text shaping])
AC_ARG_ENABLE(carbon-app,
[AS_HELP_STRING([--enable-carbon-app@<:@=DIR@:>@],
[DIR=/Application]])],
[ carbon_appdir_x=${enableval}])
+AC_ARG_ENABLE(font-backend,
+[ --enable-font-backend compile code of font-backend support],
+ USE_FONT_BACKEND=$enableval,
+ USE_FONT_BACKEND=no)
+
AC_ARG_ENABLE(asserts,
[AS_HELP_STRING([--enable-asserts], [compile code with asserts enabled])],
USE_XASSERTS=$enableval,
### based on the machine portion of the configuration name, and an s-
### file based on the operating system portion. However, it turns out
### that each m/*.h file is pretty manufacturer-specific - for
- ### example, apollo.h, hp9000s300.h, mega68k, news.h, and tad68k are
- ### all 68000 machines; mips.h, pmax.h, and news-risc are all MIPS
+ ### example hp9000s300.h is a 68000 machine;
+ ### mips.h, pmax.h are all MIPS
### machines. So we basically have to have a special case for each
### configuration name.
###
mips-*-netbsd*) machine=pmax ;;
mipsel-*-netbsd*) machine=pmax ;;
mipseb-*-netbsd*) machine=pmax ;;
- ns32k-*-netbsd*) machine=ns32000 ;;
powerpc-*-netbsd*) machine=macppc ;;
sparc*-*-netbsd*) machine=sparc ;;
vax-*-netbsd*) machine=vax ;;
arm-*-netbsd*) machine=arm ;;
x86_64-*-netbsd*) machine=amdx86-64 ;;
hppa-*-netbsd*) machine=hp800 ;;
- shle-*-netbsd*) machine=sh3el ;;
esac
;;
hppa-*-openbsd*) machine=hp9000s300 ;;
i386-*-openbsd*) machine=intel386 ;;
m68k-*-openbsd*) machine=hp9000s300 ;;
- m88k-*-openbsd*) machine=aviion ;;
mips64-*-openbsd*) machine=mips64 ;;
powerpc-*-openbsd*) machine=macppc ;;
- sh-*-openbsd*) machine=sh3el ;;
sparc*-*-openbsd*) machine=sparc ;;
vax-*-openbsd*) machine=vax ;;
x86_64-*-openbsd*) machine=amdx86-64 ;;
esac
;;
- ## Acorn RISCiX:
- arm-acorn-riscix1.1* )
- machine=acorn opsys=riscix1-1
- ;;
- arm-acorn-riscix1.2* | arm-acorn-riscix )
- ## This name is riscix12 instead of riscix1.2
- ## to avoid a file name conflict on MSDOS.
- machine=acorn opsys=riscix12
- ;;
-
## BSDI ports
*-*-bsdi* )
opsys=bsdi
esac
;;
- ## Alliant machines
- ## Strictly speaking, we need the version of the alliant operating
- ## system to choose the right machine file, but currently the
- ## configuration name doesn't tell us enough to choose the right
- ## one; we need to give alliants their own operating system name to
- ## do this right. When someone cares, they can help us.
- fx80-alliant-* )
- machine=alliant4 opsys=bsd4-2
- ;;
- i860-alliant-* )
- machine=alliant-2800 opsys=bsd4-3
- ;;
-
## Alpha (DEC) machines.
alpha*-dec-osf* )
machine=alpha opsys=osf1
machine=arm opsys=gnu-linux
;;
- ## Altos 3068
- m68*-altos-sysv* )
- machine=altos opsys=usg5-2
- ;;
-
- ## Amdahl UTS
- 580-amdahl-sysv* )
- machine=amdahl opsys=usg5-2-2
- ;;
-
- ## Apollo, Domain/OS
- m68*-apollo-* )
- machine=apollo opsys=bsd4-3
- ;;
-
## Apple Darwin / Mac OS X
*-apple-darwin* )
case "${canonical}" in
fi
;;
- ## AT&T 3b2, 3b5, 3b15, 3b20
- we32k-att-sysv* )
- machine=att3b opsys=usg5-2-2
- ;;
-
- ## AT&T 3b1 - The Mighty Unix PC!
- m68*-att-sysv* )
- machine=7300 opsys=usg5-2-2
- ;;
-
- ## Bull dpx20
- rs6000-bull-bosx* )
- machine=ibmrs6000 opsys=aix3-2
- ;;
-
- ## Bull dpx2
- m68*-bull-sysv3* )
- machine=dpx2 opsys=usg5-3
- ;;
-
- ## Bull sps7
- m68*-bull-sysv2* )
- machine=sps7 opsys=usg5-2
- ;;
-
- ## CCI 5/32, 6/32 -- see "Tahoe".
-
- ## Celerity
- ## I don't know what configuration name to use for this; config.sub
- ## doesn't seem to know anything about it. Hey, Celerity users, get
- ## in touch with us!
- celerity-celerity-bsd* )
- machine=celerity opsys=bsd4-2
- ;;
-
- ## Clipper
- ## What operating systems does this chip run that Emacs has been
- ## tested on?
- clipper-* )
- machine=clipper
- ## We'll use the catch-all code at the bottom to guess the
- ## operating system.
- ;;
-
## Compaq Nonstop
mips-compaq-nonstopux* )
machine=nonstopux opsys=nonstopux
;;
- ## Convex
- *-convex-bsd* | *-convex-convexos* )
- machine=convex opsys=bsd4-3
- ## Prevents spurious white space in makefiles - d.m.cooke@larc.nasa.gov
- NON_GNU_CPP="cc -E -P"
- ;;
-
## Cubix QBx/386
i[3456]86-cubix-sysv* )
machine=intel386 opsys=usg5-3
;;
- ## Cydra 5
- cydra*-cydrome-sysv* )
- machine=cydra5 opsys=usg5-3
- ;;
-
- ## Data General AViiON Machines
- ## DG changed naming conventions with the release of 5.4.4.10, they
- ## dropped the initial 5.4 but left the intervening R. Because of the
- ## R this shouldn't conflict with older versions of the OS (which I
- ## think were named like dgux4.*). In addition, DG new AViiONs series
- ## uses either Motorola M88k or Intel Pentium CPUs.
- m88k-dg-dguxR4.* | m88k-dg-dgux4* )
- machine=aviion opsys=dgux4
- ;;
- m88k-dg-dgux5.4R3* | m88k-dg-dgux5.4.3* )
- ## This name is dgux5-4-3 instead of dgux5-4r3
- ## to avoid a file name conflict on MSDOS.
- machine=aviion opsys=dgux5-4-3
- ;;
- m88k-dg-dgux5.4R2* | m88k-dg-dgux5.4.2* )
- machine=aviion opsys=dgux5-4r2
- ;;
- m88k-dg-dgux* )
- machine=aviion opsys=dgux
- ;;
-
- ## Data General AViiON Intel (x86) Machines
- ## Exists from 5.4.3 (current i586-dg-dguxR4.11)
- ## Ehud Karni, 1998-may-30, ehud@unix.simonwiesel.co.il
- i[345]86-dg-dguxR4* )
- machine=aviion-intel opsys=dgux4
- ;;
-
- ## DECstations
mips-dec-ultrix[0-3].* | mips-dec-ultrix4.0* | mips-dec-bsd4.2* )
machine=pmax opsys=bsd4-2
;;
machine=pmax opsys=mach-bsd4-3
;;
- ## Motorola Delta machines
- m68k-motorola-sysv* | m68000-motorola-sysv* )
- machine=delta opsys=usg5-3
- if test -z "`type gnucc | grep 'not found'`"
- then
- if test -s /etc/167config
- then CC="gnucc -m68040"
- else CC="gnucc -m68881"
- fi
- else
- if test -z "`type gcc | grep 'not found'`"
- then CC=gcc
- else CC=cc
- fi
- fi
- ;;
- m88k-motorola-sysv4* )
- # jbotte@bnr.ca says that UNIX_System_V <hostName> 4.0 R40V4.3 m88k mc88110
- # needs POSIX_SIGNALS and therefore needs usg5-4-2.
- # I hope there are not other 4.0 versions for this machine
- # which really need usg5-4 instead.
- machine=delta88k opsys=usg5-4-2
- ;;
- m88k-motorola-sysv* | m88k-motorola-m88kbcs* )
- machine=delta88k opsys=usg5-3
- ;;
-
- ## Dual machines
- m68*-dual-sysv* )
- machine=dual opsys=usg5-2
- ;;
- m68*-dual-uniplus* )
- machine=dual opsys=unipl5-2
- ;;
-
- ## Elxsi 6400
- elxsi-elxsi-sysv* )
- machine=elxsi opsys=usg5-2
- ;;
-
- ## Encore machines
- ns16k-encore-bsd* )
- machine=ns16000 opsys=umax
- ;;
-
- ## The GEC 63 - apparently, this port isn't really finished yet.
- # I'm sure we finished off the last of the machines, though. -- fx
-
- ## Gould Power Node and NP1
- pn-gould-bsd4.2* )
- machine=gould opsys=bsd4-2
- ;;
- pn-gould-bsd4.3* )
- machine=gould opsys=bsd4-3
- ;;
- np1-gould-bsd* )
- machine=gould-np1 opsys=bsd4-3
- ;;
-
- ## Harris Night Hawk machines running CX/UX (a 5000 looks just like a 4000
- ## as far as Emacs is concerned).
- m88k-harris-cxux* )
- # Build needs to be different on 7.0 and later releases
- case "`uname -r`" in
- [56].[0-9] ) machine=nh4000 opsys=cxux ;;
- [7].[0-9] ) machine=nh4000 opsys=cxux7 ;;
- esac
- NON_GNU_CPP="/lib/cpp"
- ;;
- ## Harris ecx or gcx running CX/UX (Series 1200, Series 3000)
- m68k-harris-cxux* )
- machine=nh3000 opsys=cxux
- ;;
- ## Harris power pc NightHawk running Power UNIX (Series 6000)
- powerpc-harris-powerunix )
- machine=nh6000 opsys=powerunix
- NON_GNU_CPP="cc -Xo -E -P"
- ;;
- ## SR2001/SR2201 running HI-UX/MPP
- hppa1.1-hitachi-hiuxmpp* )
- machine=sr2k opsys=hiuxmpp
- ;;
- hppa1.1-hitachi-hiuxwe2* )
- machine=sr2k opsys=hiuxwe2
- ;;
- ## Honeywell XPS100
- xps*-honeywell-sysv* )
- machine=xps100 opsys=usg5-2
- ;;
-
## HP 9000 series 200 or 300
m68*-hp-bsd* )
machine=hp9000s300 opsys=bsd4-3
machine=hp800 opsys=nextstep
;;
- ## Orion machines
- orion-orion-bsd* )
- machine=orion opsys=bsd4-2
- ;;
- clipper-orion-bsd* )
- machine=orion105 opsys=bsd4-2
- ;;
-
## IBM machines
- i[3456]86-ibm-aix1.1* )
- machine=ibmps2-aix opsys=usg5-2-2
- ;;
- i[3456]86-ibm-aix1.[23]* | i[3456]86-ibm-aix* )
- machine=ibmps2-aix opsys=usg5-3
- ;;
i370-ibm-aix*)
machine=ibm370aix opsys=usg5-3
;;
rs6000-ibm-aix* | powerpc-ibm-aix* )
machine=ibmrs6000 opsys=aix3-2
;;
- romp-ibm-bsd4.3* )
- machine=ibmrt opsys=bsd4-3
- ;;
- romp-ibm-bsd4.2* )
- machine=ibmrt opsys=bsd4-2
- ;;
- romp-ibm-aos4.3* )
- machine=ibmrt opsys=bsd4-3
- ;;
- romp-ibm-aos4.2* )
- machine=ibmrt opsys=bsd4-2
- ;;
- romp-ibm-aos* )
- machine=ibmrt opsys=bsd4-3
- ;;
- romp-ibm-bsd* )
- machine=ibmrt opsys=bsd4-3
- ;;
- romp-ibm-aix* )
- machine=ibmrt-aix opsys=usg5-2-2
- ;;
-
- ## Integrated Solutions `Optimum V'
- m68*-isi-bsd4.2* )
- machine=isi-ov opsys=bsd4-2
- ;;
- m68*-isi-bsd4.3* )
- machine=isi-ov opsys=bsd4-3
- ;;
-
- ## Intel 386 machines where we do care about the manufacturer
- i[3456]86-intsys-sysv* )
- machine=is386 opsys=usg5-2-2
- ;;
## Prime EXL
i[3456]86-prime-sysv* )
machine=i386 opsys=usg5-3
;;
- ## Sequent Symmetry running Dynix
- i[3456]86-sequent-bsd* )
- machine=symmetry opsys=bsd4-3
- ;;
-
## Sequent Symmetry running ptx 4, which is a modified SVR4.
i[3456]86-sequent-ptx4* | i[3456]86-sequent-sysv4* )
machine=sequent-ptx opsys=ptx4
machine=ncr386 opsys=usg5-4-2
;;
- ## Intel Paragon OSF/1
- i860-intel-osf1* )
- machine=paragon opsys=osf1 NON_GNU_CPP=/usr/mach/lib/cpp
- ;;
-
- ## Intel 860
- i860-*-sysv4* )
- machine=i860 opsys=usg5-4
- NON_GNU_CC="/bin/cc" # Ie, not the one in /usr/ucb/cc.
- NON_GNU_CPP="/usr/ccs/lib/cpp" # cc -E tokenizes macro expansion.
- ;;
-
## Macintosh PowerPC
powerpc*-*-linux-gnu* )
machine=macppc opsys=gnu-linux
;;
- ## Masscomp machines
- m68*-masscomp-rtu* )
- machine=masscomp opsys=rtu
- ;;
-
- ## Megatest machines
- m68*-megatest-bsd* )
- machine=mega68 opsys=bsd4-2
- ;;
-
## Workstations sold by MIPS
## This is not necessarily all workstations using the MIPS processor -
## Irises are produced by SGI, and DECstations by DEC.
machine=m68k opsys=nextstep
;;
- ## The complete machine from National Semiconductor
- ns32k-ns-genix* )
- machine=ns32000 opsys=usg5-2
- ;;
-
- ## NCR machines
- m68*-ncr-sysv2* | m68*-ncr-sysvr2* )
- machine=tower32 opsys=usg5-2-2
- ;;
- m68*-ncr-sysv3* | m68*-ncr-sysvr3* )
- machine=tower32v3 opsys=usg5-3
- ;;
-
## NEC EWS4800
mips-nec-sysv4*)
machine=ews4800 opsys=ux4800
;;
- ## Nixdorf Targon 31
- m68*-nixdorf-sysv* )
- machine=targon31 opsys=usg5-2-2
- ;;
-
- ## Nu (TI or LMI)
- m68*-nu-sysv* )
- machine=nu opsys=usg5-2
- ;;
-
- ## Plexus
- m68*-plexus-sysv* )
- machine=plexus opsys=usg5-2
- ;;
-
- ## Pyramid machines
- ## I don't really have any idea what sort of processor the Pyramid has,
- ## so I'm assuming it is its own architecture.
- pyramid-pyramid-bsd* )
- machine=pyramid opsys=bsd4-2
- ;;
-
- ## Sequent Balance
- ns32k-sequent-bsd4.2* )
- machine=sequent opsys=bsd4-2
- ;;
- ns32k-sequent-bsd4.3* )
- machine=sequent opsys=bsd4-3
- ;;
-
## Siemens Nixdorf
mips-siemens-sysv* | mips-sni-sysv*)
machine=mips-siemens opsys=usg5-4
;;
## Silicon Graphics machines
- ## Iris 2500 and Iris 2500 Turbo (aka the Iris 3030)
- m68*-sgi-iris3.5* )
- machine=irist opsys=iris3-5
- ;;
- m68*-sgi-iris3.6* | m68*-sgi-iris*)
- machine=irist opsys=iris3-6
- ;;
## Iris 4D
mips-sgi-irix3* )
machine=iris4d opsys=irix3-3
machine=iris4d opsys=irix5-2
;;
- ## SONY machines
- m68*-sony-bsd4.2* )
- machine=news opsys=bsd4-2
- ;;
- m68*-sony-bsd4.3* )
- machine=news opsys=bsd4-3
- ;;
- m68*-sony-newsos3* | m68*-sony-news3*)
- machine=news opsys=bsd4-3
- ;;
- mips-sony-bsd* | mips-sony-newsos4* | mips-sony-news4*)
- machine=news-risc opsys=bsd4-3
- ;;
- mips-sony-newsos6* )
- machine=news-r6 opsys=newsos6
- ;;
- mips-sony-news* )
- machine=news-risc opsys=newsos5
- ;;
-
- ## Stride
- m68*-stride-sysv* )
- machine=stride opsys=usg5-2
- ;;
-
## Suns
sparc-*-linux-gnu* | sparc64-*-linux-gnu* )
machine=sparc opsys=gnu-linux
| i[3456]86-*-solaris2* | i[3456]86-*-sunos5* | powerpc*-*-solaris2* \
| rs6000-*-solaris2*)
case "${canonical}" in
- m68*-sunos1* ) machine=sun1 ;;
- m68*-sunos2* ) machine=sun2 ;;
- m68* ) machine=sun3 ;;
- i[3456]86-sun-sunos[34]* ) machine=sun386 ;;
i[3456]86-*-* ) machine=intel386 ;;
amd64-*-*|x86_64-*-*) machine=amdx86-64 ;;
powerpcle* ) machine=powerpcle ;;
* ) unported=yes ;;
esac
case "${canonical}" in
- ## The Sun386 didn't get past 4.0.
- i[3456]86-*-sunos4 ) opsys=sunos4-0 ;;
- *-sunos4.0* ) opsys=sunos4-0 ;;
- *-sunos4.1.[3-9]*noshare )
- ## This name is sunos413 instead of sunos4-1-3
- ## to avoid a file name conflict on MSDOS.
- opsys=sunos413
- NON_GNU_CPP=/usr/lib/cpp
- NON_GCC_TEST_OPTIONS=-Bstatic
- GCC_TEST_OPTIONS=-static
- ;;
- *-sunos4.1.[3-9]* | *-sunos4shr*)
- opsys=sunos4shr
- NON_GNU_CPP=/usr/lib/cpp
- ;;
- *-sunos4* | *-sunos )
- opsys=sunos4-1
- NON_GCC_TEST_OPTIONS=-Bstatic
- GCC_TEST_OPTIONS=-static
- ;;
*-sunos5.3* | *-solaris2.3* )
opsys=sol2-3
NON_GNU_CPP=/usr/ccs/lib/cpp
machine=sparc opsys=nextstep
;;
- ## Tadpole 68k
- m68*-tadpole-sysv* )
- machine=tad68k opsys=usg5-3
- ;;
-
- ## Tahoe machines
- tahoe-tahoe-bsd4.2* )
- machine=tahoe opsys=bsd4-2
- ;;
- tahoe-tahoe-bsd4.3* )
- machine=tahoe opsys=bsd4-3
- ;;
-
## Tandem Integrity S2
mips-tandem-sysv* )
machine=tandem-s2 opsys=usg5-3
;;
- ## Tektronix XD88
- m88k-tektronix-sysv3* )
- machine=tekxd88 opsys=usg5-3
- ;;
-
- ## Tektronix 16000 box (6130?)
- ns16k-tektronix-bsd* )
- machine=ns16000 opsys=bsd4-2
- ;;
- ## Tektronix 4300
- ## src/m/tek4300.h hints that this is a m68k machine.
- m68*-tektronix-bsd* )
- machine=tek4300 opsys=bsd4-3
- ;;
-
- ## Titan P2 or P3
- ## We seem to have lost the machine-description file titan.h!
- titan-titan-sysv* )
- machine=titan opsys=usg5-3
- ;;
-
- ## Ustation E30 (SS5E)
- m68*-unisys-uniplus* )
- machine=ustation opsystem=unipl5-2
- ;;
-
## Vaxen.
vax-dec-* )
machine=vax
esac
;;
- ## Whitechapel MG1
- ns16k-whitechapel-* )
- machine=mg1
- ## We don't know what sort of OS runs on these; we'll let the
- ## operating system guessing code below try.
- ;;
-
- ## Wicat
- m68*-wicat-sysv* )
- machine=wicat opsys=usg5-2
- ;;
-
## IA-64
ia64*-*-linux* )
machine=ia64 opsys=gnu-linux
*-darwin* ) opsys=darwin
CPP="${CC-cc} -E -no-cpp-precomp"
;;
- *-isc1.* | *-isc2.[01]* ) opsys=386-ix ;;
- *-isc2.2* ) opsys=isc2-2 ;;
- *-isc4.0* ) opsys=isc4-0 ;;
- *-isc4.* ) opsys=isc4-1
- GCC_TEST_OPTIONS=-posix
- NON_GCC_TEST_OPTIONS=-Xp
- ;;
- *-isc* ) opsys=isc3-0 ;;
- *-esix5* ) opsys=esix5r4; NON_GNU_CPP=/usr/lib/cpp ;;
- *-esix* ) opsys=esix ;;
*-xenix* ) opsys=xenix ;;
*-linux-gnu* ) opsys=gnu-linux ;;
- *-sco3.2v4* ) opsys=sco4 ; NON_GNU_CPP=/lib/cpp ;;
- *-sco3.2v5* ) opsys=sco5
- NON_GNU_CPP=/lib/cpp
- # Prevent -belf from being passed to $CPP.
- # /lib/cpp does not accept it.
- OVERRIDE_CPPFLAGS=" "
- ;;
*-sysv4.2uw* ) opsys=unixware; NON_GNU_CPP=/lib/cpp ;;
*-sysv5uw* ) opsys=unixware; NON_GNU_CPP=/lib/cpp ;;
*-sysv5OpenUNIX* ) opsys=unixware; NON_GNU_CPP=/lib/cpp ;;
RANLIB="ar -ts"
;;
- ## UXP/V
- f301-fujitsu-uxpv4.1)
- machine=f301 opsys=uxpv
- ;;
-
## AMD x86-64 Linux-based GNU system
x86_64-*-linux-gnu* )
machine=amdx86-64 opsys=gnu-linux
fi
fi
-### Link with -lXft if available to work around a bug.
-HAVE_XFT=maybe
-if test "${HAVE_GTK}" = "yes"; then
- dnl Check if --with-pkg-config-prog has been given.
- if test "X${with_pkg_config_prog}" != X; then
- PKG_CONFIG="${with_pkg_config_prog}"
- fi
-
- PKG_CHECK_MODULES(XFT, xft >= 0.13.0, , HAVE_XFT=no)
- if test "$HAVE_XFT" != no; then
- OLD_CFLAGS="$CPPFLAGS"
- OLD_CPPFLAGS="$CFLAGS"
- OLD_LIBS="$LIBS"
- CPPFLAGS="$CPPFLAGS $XFT_CFLAGS"
- CFLAGS="$CFLAGS $XFT_CFLAGS"
- LIBS="$XFT_LIBS $LIBS"
- AC_CHECK_HEADER(X11/Xft/Xft.h,
- [AC_CHECK_LIB(Xft, XftFontOpen, HAVE_XFT=yes, , $XFT_LIBS)])
-
- if test "${HAVE_XFT}" = "yes"; then
- AC_DEFINE(HAVE_XFT, 1, [Define to 1 if you have the Xft library.])
- AC_SUBST(XFT_LIBS)
- C_SWITCH_X_SITE="$C_SWITCH_X_SITE $XFT_CFLAGS"
- else
- CFLAGS="$OLD_CPPFLAGS"
- CFLAGS="$OLD_CFLAGS"
- LIBS="$OLD_LIBS"
- fi
- fi
-fi
-
dnl Do not put whitespace before the #include statements below.
dnl Older compilers (eg sunos4 cc) choke on it.
HAVE_XAW3D=no
CFLAGS=$late_CFLAGS
fi
+#### For font-backend
+if test "${USE_FONT_BACKEND}" = "yes"; then
+
+AC_DEFINE(USE_FONT_BACKEND, 1,
+ [Define to 1 if we should use font-backend.])
+
+### Use -lXft if available, unless `--with-freetype=no' nor `--with-xft=no'.
+HAVE_XFT=maybe
+if test "${HAVE_X11}" = "yes"; then
+ if test "x${with_freetype}" = "xno"; then
+ with_xft="no";
+ fi
+ if test "x${with_xft}" != "xno"; then
+
+ dnl Check if --with-pkg-config-prog has been given.
+ if test "X${with_pkg_config_prog}" != X; then
+ PKG_CONFIG="${with_pkg_config_prog}"
+ fi
+
+ PKG_CHECK_MODULES(XFT, xft >= 0.13.0, , HAVE_XFT=no)
+ if test "$HAVE_XFT" != no; then
+ OLD_CPPFLAGS="$CPPFLAGS"
+ OLD_CFLAGS="$CFLAGS"
+ OLD_LIBS="$LIBS"
+ CPPFLAGS="$CPPFLAGS $XFT_CFLAGS"
+ CFLAGS="$CFLAGS $XFT_CFLAGS"
+ LIBS="$XFT_LIBS $LIBS"
+ AC_CHECK_HEADER(X11/Xft/Xft.h,
+ AC_CHECK_LIB(Xft, XftFontOpen, HAVE_XFT=yes, , $XFT_LIBS))
+
+ if test "${HAVE_XFT}" = "yes"; then
+ AC_DEFINE(HAVE_XFT, 1, [Define to 1 if you have the Xft library.])
+ AC_SUBST(XFT_LIBS)
+ C_SWITCH_X_SITE="$C_SWITCH_X_SITE $XFT_CFLAGS"
+ else
+ CPPFLAGS="$OLD_CPPFLAGS"
+ CFLAGS="$OLD_CFLAGS"
+ LIBS="$OLD_LIBS"
+ fi
+ fi
+ fi
+fi
+
+HAVE_FREETYPE=no
+### Use -lfreetype if available, unless `--with-freetype=no'.
+if test "${HAVE_XFT}" = "yes"; then
+ dnl As we use Xft, we anyway use freetype.
+ dnl In this case, there's no need of additional CFLAGS and LIBS.
+ HAVE_FREETYPE=yes
+elif test "x${with_freetype}" != "xno"; then
+ dnl Check if --with-pkg-config-prog has been given.
+ if test "X${with_pkg_config_prog}" != X; then
+ PKG_CONFIG="${with_pkg_config_prog}"
+ fi
+
+ PKG_CHECK_MODULES(FREETYPE, freetype2, HAVE_FREETYPE=yes, HAVE_FREETYPE=no)
+ if test "${HAVE_FREETYPE}" = "yes"; then
+ PKG_CHECK_MODULES(FONTCONFIG, fontconfig, HAVE_FC=yes, HAVE_FC=no)
+ if test "${HAVE_FC}" = "no"; then
+ dnl Witout fontconfig, we can't use freetype at the moment.
+ HAVE_FREETYPE=no
+ fi
+ fi
+fi
+
+HAVE_LIBOTF=no
+if test "${HAVE_FREETYPE}" = "yes"; then
+ AC_DEFINE(HAVE_FREETYPE, 1,
+ [Define to 1 if you have freetype and fontconfig libraries.])
+ if test "${with_libotf}" != "no"; then
+ dnl Check if --with-pkg-config-prog has been given.
+ if test "X${with_pkg_config_prog}" != X; then
+ PKG_CONFIG="${with_pkg_config_prog}"
+ fi
+ PKG_CHECK_MODULES(LIBOTF, libotf, pkg_check_libotf=yes,
+ pkg_check_libotf=no)
+ if test "$pkg_check_libotf" = "yes"; then
+ AC_DEFINE(HAVE_LIBOTF, 1,
+ [Define to 1 if you have libotf library.])
+ fi
+ fi
+fi
+
+HAVE_M17N_FLT=no
+if test "${with_m17n_flt}" != "no"; then
+ dnl Check if --with-pkg-config-prog has been given.
+ if test "X${with_pkg_config_prog}" != X; then
+ PKG_CONFIG="${with_pkg_config_prog}"
+ fi
+ dnl Checks for libraries.
+ PKG_CHECK_MODULES(M17N_FLT, m17n-flt, pkg_check_m17n_flt=yes,
+ pkg_check_m17n_flt=no)
+ if test "$pkg_check_m17n_flt" = "yes"; then
+ AC_DEFINE(HAVE_M17N_FLT, 1,
+ [Define to 1 if you have m17n-flt library.])
+ fi
+fi
+
+AC_SUBST(FREETYPE_CFLAGS)
+AC_SUBST(FREETYPE_LIBS)
+AC_SUBST(FONTCONFIG_CFLAGS)
+AC_SUBST(FONTCONFIG_LIBS)
+AC_SUBST(LIBOTF_CFLAGS)
+AC_SUBST(LIBOTF_LIBS)
+AC_SUBST(M17N_FLT_CFLAGS)
+AC_SUBST(M17N_FLT_LIBS)
+
+fi
+#### End for font-backend
+
### Use -lXpm if available, unless `--with-xpm=no'.
HAVE_XPM=no
if test "${HAVE_X11}" = "yes"; then
AH_TOP([/* GNU Emacs site configuration template file.
- Copyright (C) 1988, 1993, 1994, 1999, 2000, 2001, 2002, 2004, 2005, 2006, 2007
- Free Software Foundation, Inc.
+ Copyright (C) 1988, 1993, 1994, 1999, 2000, 2001, 2002, 2004, 2005,
+ 2006, 2007, 2008 Free Software Foundation, Inc.
This file is part of GNU Emacs.
# ifndef GC_SETJMP_WORKS
/* GC_SETJMP_WORKS is nearly always appropriate for GCC --
see NON_SAVING_SETJMP in the target descriptions. */
- /* Exceptions (see NON_SAVING_SETJMP in target description) are ns32k,
+ /* Exceptions (see NON_SAVING_SETJMP in target description) are
SCO5 non-ELF (but Emacs specifies ELF) and SVR3 on x86.
- Fixme: Deal with ns32k, SVR3. */
+ Fixme: Deal with SVR3. */
# define GC_SETJMP_WORKS 1
# endif
# ifndef GC_LISP_OBJECT_ALIGNMENT
sed -e '1,/start of cpp stuff/d'\
-e 's,/\*\*/#\(.*\)$,/* \1 */,' \
< Makefile.c > junk.c
+ if test -f ${srcdir}/admin/unidata/UnicodeData.txt; then
+ CPPFLAGS="$CPPFLAGS -DHAVE_UNIDATA"
+ fi
$CPP $undefs -I. -I$srcdir/src $CPPFLAGS junk.c | \
sed -e 's/^ / /' -e '/^#/d' -e '/^[ \f]*$/d' > junk2.c
cat junk1.c junk2.c > Makefile.new
Cze\e,B6f\e(B!, Dobr\e,B}\e(B den, \e,L7T`PRabRcYbU\e(B!, \e,FCei\\e(B \e,Fsar\e(B, \e$,1J2J0J;J0J@JOJ=J1J0\e(B
Africa: \e$(3!A!,!>\e(B
Middle/Near East: \e,Hylem\e(B, \e(38R\e(47d\e(3T!JSa\e(4W\e(3W\e(B
- South Asia: \e4\e$,4!8v#")\e0\e$,15h\e1\e4\e$,4!hv#")\e0\e$,15n\e1\e4\e$,4!zv#!)v#")v#"D\e0\e$,15x6-5d6'\e1\e(B, \e4\e$,44Kv#4z\e0\e$,1?(\e1\e4\e$,44hv#4zv#4\7f\e0\e$,1?.\e1\e4\e$,44qv#4{v#3Q\e0\e$,1?8?M>u?>\e1\e4\e$,44av#4z\e0\e$,1?0\e1\e(B, \e4\e$,46<\e0\e$,1@H\e1\e4\e$,46A\e0\e$,1@N\e1\e4\e$,46Kv#6Vv#6)v#6M\e0\e$,1@X@m@5@^\e1\e4\e$,46Cv#6W\e0\e$,1@P@"\e1\e(B, \e4\e$,4*U\e0\e$,1<U\e1\e4\e$,4*M\e0\e$,1<C\e1\e4\e$,4*Hv#)b\e0\e$,1<5<m\e1\e4\e$,4*H\e0\e$,1<5\e1\e4\e$,4*Qv#)b\e0\e$,1<N<m\e1\e(B, \e4\e$(7"7\e0"7\e1\e4$P\e0"!#C"Q\e1!;\e4"Er'"S\e0"E"S\e1\e4"G\e0"G\e1!;\e4"7\e0"7\e1\e4"2r'"[\e0"2"[\e1!;\e4"Dr'"[\e0"D"[\e1\e4"#\e0"#\e1\e4"G\e0"G\e1!>\e(B
- South East Asia: \e(1JP:R-\e04U\e1\e(B, \e,TJ\e0GQ\e1J\e04U\e1$\e0CQ\e1:\e(B, Ch\e,1`\e(Bo b\e,1U\e(Bn
+ South Asia: \e$,19h9n9x:-9d:'\e(B, \e$,15h5n5x6-5d6'\e(B, \e$,1?(?.?8?M>u?>?0\e(B, \e$,1@H@N@X@m@5@^@P@"\e(B, \e$,1;6;A;#;?;,;G\e(B,
+ \e$,1AFAzB4AvB=B AqB*\e(B, \e$,1<U<C<5<m<5<N<m\e(B, \e$,1=h=n=x>-=U=~=p=B\e(B, \e$(7"7"!#C!;"E"S"G!;"7"2"[!;"D"["#"G!>\e(B
+ South East Asia: \e$,1\'\f\:\V\4\?\]\:\e(B, \e(1JP:R-4U\e(B, \e$,1H9H$HYrmH"H<HLH5HL\e(B, \e,TJGQJ4U$CQ:\e(B, Ch\e,1`\e(Bo b\e,1U\e(Bn
East Asia: \e$ADc:C\e(B, \e$(0*/=(\e(B, \e$B$3$s$K$A$O\e(B, \e$(C>H3gGO<<?d\e(B
Misc: E\e,C6\e(Bo\e,C~\e(Ban\e,Cx\e(Bo \e,Cf\e(Biu\e,C<\e(Ba\e,C}\e(Bde, \e$,2(3(1('('(5\e(B, \e$,1x \e(B p \e$,1x(\e(B world \e$,1s"\e(B hello p \e$,2!a\e(B
CJK variety: GB(\e$AT*Fx\e(B,\e$A?*7"\e(B), BIG5(\e$(0&x86\e(B,\e$(0DeBv\e(B), JIS(\e$B855$\e(B,\e$B3+H/\e(B), KSC(\e$(Cj*Q(\e(B,\e$(CKR[!\e(B)
LANGUAGE (NATIVE NAME) HELLO
---------------------- -----
-Amharic (\e$(3"c!<!N"^\e(B) \e$(3!A!,!>\e(B
-Arabic \e(38R\e(47d\e(3T!JSa\e(4W\e(3W\e(B
+Amharic (\e$,1O M[MmN{\e(B) \e$,1M`MKM]\e(B
+Arabic (\e,GIqjHQYdG\e(B) \e,GecjdY\e(B \e,GeGdqSdG\e(B
+Bengali (\e$,17,7>6b727>\e(B) \e$,17(7.787M6u7>70\e(B
Braille \e$,2(3(1('('(5\e(B
-Bulgarian (\e,LQj[SP`aZX\e(B) \e,L7T`PRUYbU\e(B
C printf ("Hello, world!\n");
-Czech (\e,Bh\e(Be\e,B9\e(Btina) Dobr\e,B}\e(B den
+Czech (\e,Bh\e(Be\e,B9\e(Btina) Dobr\e,A}\e(B den
Danish (dansk) Hej, Goddag, Hall\e,Ax\e(Bj
+Dutch (Nederlands) Hallo, Dag
Emacs emacs --no-splash -f view-hello-file
-English [\e,0p U\e(B-\e,0EZ L\e(B] Hello
+English [\e$(O+S\e(Bi\e,D?\e(B-gli\e$(O*h\e(B] Hello
Esperanto Saluton (E\e,C6\e(Bo\e,C~\e(Ban\e,Cx\e(Bo \e,Cf\e(Biu\e,C<\e(Ba\e,C}\e(Bde)
-Estonian (eesti) Tere p\e,Ad\e(Bevast, Tere \e,Au\e(Bhtust
-Finnish (suomi) Hei, Hyv\e,Add\e(B p\e,Ad\e(Biv\e,Add\e(B
+Estonian (eesti keel) Tere p\e,Ad\e(Bevast, Tere \e,Au\e(Bhtust
+Finnish (Suomi) Hei, Hyv\e,Add\e(B p\e,Ad\e(Biv\e,Add\e(B
French (fran\e,Ag\e(Bais) Bonjour, Salut
Georgian (\e$,1JEJ0J@J7J5J4J:J8\e(B) \e$,1J2J0J;J0J@JOJ=J1J0\e(B
German (Deutsch) Guten Tag, Gr\e,A|_\e(B Gott
Greek (\e,Fekkgmij\\e(B) \e,FCei\\e(B \e,Fsar\e(B
-Hebrew (\e,Hraxiz\e(B) \e,Hylem\e(B
+Gujarati (\e$,19W:!9\9p9~9d: \e(B) \e$,19h9n9x:-9d:'\e(B
+Hebrew (\e,Hzixar\e(B) \e,Hylem\e(B
Hungarian (magyar) Sz\e,Bi\e(Bp j\e,Bs\e(B napot!
-Hindi (\e4\e$,4!}t%"+\e0\e$,15y5\7f5B\e1\e4\e$,4!.v#"Yv#"2\e0\e$,15f6 \e1\e(B) \e4\e$,4!8v#")\e0\e$,15h\e1\e4\e$,4!hv#")\e0\e$,15n\e1\e4\e$,4!zv#!)v#")v#"D\e0\e$,15x6-5d6'\e1\e(B, \e4\e$,4!8v#")\e0\e$,15h\e1\e4\e$,4!hv#")\e0\e$,15n\e1\e4\e$,4!zv# ev#"Rv#")\e0\e$,15x6-5U5~\e1\e4\e$,4!nv#"W\e0\e$,15p\e1\e(B \e4\e$,4 J\e0\e$,16D\e1\e(B
+Hindi (\e$,15y5\7f5B5f6 \e(B) \e$,15h5n5x6-5d6'\e(B, \e$,15h5n5x6-5U5~5p\e(B \e$,16D\e(B
Italian (italiano) Ciao, Buon giorno
Javanese (Jawa) System.out.println("Halo, selamat sore!");
-Kannada (\e4\e$,43Ov#4z\e0\e$,1>u\e1\e4\e$,44Kv#4zv#4M\e0\e$,1?(?M?(\e1\e4\e$,43sv#4z\e0\e$,1?!\e1\e(B) \e4\e$,44Kv#4z\e0\e$,1?(\e1\e4\e$,44hv#4zv#4\7f\e0\e$,1?.\e1\e4\e$,44qv#4{v#3Q\e0\e$,1?8?M>u?>\e1\e4\e$,44av#4z\e0\e$,1?0\e1\e(B
-Lao (\e(1>RJRERG\e(B) \e(1JP:R-\e04U\e1\e(B, \e0\e(1"m\e1c\e0Ki\e1b*!\e04U\e1\e(B
-Malayalam (\e4\e$,46A\e0\e$,1@N\e1\e4\e$,46E\e0\e$,1@R\e1\e4\e$,46Bv#6M\e0\e$,1@O@^\e1\e4\e$,46Fv#6W\e0\e$,1@S@"\e1\e(B) \e4\e$,46<\e0\e$,1@H\e1\e4\e$,46A\e0\e$,1@N\e1\e4\e$,46Kv#6Vv#6)v#6M\e0\e$,1@X@m@5@^\e1\e4\e$,46Cv#6W\e0\e$,1@P@"\e1\e(B
+Kannada (\e$,1>u?(?M?(?!\e(B) \e$,1?(?.?8?M>u?>?0\e(B
+Khmer (\e$,1\7\V\?\V\!\r\8\b\:\e(B) \e$,1\'\f\:\V\4\?\]\:\e(B
+Lao (\e(1>RJRERG\e(B) \e(1JP:R-4U\e(B, \e(1"mcKib*!4U\e(B
+Malayalam (\e$,1@N@R@O@^@S@"\e(B) \e$,1@H@N@X@m@5@^@P@"\e(B
Maltese (il-Malti) Bon\e,Cu\e(Bu, Sa\e,C11\e(Ba
-Mathematics \e$,1x \e(B p \e$,1x(\e(B world \e$,1s"\e(B hello p \e$,2!a\e(B
+Mathematics \e$B"O\e(B p \e$A!J\e(B world \e$(O#@\e(B hello p \e$A!u\e(B
+Myanmar (\e$,1H9HYH;H4HYrlH9HL\e(B) \e$,1H9H$HYrmH"H<HLH5HL\e(B
Nederlands, Vlaams Hallo, Dag
Norwegian (norsk) Hei, God dag
-Polish (polski) Dzie\e,Bq\e(B dobry! Cze\e,B6f\e(B!
+Oriya (\e$,1:s;\;?:f\e(B) \e$,1;6;A;#;?;,;G\e(B
+Polish (j\e,Bj\e(Bzyk polski) Dzie\e,Bq\e(B dobry! Cze\e,B6f\e(B!
Russian (\e,L`caaZXY\e(B) \e,L7T`PRabRcYbU\e(B!
-Slovak (sloven\e,Bh\e(Bina) Dobr\e,B}\e(B de\e,Br\e(B
+Sinhala (\e$,1B#B2ABB$A}\e(B) \e$,1AFAzB4AvB=B AqB*\e(B
+Slovak (sloven\e,Bh\e(Bina) Dobr\e,A}\e(B de\e,Br\e(B
Slovenian (sloven\e,B9h\e(Bina) Pozdravljeni!
Spanish (espa\e,Aq\e(Bol) \e,A!\e(BHola!
-Swedish (svenska) Hej, Goddag, Hall\e,Ae\e(B
-Tamil (\e4\e$,4*N\e0\e$,1<D\e1\e4\e$,4(i\e0\e$,1<N<_\e1\e4\e$,4*Vv#)b\e0\e$,1<T<m\e1\e(B) \e4\e$,4*U\e0\e$,1<U\e1\e4\e$,4*M\e0\e$,1<C\e1\e4\e$,4*Hv#)b\e0\e$,1<5<m\e1\e4\e$,4*H\e0\e$,1<5\e1\e4\e$,4*Qv#)b\e0\e$,1<N<m\e1\e(B
-Thai (\e,T@RIRd7B\e(B) \e,TJ\e0GQ\e1J\e04U\e1$\e0CQ\e1:\e(B, \e,TJ\e0GQ\e1J\e04U\e1\e0$h\e1P\e(B
-Tibetan (\e4\e$(7"7r'"]\e0"7"]\e1\e4"2\e0"2\e1!;\e4%P\e0"G#!"Q\e1\e4"2\e0"2\e1!;\e(B) \e4\e$(7"7\e0"7\e1\e4$P\e0"!#C"Q\e1!;\e4"Er'"S\e0"E"S\e1\e4"G\e0"G\e1!;\e4"7\e0"7\e1\e4"2r'"[\e0"2"[\e1!;\e4"Dr'"[\e0"D"[\e1\e4"#\e0"#\e1\e4"G\e0"G\e1!>\e(B
-Tigrigna (\e$(3"8#r!N"^\e(B) \e$(3!Q!,!<"8\e(B
-Turkish (T\e,M|\e(Brk\e,Mg\e(Be) Merhaba
+Swedish (p\e,Ae\e(B svenska) Hej, Goddag, Hall\e,Ae\e(B
+Tamil (\e$,1<D<N<_<T<m\e(B) \e$,1<U<C<5<m<5<N<m\e(B
+Telugu (\e$,1=d>&=r>!=W>!\e(B) \e$,1=h=n=x>-=U=~=p=B\e(B
+Thai (\e,T@RIRd7B\e(B) \e,TJGQJ4U$CQ:\e(B, \e,TJGQJ4U$hP\e(B
+Tibetan (\e$(7"7"]"2!;"G#!"2!;\e(B) \e$(7"7"!#C!;"E"S"G!;"7"2"[!;"D"["#"G!>\e(B
+Tigrigna (\e$,1NUP-MmN{\e(B) \e$,1MpMKM[NU\e(B
+Turkish (T\e,A|\e(Brk\e,Ag\e(Be) Merhaba
Ukrainian (\e,LcZ`Pw]alZP\e(B) \e,L2vbPn\e(B
-Vietnamese (Ti\e,1*\e(Bng Vi\e,1.\e(Bt) Ch\e,1`\e(Bo b\e,1U\e(Bn
+Vietnamese (ti\e,1*\e(Bng Vi\e,1.\e(Bt) Ch\e,A`\e(Bo b\e,1U\e(Bn
Japanese (\e$BF|K\8l\e(B) \e$B$3$s$K$A$O\e(B, \e(I:]FAJ\e(B
Chinese (\e$AVPND\e(B,\e$AFUM(;0\e(B,\e$A::So\e(B) \e$ADc:C\e(B
\f
- Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
Free Software Foundation, Inc.
This file is part of GNU Emacs.
More Neat Stuff for your Emacs
- Copyright (C) 1993, 1999, 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ Copyright (C) 1993, 1999, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
Free Software Foundation, Inc.
See the end of the file for license conditions.
* JDEE: <URL:http://jdee.sunsite.dk/>
Provides a Java development environment for Emacs.
- * Mule-UCS: Universal enCoding System:
- <URL:ftp://ftp.m17n.org/pub/mule/Mule-UCS/>
- Extended coding systems for Mule, specifically for reading and
- writing UTF-8 encoded Unicode. This probably doesn't have much
- advantage over the built-in `mule-utf-8' coding system with
- `utf-translate-cjk' turned on.
-
* Mailcrypt:
<URL:http://mailcrypt.sourceforge.net/>
PGP and GPG support. PGP isn't free software, but GPG, the GNU
Copyright (C) 1987, 1988, 1989, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
Free Software Foundation, Inc.
See the end of the file for license conditions.
in compiling, installing and running GNU Emacs. Try doing Ctl-C Ctl-t
and browsing through the outline headers.
+* Mule-UCS doesn't work in Emacs 23.
+
+It's completely redundant now, as far as we know.
+
* Emacs startup failures
** Emacs fails to start, complaining about missing fonts.
The fix is to install an unshared library that corresponds to what you
installed in the shared library, and then relink Emacs.
- On SunOS 4.1, simply define HAVE_RES_INIT.
-
If you have already installed the name resolver in the file libresolv.a,
then you need to compile Emacs to use that library. The easiest way to
do this is to add to config.h a definition of LIBS_SYSTEM, LIBS_MACHINE
The only known fix: Don't run display-time.
- *** SunOS
-
- SunOS 4.1.4 stopped shipping on Sep 30 1998.
-
- **** SunOS: You get linker errors
- ld: Undefined symbol
- _get_wmShellWidgetClass
- _get_applicationShellWidgetClass
-
- **** Sun 4.0.x: M-x shell persistently reports "Process shell exited abnormally with code 1".
-
- This happened on Suns as a result of what is said to be a bug in Sunos
- version 4.0.x. The only fix was to reboot the machine.
-
- **** SunOS4.1.1 and SunOS4.1.3: Mail is lost when sent to local aliases.
-
- Many emacs mail user agents (VM and rmail, for instance) use the
- sendmail.el library. This library can arrange for mail to be
- delivered by passing messages to the /usr/lib/sendmail (usually)
- program . In doing so, it passes the '-t' flag to sendmail, which
- means that the name of the recipient of the message is not on the
- command line and, therefore, that sendmail must parse the message to
- obtain the destination address.
-
- There is a bug in the SunOS4.1.1 and SunOS4.1.3 versions of sendmail.
- In short, when given the -t flag, the SunOS sendmail won't recognize
- non-local (i.e. NIS) aliases. It has been reported that the Solaris
- 2.x versions of sendmail do not have this bug. For those using SunOS
- 4.1, the best fix is to install sendmail V8 or IDA sendmail (which
- have other advantages over the regular sendmail as well). At the time
- of this writing, these official versions are available:
-
- Sendmail V8 on ftp.cs.berkeley.edu in /ucb/sendmail:
- sendmail.8.6.9.base.tar.Z (the base system source & documentation)
- sendmail.8.6.9.cf.tar.Z (configuration files)
- sendmail.8.6.9.misc.tar.Z (miscellaneous support programs)
- sendmail.8.6.9.xdoc.tar.Z (extended documentation, with postscript)
-
- IDA sendmail on vixen.cso.uiuc.edu in /pub:
- sendmail-5.67b+IDA-1.5.tar.gz
-
- **** Sunos 4: You get the error ld: Undefined symbol __lib_version.
-
- This is the result of using cc or gcc with the shared library meant
- for acc (the Sunpro compiler). Check your LD_LIBRARY_PATH and delete
- /usr/lang/SC2.0.1 or some similar directory.
-
- **** SunOS 4.1.3: Emacs unpredictably crashes in _yp_dobind_soft.
-
- This happens if you configure Emacs specifying just `sparc-sun-sunos4'
- on a system that is version 4.1.3. You must specify the precise
- version number (or let configure figure out the configuration, which
- it can do perfectly well for SunOS).
-
- **** Sunos 4.1.3: Emacs gets hung shortly after startup.
-
- We think this is due to a bug in Sunos. The word is that
- one of these Sunos patches fixes the bug:
-
- 100075-11 100224-06 100347-03 100482-05 100557-02 100623-03 100804-03 101080-01
- 100103-12 100249-09 100496-02 100564-07 100630-02 100891-10 101134-01
- 100170-09 100296-04 100377-09 100507-04 100567-04 100650-02 101070-01 101145-01
- 100173-10 100305-15 100383-06 100513-04 100570-05 100689-01 101071-03 101200-02
- 100178-09 100338-05 100421-03 100536-02 100584-05 100784-01 101072-01 101207-01
-
- We don't know which of these patches really matter. If you find out
- which ones, please inform bug-gnu-emacs@gnu.org.
-
- **** SunOS 4: Emacs processes keep going after you kill the X server
- (or log out, if you logged in using X).
-
- Someone reported that recompiling with GCC 2.7.0 fixed this problem.
-
- The fix to this is to install patch 100573 for OpenWindows 3.0
- or link libXmu statically.
-
**** Sunos 5.3: Subprocesses remain, hanging but not zombies.
A bug in Sunos 5.3 causes Emacs subprocesses to remain after Emacs
applies to ptys, and doesn't fix the problem with subprocesses
communicating through pipes.
- *** Apollo Domain
-
- **** Shell mode ignores interrupts on Apollo Domain.
-
- You may find that M-x shell prints the following message:
-
- Warning: no access to tty; thus no job control in this shell...
-
- This can happen if there are not enough ptys on your system.
- Here is how to make more of them.
-
- % cd /dev
- % ls pty*
- # shows how many pty's you have. I had 8, named pty0 to pty7)
- % /etc/crpty 8
- # creates eight new pty's
-
*** Irix
*** Irix 6.2: No visible display on mips-sgi-irix6.2 when compiling with GCC 2.8.1.
However, the easiest approach is to build Xlib with the default
floating point option: -fsoft.
- ** SunOS: Undefined symbols _dlopen, _dlsym and/or _dlclose.
-
- If you see undefined symbols _dlopen, _dlsym, or _dlclose when linking
- with -lX11, compile and link against the file mit/util/misc/dlsym.c in
- the MIT X11R5 distribution. Alternatively, link temacs using shared
- libraries with s/sunos4shr.h. (This doesn't work if you use the X
- toolkit.)
-
- If you get the additional error that the linker could not find
- lib_version.o, try extracting it from X11/usr/lib/X11/libvim.a in
- X11R4, then use it in the link.
-
- ** SunOS4, DGUX 5.4.2: --with-x-toolkit version crashes when used with shared libraries.
-
- On some systems, including Sunos 4 and DGUX 5.4.2 and perhaps others,
- unexec doesn't work properly with the shared library for the X
- toolkit. You might be able to work around this by using a nonshared
- libXt.a library. The real fix is to upgrade the various versions of
- unexec and/or ralloc. We think this has been fixed on Sunos 4
- and Solaris in version 19.29.
-
** HPUX 10.20: Emacs crashes during dumping on the HPPA machine.
This seems to be due to a GCC bug; it is fixed in GCC 2.8.1.
Emacs TODO List -*-outline-*-
- Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
Free Software Foundation, Inc.
See the end of the file for license conditions.
** Check for any included packages that define obsolete bug-reporting commands.
Change them to use report-emacs-bug.
+ ** Allow fringe indicators to display a tooltip (provide a help-echo property?)
+
* Important features:
** Provide user-friendly ways to list all available font families,
(with ASCIIfied fallback via latin1-disp). Examples include
box-drawing graphics in Custom buffers, W3 rules and tables, and
tree displays generally, mode-line mail indicator. [See work done
- already for Emacs 22 and consult fx.]
+ already for Emacs 23 and consult fx.]
** Do something to make rms happy with fx's dynamic loading, and use it
to implement things like auto-loaded buffer parsers and database
# Makefile for leim subdirectory in GNU Emacs.
- # Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ # Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
+ # 2006, 2007, 2008
# Free Software Foundation, Inc.
- # Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ # Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
+ # 2006, 2007, 2008
# National Institute of Advanced Industrial Science and Technology (AIST)
# Registration Number H14PRO021
GZIP_PROG = @GZIP_PROG@
- # On Xenix and the IBM RS6000, double-dot gets screwed up.
+ # On IBM RS6000, double-dot gets screwed up.
dot = .
# Which Emacs to use to convert TIT files to Emacs Lisp files,
buildlisppath=${srcdir}/${dot}${dot}/lisp
# How to run Emacs.
-RUN-EMACS = EMACSLOADPATH=$(buildlisppath) LC_ALL=C\
+RUN-EMACS = EMACSLOADPATH=$(buildlisppath) LC_ALL=C \
${BUILT-EMACS} -batch --no-init-file --no-site-file --multibyte
# Subdirectories to be made if ${srcdir} is different from the current
RUSSIAN=${srcdir}/quail/cyrillic.elc ${srcdir}/quail/cyril-jis.elc
OTHERS= \
+ ${srcdir}/quail/arabic.elc \
${srcdir}/quail/ethiopic.elc \
${srcdir}/quail/ipa.elc \
${srcdir}/quail/hebrew.elc \
;;; cyrillic.el --- Quail package for inputting Cyrillic characters
- ;; Copyright (C) 1997, 1998, 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ ;; Copyright (C) 1997, 1998, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
;; Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
- ;; 2006, 2007
+ ;; 2006, 2007, 2008
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
;; least the top row is different.
(quail-define-package
"cyrillic-macedonian" "Cyrillic" "\e,L6\e(BM" nil
- "\e,L)*5@B7\e(B-\e,L#,\e(B keyboard layout based on JUS.I.K1.004 (ISO 8859-5 encoding)"
+ "\e,L)*5@B7\e(B-\e,L#,\e(B keyboard layout based on JUS.I.K1.004"
nil t t t t nil nil nil nil nil t)
;; 1! 2" 3# 4$ 5% 6& 7' 8( 9) 0= /? +* <>
(quail-define-package
"cyrillic-serbian" "Cyrillic" "\e,L6\e(BS" nil
- "\e,L)*5@B7\e(B-\e,L"+\e(B keyboard layout based on JUS.I.K1.005 (ISO 8859-5 encoding)"
+ "\e,L)*5@B7\e(B-\e,L"+\e(B keyboard layout based on JUS.I.K1.005"
nil t t t t nil nil nil nil nil t)
;; 1! 2" 3# 4$ 5% 6& 7' 8( 9) 0= /? +* <>
;; Fixme: add GHE_WITH_UPTURN.
(quail-define-package
"cyrillic-ukrainian" "Ukrainian" "\e,L6\e(BU" nil
- "\e,L$'5@B7\e(B-\e,L&.\e(B UKRAINIAN (ISO 8859-5 encoding)
+ "\e,L$'5@B7\e(B-\e,L&.\e(B UKRAINIAN
Sorry, but 'ghe with upturn' is not included in ISO 8859-5."
nil t t t t nil nil nil nil nil t)
;; (mostly Russian) from time to time.
(quail-define-package
"cyrillic-yawerty" "Cyrillic" "\e,L6O\e(B" nil
- "\e,LO25@BK\e(B Roman transcription (ISO 8859-5 encoding)
+ "\e,LO25@BK\e(B Roman transcription
This layout is based on Roman transcription by phonemic resemblance.
When preceded by a '/', the second and the third rows (number key row) change
;;; hangul3.el --- Quail package for inputting Korean Hangul characters -*-coding: iso-2022-7bit;-*-
- ;; Copyright (C) 1997, 1998, 2001, 2002, 2003, 2004, 2005, 2006, 2007
- ;; Free Software Foundation, Inc.
+ ;; Copyright (C) 1997, 1998, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
+ ;; 2008 Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
- ;; 2006, 2007
+ ;; 2006, 2007, 2008
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
(?1 . "\e$(C$>\e(B")
;; other bindings
(?G . "/") (?T . ";") (?H . "'") (?B . "!") (?Y . "<")
- (?P . ">") (?\[ . "\e$(C!8\e(B") (?\[ . "\e$(C!9\e(B") (?{ . "\e$(C!:\e(B") (?{ . "\e$(C!;\e(B")
+ (?P . ">") (?\[ . "[") (?\[ . "]") (?{ . "{") (?{ . "}")
(?N . "0") (?M . "1") (?< . "2") (?> . "3") (?J . "4")
(?K . "5") (?L . "6") (?U . "7") (?I . "8") (?O . "9"))
"\e$(CGQ1[\e(B 3\e$(C9z=D\e(B: Hangul input method
("B" ?!)
("Y" ?<)
("P" ?>)
- ("\[" ?\e$(C!8\e(B)
- ("\]" ?\e$(C!9\e(B)
- ("{" ?\e$(C!:\e(B)
- ("}" ?\e$(C!;\e(B)
+ ("\[" ?[)
+ ("\]" ?])
+ ("{" ?{)
+ ("}" ?})
("N" ?0)
("M" ?1)
("<" ?2)
;;; arch-tag: 20ea2223-ab47-414f-8e28-d03dc83617b7
;;; hangul3.el ends here
+
;;; indian.el --- Quail packages for inputting Indian
- ;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ ;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
;; Free Software Foundation, Inc.
;; Author: KAWABATA, Taichi <kawabata@m17n.org>
;;; Code:
(require 'quail)
-(require 'devan-util)
(require 'ind-util)
-
-(defun quail-indian-preceding-char-position (position)
- "Return the position of preceding composite character."
- (let (prec-composed)
- (if (char-valid-p (char-before position)) ;; range o.k.
- (if (setq prec-composed (find-composition (1- position)))
- (car prec-composed)
- (1- position))
- nil)))
-
-(defvar quail-indian-update-preceding-char nil)
-
-;; Input value ::
-;; CONTROL-FLAG is integer `n'
-;; quail-current-key :: keyboard input.
-;; Only first `n' can be translated.
-;; quail-current-str :: corresonding string.
-;; jobs :: (1) put last (len-n) char to unrread-command-event.
-;; (2) put translated string to quail-current-str.
-;;
-;; CONTROL-FLAG is t (terminate) or nil (proceed the translation)
-;; quail-current-key :: keyboard input.
-;; quail-current-str :: corresponding string.
-;; jobs :: (1) put modified translated string to quail-current-str.
-;;
-;; When non-nil value is returned from quail-translation-update-function,
-;; the quail-current-str is split to characters and put into event queue,
-;; with `compose-last-char' event with composition info at the end.
-
-(defun quail-indian-update-translation (control-flag)
- ;; make quail-current-str string when possible.
- (if (char-valid-p quail-current-str)
- (setq quail-current-str (char-to-string quail-current-str)))
- ;(message "\n input control-flag=%s, str=%s, key=%s q-ind-upd-prec-char=%s"
- ; control-flag quail-current-str quail-current-key
- ; quail-indian-update-preceding-char)
- ;; reset quail-indian-update-preceding-char if it's initial.
- (if (= (overlay-start quail-overlay) (overlay-end quail-overlay))
- (setq quail-indian-update-preceding-char nil))
- ;; Check the preceding character of the quail region. If the
- ;; preceding character can be composed with quail-current-str, then
- ;; grab that preceding character into the quail-current-str and
- ;; remove that char from the region.
- (let* (prec-char-position composition-regexp
- prec-char-str candidate-str match-pos match-end)
- (when (and quail-current-str
- (null quail-indian-update-preceding-char)
- (null input-method-use-echo-area)
- (null input-method-exit-on-first-char)
- (setq prec-char-position
- (quail-indian-preceding-char-position
- (overlay-start quail-overlay)))
- (setq composition-regexp
- (if prec-char-position
- (caar (elt composition-function-table
- (char-after prec-char-position)))))
- (setq prec-char-str
- (buffer-substring prec-char-position
- (overlay-start quail-overlay))
- candidate-str (concat prec-char-str quail-current-str)
- match-pos (string-match composition-regexp candidate-str)
- match-end (match-end 0))
- (> match-end (length prec-char-str)))
- (setq quail-indian-update-preceding-char prec-char-str)
- (delete-region prec-char-position
- (overlay-start quail-overlay))))
- (setq quail-current-str
- (indian-compose-string
- (concat quail-indian-update-preceding-char
- quail-current-str)))
- (if (numberp control-flag)
- (setq unread-command-events
- (string-to-list
- (substring quail-current-key control-flag))))
- (when control-flag
- (setq quail-indian-update-preceding-char nil))
- ;(message "output control-flag=%s, str=%s, key=%s q-ind-upd-prec-char=%s"
- ; control-flag quail-current-str quail-current-key
- ; quail-indian-update-preceding-char)
- control-flag)
+(require 'devan-util)
;;;
;;; Input by transliteration
(defun quail-define-indian-trans-package (hashtbls pkgname
lang title doc)
(funcall 'quail-define-package pkgname lang title t doc
- nil nil nil nil nil nil t nil
- 'quail-indian-update-translation)
+ nil nil nil nil nil nil t nil)
(maphash
(lambda (key val)
(quail-defrule key (if (= (length val) 1)
;;; Input by Inscript
;;;
-(defun quail-indian-flatten-list (lst)
- "Flatten the nested LIST so that there would be no innner list."
- (if (listp lst)
- (apply 'append (mapcar 'quail-indian-flatten-list lst))
- (list lst)))
-
-(defun quail-define-inscript-package (char-table key-table pkgname lang title
- docstring)
- (setq char-table (quail-indian-flatten-list char-table))
- (setq key-table (quail-indian-flatten-list key-table))
+(defun quail-define-inscript-package (char-tables key-tables pkgname lang
+ title docstring)
(funcall 'quail-define-package pkgname lang title nil docstring
- nil nil nil nil nil nil nil nil
- 'quail-indian-update-translation)
- (dolist (key key-table)
- (let ((val (pop char-table)))
- (if (and key val)
- (quail-defrule
- (if (char-valid-p key) (char-to-string key) key)
- (if (stringp val) (vector val) val))))))
+ nil nil nil nil nil nil nil nil)
+ (let (char-table key-table char key)
+ (while (and char-tables key-tables)
+ (setq char-table (car char-tables)
+ char-tables (cdr char-tables)
+ key-table (car key-tables)
+ key-tables (cdr key-tables))
+ (while (and char-table key-table)
+ (setq char (car char-table)
+ char-table (cdr char-table)
+ key (car key-table)
+ key-table (cdr key-table))
+ (if (and (consp char) (consp key))
+ (setq char-table (append char char-table)
+ key-table (append key key-table))
+ (if (and key char)
+ (quail-defrule
+ (if (characterp key) (char-to-string key) key)
+ (if (stringp char) (vector char) char))))))))
;;
(;; Inscripts
?# ?$ ?^ ?* ?\])))
+(defvar inscript-tml-keytable
+ '(
+ (;; VOWELS (18)
+ (?D nil) (?E ?e) (?F ?f) (?R ?r) (?G ?g) (?T ?t)
+ nil nil nil (?S ?s) (?Z ?z) (?W ?w)
+ nil (?A ?a) (?~ ?`) (?Q ?q) nil nil)
+ (;; CONSONANTS (42)
+ ?k ?K ?i ?I ?U ;; GRUTTALS
+ ?\; ?: ?p ?P ?} ;; PALATALS
+ ?' ?\" ?\[ ?{ ?C ;; CEREBRALS
+ ?l ?L ?o ?O ?v ?V ;; DENTALS
+ ?h ?H ?y ?Y ?c ;; LABIALS
+ ?/ ?j ?J ?n ?N "N]" ?b ;; SEMIVOWELS
+ ?M ?< ?m ?u ;; SIBILANTS
+ "k]" "K]" "i]" "p]" "[]" "{]" "H]" "/]" ;; NUKTAS
+ ?% ?&)
+ (;; Misc Symbols (7)
+ ?X ?x ?_ ">]" ?d "X]" ?>)
+ (;; Digits
+ ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9)
+ (;; Inscripts
+ ?# ?$ ?^ ?* ?\])))
+
(if nil
(quail-define-package "devanagari-inscript" "Devanagari" "DevIS" t "Devanagari keyboard Inscript"))
(quail-define-inscript-package
(if nil
(quail-define-package "tamil-inscript" "Tamil" "TmlIS" t "Tamil keyboard Inscript"))
(quail-define-inscript-package
- indian-tml-base-table inscript-dev-keytable
+ indian-tml-base-table inscript-tml-keytable
"tamil-inscript" "Tamil" "TmlIS"
"Tamil keyboard Inscript.")
-;;; latin-alt.el --- Quail package for inputting various European characters -*-coding: iso-2022-7bit;-*-
+;;; latin-alt.el --- Quail package for inputting various European characters -*-coding: utf-8;-*-
- ;; Copyright (C) 1997, 1998, 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ ;; Copyright (C) 1997, 1998, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
;; Free Software Foundation, Inc.
- ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
| postfix | examples
------------+---------+----------
- acute | ' | a' -> \e,Aa\e(B
- grave | ` | a` -> \e,A`\e(B
- circumflex | ^ | a^ -> \e,Ab\e(B
- diaeresis | \" | a\" -> \e,Ad\e(B
- tilde | ~ | a~ -> \e,Ac\e(B
- cedilla | / | c/ -> \e,Ag\e(B
- nordic | / | d/ -> \e,Ap\e(B t/ -> \e,A~\e(B a/ -> \e,Ae\e(B e/ -> \e,Af\e(B o/ -> \e,Ax\e(B
- others | /<> | s/ -> \e,A_\e(B ?/ -> \e,A?\e(B !/ -> \e,A!\e(B
- | various | << -> \e,A+\e(B >> -> \e,A;\e(B o_ -> \e,A:\e(B a_ -> \e,A*\e(B
+ acute | ' | a' -> á
+ grave | ` | a` -> Ã
+ circumflex | ^ | a^ -> â
+ diaeresis | \" | a\" -> ä
+ tilde | ~ | a~ -> ã
+ cedilla | / | c/ -> ç
+ nordic | / | d/ -> ð t/ -> þ a/ -> å e/ -> æ o/ -> ø
+ others | /<> | s/ -> ß ?/ -> ¿ !/ -> ¡
+ | various | << -> « >> -> » o_ -> º a_ -> ª
It seems natural to use comma for cedillas, but that is
inconvenient in practice because commas are needed very
" nil t nil nil nil nil nil nil nil nil t)
(quail-define-rules
- ("A`" ?\e,A@\e(B)
- ("A'" ?\e,AA\e(B)
- ("A^" ?\e,AB\e(B)
- ("A~" ?\e,AC\e(B)
- ("A\"" ?\e,AD\e(B)
- ("A/" ?\e,AE\e(B)
- ("a`" ?\e,A`\e(B)
- ("a'" ?\e,Aa\e(B)
- ("a^" ?\e,Ab\e(B)
- ("a~" ?\e,Ac\e(B)
- ("a\"" ?\e,Ad\e(B)
- ("a/" ?\e,Ae\e(B)
- ("E`" ?\e,AH\e(B)
- ("E'" ?\e,AI\e(B)
- ("E^" ?\e,AJ\e(B)
- ("E\"" ?\e,AK\e(B)
- ("E/" ?\e,AF\e(B)
- ("e`" ?\e,Ah\e(B)
- ("e'" ?\e,Ai\e(B)
- ("e^" ?\e,Aj\e(B)
- ("e\"" ?\e,Ak\e(B)
- ("e/" ?\e,Af\e(B)
- ("I`" ?\e,AL\e(B)
- ("i`" ?\e,Al\e(B)
- ("I'" ?\e,AM\e(B)
- ("i'" ?\e,Am\e(B)
- ("I^" ?\e,AN\e(B)
- ("i^" ?\e,An\e(B)
- ("I\"" ?\e,AO\e(B)
- ("i\"" ?\e,Ao\e(B)
- ("O`" ?\e,AR\e(B)
- ("o`" ?\e,Ar\e(B)
- ("O'" ?\e,AS\e(B)
- ("o'" ?\e,As\e(B)
- ("O^" ?\e,AT\e(B)
- ("o^" ?\e,At\e(B)
- ("O~" ?\e,AU\e(B)
- ("o~" ?\e,Au\e(B)
- ("O\"" ?\e,AV\e(B)
- ("o\"" ?\e,Av\e(B)
- ("O/" ?\e,AX\e(B)
- ("o/" ?\e,Ax\e(B)
- ("U`" ?\e,AY\e(B)
- ("u`" ?\e,Ay\e(B)
- ("U'" ?\e,AZ\e(B)
- ("u'" ?\e,Az\e(B)
- ("U^" ?\e,A[\e(B)
- ("u^" ?\e,A{\e(B)
- ("U\"" ?\e,A\\e(B)
- ("u\"" ?\e,A|\e(B)
- ("Y'" ?\e,A]\e(B)
- ("y'" ?\e,A}\e(B)
- ("y\"" ?\e,A\7f\e(B)
- ("D/" ?\e,AP\e(B)
- ("d/" ?\e,Ap\e(B)
- ("T/" ?\e,A^\e(B)
- ("t/" ?\e,A~\e(B)
- ("s/" ?\e,A_\e(B)
- ("C/" ?\e,AG\e(B)
- ("c/" ?\e,Ag\e(B)
- ("N~" ?\e,AQ\e(B)
- ("n~" ?\e,Aq\e(B)
- ("?/" ?\e,A?\e(B)
- ("!/" ?\e,A!\e(B)
- ("<<" ?\e,A+\e(B)
- (">>" ?\e,A;\e(B)
- ("o_" ?\e,A:\e(B)
- ("a_" ?\e,A*\e(B)
+ ("A`" ?À)
+ ("A'" ?Ã)
+ ("A^" ?Â)
+ ("A~" ?Ã)
+ ("A\"" ?Ä)
+ ("A/" ?Ã…)
+ ("a`" ?Ã )
+ ("a'" ?á)
+ ("a^" ?â)
+ ("a~" ?ã)
+ ("a\"" ?ä)
+ ("a/" ?Ã¥)
+ ("E`" ?È)
+ ("E'" ?É)
+ ("E^" ?Ê)
+ ("E\"" ?Ë)
+ ("E/" ?Æ)
+ ("e`" ?è)
+ ("e'" ?é)
+ ("e^" ?ê)
+ ("e\"" ?ë)
+ ("e/" ?æ)
+ ("I`" ?Ì)
+ ("i`" ?ì)
+ ("I'" ?Ã)
+ ("i'" ?Ã)
+ ("I^" ?ÃŽ)
+ ("i^" ?î)
+ ("I\"" ?Ã)
+ ("i\"" ?ï)
+ ("O`" ?Ã’)
+ ("o`" ?ò)
+ ("O'" ?Ó)
+ ("o'" ?ó)
+ ("O^" ?Ô)
+ ("o^" ?ô)
+ ("O~" ?Õ)
+ ("o~" ?õ)
+ ("O\"" ?Ö)
+ ("o\"" ?ö)
+ ("O/" ?Ø)
+ ("o/" ?ø)
+ ("U`" ?Ù)
+ ("u`" ?ù)
+ ("U'" ?Ú)
+ ("u'" ?ú)
+ ("U^" ?Û)
+ ("u^" ?û)
+ ("U\"" ?Ü)
+ ("u\"" ?ü)
+ ("Y'" ?Ã)
+ ("y'" ?ý)
+ ("y\"" ?ÿ)
+ ("D/" ?Ã)
+ ("d/" ?ð)
+ ("T/" ?Þ)
+ ("t/" ?þ)
+ ("s/" ?ß)
+ ("C/" ?Ç)
+ ("c/" ?ç)
+ ("N~" ?Ñ)
+ ("n~" ?ñ)
+ ("?/" ?¿)
+ ("!/" ?¡)
+ ("<<" ?«)
+ (">>" ?»)
+ ("o_" ?º)
+ ("a_" ?ª)
("A``" ["A`"])
("A''" ["A'"])
| postfix | examples
------------+---------+----------
- acute | ' | a' -> \e,Ba\e(B
- ogonek | ` | a` -> \e,B1\e(B
- diaeresis | \" | a\" -> \e,Bd\e(B
- circumflex | ^ | a^ -> \e,Bb\e(B
- breve | ~ | a~ -> \e,Bc\e(B
- cedilla | ` | c` -> \e,Bg\e(B
- caron | ~ | c~ -> \e,Bh\e(B
- dbl. acute | : | o: -> \e,Bu\e(B
- ring | ` | u` -> \e,By\e(B
- dot | ` | z` -> \e,B?\e(B
- stroke | / | d/ -> \e,Bp\e(B
- others | / | s/ -> \e,B_\e(B
+ acute | ' | a' -> á
+ ogonek | ` | a` -> Ä…
+ diaeresis | \" | a\" -> ä
+ circumflex | ^ | a^ -> â
+ breve | ~ | a~ -> ă
+ cedilla | ` | c` -> ç
+ caron | ~ | c~ -> Ä
+ dbl. acute | : | o: -> Å‘
+ ring | ` | u` -> ů
+ dot | ` | z` -> ż
+ stroke | / | d/ -> Ä‘
+ others | / | s/ -> ß
It seems natural to use period and comma for dots/rings and
cedillas/ogoneks, but that is inconvenient in practice, because
" nil t nil nil nil nil nil nil nil nil t)
(quail-define-rules
- ("A'" ?\e,BA\e(B)
- ("A`" ?\e,B!\e(B)
- ("A\"" ?\e,BD\e(B)
- ("A^" ?\e,BB\e(B)
- ("A~" ?\e,BC\e(B)
- ("C'" ?\e,BF\e(B)
- ("C`" ?\e,BG\e(B)
- ("C~" ?\e,BH\e(B)
- ("D/" ?\e,BP\e(B)
- ("D~" ?\e,BO\e(B)
- ("E'" ?\e,BI\e(B)
- ("E`" ?\e,BJ\e(B)
- ("E\"" ?\e,BK\e(B)
- ("E~" ?\e,BL\e(B)
- ("I'" ?\e,BM\e(B)
- ("I^" ?\e,BN\e(B)
- ("L'" ?\e,BE\e(B)
- ("L/" ?\e,B#\e(B)
- ("L~" ?\e,B%\e(B)
- ("N'" ?\e,BQ\e(B)
- ("N~" ?\e,BR\e(B)
- ("O'" ?\e,BS\e(B)
- ("O:" ?\e,BU\e(B)
- ("O\"" ?\e,BV\e(B)
- ("O^" ?\e,BT\e(B)
- ("R'" ?\e,B@\e(B)
- ("R~" ?\e,BX\e(B)
- ("S'" ?\e,B&\e(B)
- ("S`" ?\e,B*\e(B)
- ("S~" ?\e,B)\e(B)
- ("T`" ?\e,B^\e(B)
- ("T~" ?\e,B+\e(B)
- ("U'" ?\e,BZ\e(B)
- ("U:" ?\e,B[\e(B)
- ("U\"" ?\e,B\\e(B)
- ("U`" ?\e,BY\e(B)
- ("Y'" ?\e,B]\e(B)
- ("Z'" ?\e,B,\e(B)
- ("Z`" ?\e,B/\e(B)
- ("Z~" ?\e,B.\e(B)
- ("a'" ?\e,Ba\e(B)
- ("a`" ?\e,B1\e(B)
- ("a\"" ?\e,Bd\e(B)
- ("a^" ?\e,Bb\e(B)
- ("a~" ?\e,Bc\e(B)
- ("c'" ?\e,Bf\e(B)
- ("c`" ?\e,Bg\e(B)
- ("c~" ?\e,Bh\e(B)
- ("d/" ?\e,Bp\e(B)
- ("d~" ?\e,Bo\e(B)
- ("e'" ?\e,Bi\e(B)
- ("e`" ?\e,Bj\e(B)
- ("e\"" ?\e,Bk\e(B)
- ("e~" ?\e,Bl\e(B)
- ("i'" ?\e,Bm\e(B)
- ("i^" ?\e,Bn\e(B)
- ("l'" ?\e,Be\e(B)
- ("l/" ?\e,B3\e(B)
- ("l~" ?\e,B5\e(B)
- ("n'" ?\e,Bq\e(B)
- ("n~" ?\e,Br\e(B)
- ("o'" ?\e,Bs\e(B)
- ("o:" ?\e,Bu\e(B)
- ("o\"" ?\e,Bv\e(B)
- ("o^" ?\e,Bt\e(B)
- ("r'" ?\e,B`\e(B)
- ("r~" ?\e,Bx\e(B)
- ("s'" ?\e,B6\e(B)
- ("s`" ?\e,B:\e(B)
- ("s/" ?\e,B_\e(B)
- ("s~" ?\e,B9\e(B)
- ("t`" ?\e,B~\e(B)
- ("t~" ?\e,B;\e(B)
- ("u'" ?\e,Bz\e(B)
- ("u:" ?\e,B{\e(B)
- ("u\"" ?\e,B|\e(B)
- ("u`" ?\e,By\e(B)
- ("y'" ?\e,B}\e(B)
- ("z'" ?\e,B<\e(B)
- ("z`" ?\e,B?\e(B)
- ("z~" ?\e,B>\e(B)
+ ("A'" ?Ã)
+ ("A`" ?Ä„)
+ ("A\"" ?Ä)
+ ("A^" ?Â)
+ ("A~" ?Ä‚)
+ ("C'" ?Ć)
+ ("C`" ?Ç)
+ ("C~" ?Č)
+ ("D/" ?Ä)
+ ("D~" ?ÄŽ)
+ ("E'" ?É)
+ ("E`" ?Ę)
+ ("E\"" ?Ë)
+ ("E~" ?Äš)
+ ("I'" ?Ã)
+ ("I^" ?ÃŽ)
+ ("L'" ?Ĺ)
+ ("L/" ?Å)
+ ("L~" ?Ľ)
+ ("N'" ?Ń)
+ ("N~" ?Ň)
+ ("O'" ?Ó)
+ ("O:" ?Å)
+ ("O\"" ?Ö)
+ ("O^" ?Ô)
+ ("R'" ?Å”)
+ ("R~" ?Ř)
+ ("S'" ?Åš)
+ ("S`" ?Åž)
+ ("S~" ?Å )
+ ("T`" ?Å¢)
+ ("T~" ?Ť)
+ ("U'" ?Ú)
+ ("U:" ?Å°)
+ ("U\"" ?Ü)
+ ("U`" ?Å®)
+ ("Y'" ?Ã)
+ ("Z'" ?Ź)
+ ("Z`" ?Å»)
+ ("Z~" ?Ž)
+ ("a'" ?á)
+ ("a`" ?Ä…)
+ ("a\"" ?ä)
+ ("a^" ?â)
+ ("a~" ?ă)
+ ("c'" ?ć)
+ ("c`" ?ç)
+ ("c~" ?Ä)
+ ("d/" ?Ä‘)
+ ("d~" ?Ä)
+ ("e'" ?é)
+ ("e`" ?Ä™)
+ ("e\"" ?ë)
+ ("e~" ?Ä›)
+ ("i'" ?Ã)
+ ("i^" ?î)
+ ("l'" ?ĺ)
+ ("l/" ?Å‚)
+ ("l~" ?ľ)
+ ("n'" ?Å„)
+ ("n~" ?ň)
+ ("o'" ?ó)
+ ("o:" ?Å‘)
+ ("o\"" ?ö)
+ ("o^" ?ô)
+ ("r'" ?Å•)
+ ("r~" ?Å™)
+ ("s'" ?Å›)
+ ("s`" ?ÅŸ)
+ ("s/" ?ß)
+ ("s~" ?Å¡)
+ ("t`" ?Å£)
+ ("t~" ?Å¥)
+ ("u'" ?ú)
+ ("u:" ?ű)
+ ("u\"" ?ü)
+ ("u`" ?ů)
+ ("y'" ?ý)
+ ("z'" ?ź)
+ ("z`" ?ż)
+ ("z~" ?ž)
("A''" ["A'"])
("A``" ["A`"])
| postfix | examples
------------+---------+----------
- acute | ' | a' -> \e,Ca\e(B
- grave | ` | a` -> \e,C`\e(B
- circumflex | ^ | a^ -> \e,Cb\e(B
- diaeresis | \" | a\" -> \e,Cd\e(B
- dot | / | c/ -> \e,Ce\e(B i/ -> \e,C9\e(B I/ -> \e,C)\e(B
- cedilla | ` | c` -> \e,Cg\e(B
- breve | ~ | g~ -> \e,C;\e(B
- tilde | ~ | n~ -> \e,Cq\e(B
- stroke | / | h/ -> \e,C1\e(B
- others | / | s/ -> \e,C_\e(B
+ acute | ' | a' -> á
+ grave | ` | a` -> Ã
+ circumflex | ^ | a^ -> â
+ diaeresis | \" | a\" -> ä
+ dot | / | c/ -> ċ i/ -> ı I/ -> İ
+ cedilla | ` | c` -> ç
+ breve | ~ | g~ -> ÄŸ
+ tilde | ~ | n~ -> ñ
+ stroke | / | h/ -> ħ
+ others | / | s/ -> ß
It would be natural to use period and comma for dots and cedillas, but
that would inconvenient in practice, because periods and commas are
" nil t nil nil nil nil nil nil nil nil t)
(quail-define-rules
- ("A`" ?\e,C@\e(B)
- ("A'" ?\e,CA\e(B)
- ("A^" ?\e,CB\e(B)
- ("A\"" ?\e,CD\e(B)
- ("C/" ?\e,CE\e(B)
- ("C^" ?\e,CF\e(B)
- ("C`" ?\e,CG\e(B)
- ("E`" ?\e,CH\e(B)
- ("E'" ?\e,CI\e(B)
- ("E^" ?\e,CJ\e(B)
- ("E\"" ?\e,CK\e(B)
- ("G~" ?\e,C+\e(B)
- ("G/" ?\e,CU\e(B)
- ("G^" ?\e,CX\e(B)
- ("H/" ?\e,C!\e(B)
- ("H^" ?\e,C&\e(B)
- ("I/" ?\e,C)\e(B)
- ("I`" ?\e,CL\e(B)
- ("I'" ?\e,CM\e(B)
- ("I^" ?\e,CN\e(B)
- ("I\"" ?\e,CO\e(B)
- ("J^" ?\e,C,\e(B)
- ("N~" ?\e,CQ\e(B)
- ("O`" ?\e,CR\e(B)
- ("O'" ?\e,CS\e(B)
- ("O^" ?\e,CT\e(B)
- ("O\"" ?\e,CV\e(B)
- ("S`" ?\e,C*\e(B)
- ("S^" ?\e,C^\e(B)
- ("U`" ?\e,CY\e(B)
- ("U'" ?\e,CZ\e(B)
- ("U^" ?\e,C[\e(B)
- ("U\"" ?\e,C\\e(B)
- ("U~" ?\e,C]\e(B)
- ("Z/" ?\e,C/\e(B)
- ("a`" ?\e,C`\e(B)
- ("a'" ?\e,Ca\e(B)
- ("a^" ?\e,Cb\e(B)
- ("a\"" ?\e,Cd\e(B)
- ("c/" ?\e,Ce\e(B)
- ("c^" ?\e,Cf\e(B)
- ("c`" ?\e,Cg\e(B)
- ("e`" ?\e,Ch\e(B)
- ("e'" ?\e,Ci\e(B)
- ("e^" ?\e,Cj\e(B)
- ("e\"" ?\e,Ck\e(B)
- ("g~" ?\e,C;\e(B)
- ("g/" ?\e,Cu\e(B)
- ("g^" ?\e,Cx\e(B)
- ("h/" ?\e,C1\e(B)
- ("h^" ?\e,C6\e(B)
- ("i/" ?\e,C9\e(B)
- ("i`" ?\e,Cl\e(B)
- ("i'" ?\e,Cm\e(B)
- ("i^" ?\e,Cn\e(B)
- ("i\"" ?\e,Co\e(B)
- ("j^" ?\e,C<\e(B)
- ("n~" ?\e,Cq\e(B)
- ("o`" ?\e,Cr\e(B)
- ("o'" ?\e,Cs\e(B)
- ("o^" ?\e,Ct\e(B)
- ("o\"" ?\e,Cv\e(B)
- ("s`" ?\e,C:\e(B)
- ("s/" ?\e,C_\e(B)
- ("s^" ?\e,C~\e(B)
- ("u`" ?\e,Cy\e(B)
- ("u'" ?\e,Cz\e(B)
- ("u^" ?\e,C{\e(B)
- ("u\"" ?\e,C|\e(B)
- ("u~" ?\e,C}\e(B)
- ("z/" ?\e,C?\e(B)
+ ("A`" ?À)
+ ("A'" ?Ã)
+ ("A^" ?Â)
+ ("A\"" ?Ä)
+ ("C/" ?ÄŠ)
+ ("C^" ?Ĉ)
+ ("C`" ?Ç)
+ ("E`" ?È)
+ ("E'" ?É)
+ ("E^" ?Ê)
+ ("E\"" ?Ë)
+ ("G~" ?Äž)
+ ("G/" ?Ä )
+ ("G^" ?Ĝ)
+ ("H/" ?Ħ)
+ ("H^" ?Ĥ)
+ ("I/" ?Ä°)
+ ("I`" ?Ì)
+ ("I'" ?Ã)
+ ("I^" ?ÃŽ)
+ ("I\"" ?Ã)
+ ("J^" ?Ä´)
+ ("N~" ?Ñ)
+ ("O`" ?Ã’)
+ ("O'" ?Ó)
+ ("O^" ?Ô)
+ ("O\"" ?Ö)
+ ("S`" ?Åž)
+ ("S^" ?Ŝ)
+ ("U`" ?Ù)
+ ("U'" ?Ú)
+ ("U^" ?Û)
+ ("U\"" ?Ü)
+ ("U~" ?Ŭ)
+ ("Z/" ?Å»)
+ ("a`" ?Ã )
+ ("a'" ?á)
+ ("a^" ?â)
+ ("a\"" ?ä)
+ ("c/" ?Ä‹)
+ ("c^" ?ĉ)
+ ("c`" ?ç)
+ ("e`" ?è)
+ ("e'" ?é)
+ ("e^" ?ê)
+ ("e\"" ?ë)
+ ("g~" ?ÄŸ)
+ ("g/" ?Ä¡)
+ ("g^" ?Ä)
+ ("h/" ?ħ)
+ ("h^" ?Ä¥)
+ ("i/" ?ı)
+ ("i`" ?ì)
+ ("i'" ?Ã)
+ ("i^" ?î)
+ ("i\"" ?ï)
+ ("j^" ?ĵ)
+ ("n~" ?ñ)
+ ("o`" ?ò)
+ ("o'" ?ó)
+ ("o^" ?ô)
+ ("o\"" ?ö)
+ ("s`" ?ÅŸ)
+ ("s/" ?ß)
+ ("s^" ?Å)
+ ("u`" ?ù)
+ ("u'" ?ú)
+ ("u^" ?û)
+ ("u\"" ?ü)
+ ("u~" ?Å)
+ ("z/" ?ż)
("A``" ["A`"])
("A''" ["A'"])
| postfix | examples
------------+---------+----------
- acute | ' | a' -> \e,Da\e(B
- circumflex | ^ | a^ -> \e,Db\e(B
- diaeresis | \" | a\" -> \e,Dd\e(B
- ogonek | ` | a` -> \e,D1\e(B
- macron | - | a- -> \e,D`\e(B
- tilde | ~ | a~ -> \e,Dc\e(B
- caron | ~ | c~ -> \e,Dh\e(B
- dot | ~ | e~ -> \e,Dl\e(B
- cedilla | ` | k` -> \e,Ds\e(B g` -> \e,D;\e(B
- stroke | / | d/ -> \e,Dp\e(B
- nordic | / | a/ -> \e,De\e(B e/ -> \e,Df\e(B o/ -> \e,Dx\e(B
- others | / | s/ -> \e,D_\e(B n/ -> \e,D?\e(B k/ -> \e,D"\e(B
+ acute | ' | a' -> á
+ circumflex | ^ | a^ -> â
+ diaeresis | \" | a\" -> ä
+ ogonek | ` | a` -> Ä…
+ macron | - | a- -> Ä
+ tilde | ~ | a~ -> ã
+ caron | ~ | c~ -> Ä
+ dot | ~ | e~ -> Ä—
+ cedilla | ` | k` -> ķ g` -> ģ
+ stroke | / | d/ -> Ä‘
+ nordic | / | a/ -> å e/ -> æ o/ -> ø
+ others | / | s/ -> ß n/ -> ŋ k/ -> ĸ
It seems natural to use period and comma for dots and
cedillas/ogoneks, but that is inconvenient in practice, because
" nil t nil nil nil nil nil nil nil nil t)
(quail-define-rules
- ("A`" ?\e,D!\e(B)
- ("A-" ?\e,D@\e(B)
- ("A'" ?\e,DA\e(B)
- ("A^" ?\e,DB\e(B)
- ("A~" ?\e,DC\e(B)
- ("A\"" ?\e,DD\e(B)
- ("A/" ?\e,DE\e(B)
- ("C~" ?\e,DH\e(B)
- ("D/" ?\e,DP\e(B)
- ("E/" ?\e,DF\e(B)
- ("E-" ?\e,D*\e(B)
- ("E'" ?\e,DI\e(B)
- ("E`" ?\e,DJ\e(B)
- ("E\"" ?\e,DK\e(B)
- ("E~" ?\e,DL\e(B)
- ("G`" ?\e,D+\e(B)
- ("I~" ?\e,D%\e(B)
- ("I`" ?\e,DG\e(B)
- ("I'" ?\e,DM\e(B)
- ("I^" ?\e,DN\e(B)
- ("I-" ?\e,DO\e(B)
- ("K`" ?\e,DS\e(B)
- ("L`" ?\e,D&\e(B)
- ("N/" ?\e,D=\e(B)
- ("N`" ?\e,DQ\e(B)
- ("O-" ?\e,DR\e(B)
- ("O^" ?\e,DT\e(B)
- ("O~" ?\e,DU\e(B)
- ("O\"" ?\e,DV\e(B)
- ("O/" ?\e,DX\e(B)
- ("R`" ?\e,D#\e(B)
- ("S~" ?\e,D)\e(B)
- ("T/" ?\e,D,\e(B)
- ("U`" ?\e,DY\e(B)
- ("U'" ?\e,DZ\e(B)
- ("U^" ?\e,D[\e(B)
- ("U\"" ?\e,D\\e(B)
- ("U~" ?\e,D]\e(B)
- ("U-" ?\e,D^\e(B)
- ("Z~" ?\e,D.\e(B)
- ("a`" ?\e,D1\e(B)
- ("a-" ?\e,D`\e(B)
- ("a'" ?\e,Da\e(B)
- ("a^" ?\e,Db\e(B)
- ("a~" ?\e,Dc\e(B)
- ("a\"" ?\e,Dd\e(B)
- ("a/" ?\e,De\e(B)
- ("c~" ?\e,Dh\e(B)
- ("d/" ?\e,Dp\e(B)
- ("e/" ?\e,Df\e(B)
- ("e-" ?\e,D:\e(B)
- ("e'" ?\e,Di\e(B)
- ("e`" ?\e,Dj\e(B)
- ("e\"" ?\e,Dk\e(B)
- ("e~" ?\e,Dl\e(B)
- ("g`" ?\e,D;\e(B)
- ("i~" ?\e,D5\e(B)
- ("i`" ?\e,Dg\e(B)
- ("i'" ?\e,Dm\e(B)
- ("i^" ?\e,Dn\e(B)
- ("i-" ?\e,Do\e(B)
- ("k/" ?\e,D"\e(B)
- ("k`" ?\e,Ds\e(B)
- ("l`" ?\e,D6\e(B)
- ("n/" ?\e,D?\e(B)
- ("n`" ?\e,Dq\e(B)
- ("o-" ?\e,Dr\e(B)
- ("o^" ?\e,Dt\e(B)
- ("o~" ?\e,Du\e(B)
- ("o\"" ?\e,Dv\e(B)
- ("o/" ?\e,Dx\e(B)
- ("r`" ?\e,D3\e(B)
- ("s/" ?\e,D_\e(B)
- ("s~" ?\e,D9\e(B)
- ("t/" ?\e,D<\e(B)
- ("u`" ?\e,Dy\e(B)
- ("u'" ?\e,Dz\e(B)
- ("u^" ?\e,D{\e(B)
- ("u\"" ?\e,D|\e(B)
- ("u~" ?\e,D}\e(B)
- ("u-" ?\e,D~\e(B)
- ("z~" ?\e,D>\e(B)
+ ("A`" ?Ä„)
+ ("A-" ?Ä€)
+ ("A'" ?Ã)
+ ("A^" ?Â)
+ ("A~" ?Ã)
+ ("A\"" ?Ä)
+ ("A/" ?Ã…)
+ ("C~" ?Č)
+ ("D/" ?Ä)
+ ("E/" ?Æ)
+ ("E-" ?Ä’)
+ ("E'" ?É)
+ ("E`" ?Ę)
+ ("E\"" ?Ë)
+ ("E~" ?Ä–)
+ ("G`" ?Ä¢)
+ ("I~" ?Ĩ)
+ ("I`" ?Ä®)
+ ("I'" ?Ã)
+ ("I^" ?ÃŽ)
+ ("I-" ?Ī)
+ ("K`" ?Ķ)
+ ("L`" ?Ä»)
+ ("N/" ?ÅŠ)
+ ("N`" ?Å…)
+ ("O-" ?Ō)
+ ("O^" ?Ô)
+ ("O~" ?Õ)
+ ("O\"" ?Ö)
+ ("O/" ?Ø)
+ ("R`" ?Å–)
+ ("S~" ?Å )
+ ("T/" ?Ŧ)
+ ("U`" ?Ų)
+ ("U'" ?Ú)
+ ("U^" ?Û)
+ ("U\"" ?Ü)
+ ("U~" ?Ũ)
+ ("U-" ?Ū)
+ ("Z~" ?Ž)
+ ("a`" ?Ä…)
+ ("a-" ?Ä)
+ ("a'" ?á)
+ ("a^" ?â)
+ ("a~" ?ã)
+ ("a\"" ?ä)
+ ("a/" ?Ã¥)
+ ("c~" ?Ä)
+ ("d/" ?Ä‘)
+ ("e/" ?æ)
+ ("e-" ?Ä“)
+ ("e'" ?é)
+ ("e`" ?Ä™)
+ ("e\"" ?ë)
+ ("e~" ?Ä—)
+ ("g`" ?Ä£)
+ ("i~" ?Ä©)
+ ("i`" ?į)
+ ("i'" ?Ã)
+ ("i^" ?î)
+ ("i-" ?Ä«)
+ ("k/" ?ĸ)
+ ("k`" ?Ä·)
+ ("l`" ?ļ)
+ ("n/" ?Å‹)
+ ("n`" ?ņ)
+ ("o-" ?Å)
+ ("o^" ?ô)
+ ("o~" ?õ)
+ ("o\"" ?ö)
+ ("o/" ?ø)
+ ("r`" ?Å—)
+ ("s/" ?ß)
+ ("s~" ?Å¡)
+ ("t/" ?ŧ)
+ ("u`" ?ų)
+ ("u'" ?ú)
+ ("u^" ?û)
+ ("u\"" ?ü)
+ ("u~" ?Å©)
+ ("u-" ?Å«)
+ ("z~" ?ž)
("A``" ["A`"])
("A--" ["A-"])
| postfix | examples
------------+---------+----------
- acute | ' | a' -> \e,Ma\e(B
- grave | ` | a` -> \e,M`\e(B
- circumflex | ^ | a^ -> \e,Mb\e(B
- diaeresis | \" | a\" -> \e,Md\e(B
- tilde | ~ | a~ -> \e,Mc\e(B
- breve | ~ | g~ -> \e,Mp\e(B
- cedilla | ` | c` -> \e,Mg\e(B
- dot | / | i/ -> \e,M}\e(B I/ -> \e,M]\e(B
- nordic | / | a/ -> \e,Me\e(B e/ -> \e,Mf\e(B o/ -> \e,Mx\e(B
- others | / | s/ -> \e,M_\e(B
+ acute | ' | a' -> á
+ grave | ` | a` -> Ã
+ circumflex | ^ | a^ -> â
+ diaeresis | \" | a\" -> ä
+ tilde | ~ | a~ -> ã
+ breve | ~ | g~ -> ÄŸ
+ cedilla | ` | c` -> ç
+ dot | / | i/ -> ı I/ -> İ
+ nordic | / | a/ -> å e/ -> æ o/ -> ø
+ others | / | s/ -> ß
It seems natural to use period and comma for dots and cedillas, but
that is inconvenient in practice, because periods and commas are
" nil t nil nil nil nil nil nil nil nil t)
(quail-define-rules
- ("A'" ?\e,MA\e(B)
- ("A/" ?\e,ME\e(B)
- ("A\"" ?\e,MD\e(B)
- ("A^" ?\e,MB\e(B)
- ("A`" ?\e,M@\e(B)
- ("A~" ?\e,MC\e(B)
- ("C`" ?\e,MG\e(B)
- ("E'" ?\e,MI\e(B)
- ("E/" ?\e,MF\e(B)
- ("E\"" ?\e,MK\e(B)
- ("E^" ?\e,MJ\e(B)
- ("E`" ?\e,MH\e(B)
- ("G~" ?\e,MP\e(B)
- ("I'" ?\e,MM\e(B)
- ("I/" ?\e,M]\e(B)
- ("I\"" ?\e,MO\e(B)
- ("I^" ?\e,MN\e(B)
- ("I`" ?\e,ML\e(B)
- ("N~" ?\e,MQ\e(B)
- ("O'" ?\e,MS\e(B)
- ("O/" ?\e,MX\e(B)
- ("O\"" ?\e,MV\e(B)
- ("O^" ?\e,MT\e(B)
- ("O`" ?\e,MR\e(B)
- ("O~" ?\e,MU\e(B)
- ("S`" ?\e,M^\e(B)
- ("U'" ?\e,MZ\e(B)
- ("U\"" ?\e,M\\e(B)
- ("U^" ?\e,M[\e(B)
- ("U`" ?\e,MY\e(B)
- ("a'" ?\e,Ma\e(B)
- ("a/" ?\e,Me\e(B)
- ("a\"" ?\e,Md\e(B)
- ("a^" ?\e,Mb\e(B)
- ("a`" ?\e,M`\e(B)
- ("a~" ?\e,Mc\e(B)
- ("c`" ?\e,Mg\e(B)
- ("e'" ?\e,Mi\e(B)
- ("e/" ?\e,Mf\e(B)
- ("e\"" ?\e,Mk\e(B)
- ("e^" ?\e,Mj\e(B)
- ("e`" ?\e,Mh\e(B)
- ("g~" ?\e,Mp\e(B)
- ("i'" ?\e,Mm\e(B)
- ("i/" ?\e,M}\e(B)
- ("i\"" ?\e,Mo\e(B)
- ("i^" ?\e,Mn\e(B)
- ("i`" ?\e,Ml\e(B)
- ("n~" ?\e,Mq\e(B)
- ("o'" ?\e,Ms\e(B)
- ("o/" ?\e,Mx\e(B)
- ("o\"" ?\e,Mv\e(B)
- ("o^" ?\e,Mt\e(B)
- ("o`" ?\e,Mr\e(B)
- ("o~" ?\e,Mu\e(B)
- ("s`" ?\e,M~\e(B)
- ("s/" ?\e,M_\e(B)
- ("u'" ?\e,Mz\e(B)
- ("u\"" ?\e,M|\e(B)
- ("u^" ?\e,M{\e(B)
- ("u`" ?\e,My\e(B)
- ("y\"" ?\e,M\7f\e(B)
+ ("A'" ?Ã)
+ ("A/" ?Ã…)
+ ("A\"" ?Ä)
+ ("A^" ?Â)
+ ("A`" ?À)
+ ("A~" ?Ã)
+ ("C`" ?Ç)
+ ("E'" ?É)
+ ("E/" ?Æ)
+ ("E\"" ?Ë)
+ ("E^" ?Ê)
+ ("E`" ?È)
+ ("G~" ?Äž)
+ ("I'" ?Ã)
+ ("I/" ?Ä°)
+ ("I\"" ?Ã)
+ ("I^" ?ÃŽ)
+ ("I`" ?Ì)
+ ("N~" ?Ñ)
+ ("O'" ?Ó)
+ ("O/" ?Ø)
+ ("O\"" ?Ö)
+ ("O^" ?Ô)
+ ("O`" ?Ã’)
+ ("O~" ?Õ)
+ ("S`" ?Åž)
+ ("U'" ?Ú)
+ ("U\"" ?Ü)
+ ("U^" ?Û)
+ ("U`" ?Ù)
+ ("a'" ?á)
+ ("a/" ?Ã¥)
+ ("a\"" ?ä)
+ ("a^" ?â)
+ ("a`" ?Ã )
+ ("a~" ?ã)
+ ("c`" ?ç)
+ ("e'" ?é)
+ ("e/" ?æ)
+ ("e\"" ?ë)
+ ("e^" ?ê)
+ ("e`" ?è)
+ ("g~" ?ÄŸ)
+ ("i'" ?Ã)
+ ("i/" ?ı)
+ ("i\"" ?ï)
+ ("i^" ?î)
+ ("i`" ?ì)
+ ("n~" ?ñ)
+ ("o'" ?ó)
+ ("o/" ?ø)
+ ("o\"" ?ö)
+ ("o^" ?ô)
+ ("o`" ?ò)
+ ("o~" ?õ)
+ ("s`" ?ÅŸ)
+ ("s/" ?ß)
+ ("u'" ?ú)
+ ("u\"" ?ü)
+ ("u^" ?û)
+ ("u`" ?ù)
+ ("y\"" ?ÿ)
("A''" ["A'"])
("A//" ["A/"])
(quail-define-package
"french-alt-postfix" "French" "FR<" t
- "French (Fran\e,Ag\e(Bais) input method with postfix modifiers
+ "French (Français) input method with postfix modifiers
-` pour grave, ' pour aigu, ^ pour circonflexe, et \" pour tr\e,Ai\e(Bma.
-Par exemple: a` -> \e,A`\e(B e' -> \e,Ai\e(B.
+` pour grave, ' pour aigu, ^ pour circonflexe, et \" pour tréma.
+Par exemple: a` -> à e' -> é.
-\e,AG\e(B, \e,A+\e(B, et \e,A;\e(B sont produits par C/, <<, et >>.
+Ç, «, et » sont produits par C/, <<, et >>.
En doublant la frappe des diacritiques, ils s'isoleront de la lettre.
Par exemple: e'' -> e'
nil t nil nil nil nil nil nil nil nil t)
(quail-define-rules
- ("A`" ?\e,A@\e(B)
- ("A^" ?\e,AB\e(B)
- ("a`" ?\e,A`\e(B)
- ("a^" ?\e,Ab\e(B)
- ("E`" ?\e,AH\e(B)
- ("E'" ?\e,AI\e(B)
- ("E^" ?\e,AJ\e(B)
- ("E\"" ?\e,AK\e(B)
- ("e`" ?\e,Ah\e(B)
- ("e'" ?\e,Ai\e(B)
- ("e^" ?\e,Aj\e(B)
- ("e\"" ?\e,Ak\e(B)
- ("I^" ?\e,AN\e(B)
- ("I\"" ?\e,AO\e(B)
- ("i^" ?\e,An\e(B)
- ("i\"" ?\e,Ao\e(B)
- ("O^" ?\e,AT\e(B)
- ("o^" ?\e,At\e(B)
- ("U`" ?\e,AY\e(B)
- ("U^" ?\e,A[\e(B)
- ("U\"" ?\e,A\\e(B)
- ("u`" ?\e,Ay\e(B)
- ("u^" ?\e,A{\e(B)
- ("u\"" ?\e,A|\e(B)
- ("C/" ?\e,AG\e(B)
- ("c/" ?\e,Ag\e(B)
- ("<<" ?\e,A+\e(B)
- (">>" ?\e,A;\e(B)
+ ("A`" ?À)
+ ("A^" ?Â)
+ ("a`" ?Ã )
+ ("a^" ?â)
+ ("E`" ?È)
+ ("E'" ?É)
+ ("E^" ?Ê)
+ ("E\"" ?Ë)
+ ("e`" ?è)
+ ("e'" ?é)
+ ("e^" ?ê)
+ ("e\"" ?ë)
+ ("I^" ?ÃŽ)
+ ("I\"" ?Ã)
+ ("i^" ?î)
+ ("i\"" ?ï)
+ ("O^" ?Ô)
+ ("o^" ?ô)
+ ("U`" ?Ù)
+ ("U^" ?Û)
+ ("U\"" ?Ü)
+ ("u`" ?ù)
+ ("u^" ?û)
+ ("u\"" ?ü)
+ ("C/" ?Ç)
+ ("c/" ?ç)
+ ("<<" ?«)
+ (">>" ?»)
("A``" ["A`"])
("A^^" ["A^"])
"italian-alt-postfix" "Latin-1" "IT<" t
"Italian (Italiano) input method with postfix modifiers
-a' -> \e,Aa\e(B A' -> \e,AA\e(B a` -> \e,A`\e(B A` -> \e,A@\e(B i^ -> \e,An\e(B << -> \e,A+\e(B
-e' -> \e,Ai\e(B E' -> \e,AI\e(B e` -> \e,Ah\e(B E` -> \e,AH\e(B I^ -> \e,AN\e(B >> -> \e,A;\e(B
-i' -> \e,Am\e(B I' -> \e,AM\e(B i` -> \e,Al\e(B I` -> \e,AL\e(B o_ -> \e,A:\e(B
-o' -> \e,As\e(B O' -> \e,AS\e(B o` -> \e,Ar\e(B O` -> \e,AR\e(B a_ -> \e,A*\e(B
-u' -> \e,Az\e(B U' -> \e,AZ\e(B u` -> \e,Ay\e(B U` -> \e,AY\e(B
+a' -> á A' -> à a` -> à A` -> À i^ -> î << -> «
+e' -> é E' -> É e` -> è E` -> È I^ -> Î >> -> »
+i' -> à I' -> à i` -> ì I` -> Ì o_ -> º
+o' -> ó O' -> Ó o` -> ò O` -> Ò a_ -> ª
+u' -> ú U' -> Ú u` -> ù U` -> Ù
This method is for purists who like accents the old way.
" nil t nil nil nil nil nil nil nil nil t)
(quail-define-rules
- ("A`" ?\e,A@\e(B)
- ("A'" ?\e,AA\e(B)
- ("a`" ?\e,A`\e(B)
- ("a'" ?\e,Aa\e(B)
- ("E`" ?\e,AH\e(B)
- ("E'" ?\e,AI\e(B)
- ("e`" ?\e,Ah\e(B)
- ("e'" ?\e,Ai\e(B)
- ("I`" ?\e,AL\e(B)
- ("i`" ?\e,Al\e(B)
- ("I'" ?\e,AM\e(B)
- ("i'" ?\e,Am\e(B)
- ("I^" ?\e,AN\e(B)
- ("i^" ?\e,An\e(B)
- ("O`" ?\e,AR\e(B)
- ("o`" ?\e,Ar\e(B)
- ("O'" ?\e,AS\e(B)
- ("o'" ?\e,As\e(B)
- ("U`" ?\e,AY\e(B)
- ("u`" ?\e,Ay\e(B)
- ("U'" ?\e,AZ\e(B)
- ("u'" ?\e,Az\e(B)
- ("<<" ?\e,A+\e(B)
- (">>" ?\e,A;\e(B)
- ("o_" ?\e,A:\e(B)
- ("a_" ?\e,A*\e(B)
+ ("A`" ?À)
+ ("A'" ?Ã)
+ ("a`" ?Ã )
+ ("a'" ?á)
+ ("E`" ?È)
+ ("E'" ?É)
+ ("e`" ?è)
+ ("e'" ?é)
+ ("I`" ?Ì)
+ ("i`" ?ì)
+ ("I'" ?Ã)
+ ("i'" ?Ã)
+ ("I^" ?ÃŽ)
+ ("i^" ?î)
+ ("O`" ?Ã’)
+ ("o`" ?ò)
+ ("O'" ?Ó)
+ ("o'" ?ó)
+ ("U`" ?Ù)
+ ("u`" ?ù)
+ ("U'" ?Ú)
+ ("u'" ?ú)
+ ("<<" ?«)
+ (">>" ?»)
+ ("o_" ?º)
+ ("a_" ?ª)
("A``" ["A`"])
("A''" ["A'"])
(quail-define-package
- "turkish-latin-3-alt-postfix" "Turkish" "TR3<<" t
- "Turkish (T\e,A|\e(Brk\e,Ag\e(Be) input method with postfix modifiers.
-This input method differs from `turkish-latin-3-postfix' in that
-comma is not special (use ` instead).
-
-This is for those who use Latin-3 (ISO-8859-3) for Turkish. If you
-use Latin-5 (ISO-8859-9), you should use \"turkish-alt-postfix\" instead.
-
-Note for I, \e,C9\e(B, \e,C)\e(B, i.
-
-A^ -> \e,CB\e(B
-C` -> \e,CG\e(B
-G^ -> \e,C+\e(B
-I -> I
-i -> \e,C9\e(B
-I/ -> \e,C)\e(B
-i/ -> i
-O\" -> \e,CV\e(B
-S` -> \e,C*\e(B
-U\" -> \e,C\\e(B
-U^ -> \e,C[\e(B
-
-Doubling the postfix separates the letter and postfix: e.g. a^^ -> a^
-" nil t nil nil nil nil nil nil nil nil t)
-
-(quail-define-rules
- ("A^" ?\e,CB\e(B)
- ("a^" ?\e,Cb\e(B)
- ("C`" ?\e,CG\e(B)
- ("c`" ?\e,Cg\e(B)
- ("G^" ?\e,C+\e(B)
- ("g^" ?\e,C;\e(B)
- ("I/" ?\e,C)\e(B)
- ("i" ?\e,C9\e(B)
- ("i/" ?i)
- ("O\"" ?\e,CV\e(B)
- ("o\"" ?\e,Cv\e(B)
- ("S`" ?\e,C*\e(B)
- ("s`" ?\e,C:\e(B)
- ("U\"" ?\e,C\\e(B)
- ("u\"" ?\e,C|\e(B)
- ("U^" ?\e,C[\e(B)
- ("u^" ?\e,C{\e(B)
-
- ("A^^" ["A^"])
- ("a^^" ["a^"])
- ("C``" ["C`"])
- ("c``" ["c`"])
- ("G^^" ["G^"])
- ("g^^" ["g^"])
- ("I//" ["I/"])
- ("i" ["i"])
- ("i//" ["i/"])
- ("O\"\"" ["O\""])
- ("o\"\"" ["o\""])
- ("S``" ["S`"])
- ("s``" ["s`"])
- ("U\"\"" ["U\""])
- ("u\"\"" ["u\""])
- ("U^^" ["U^"])
- ("u^^" ["u^"])
- )
-
-(quail-define-package
- "turkish-alt-postfix" "Turkish" "TR\e,A+\e(B" t
- "Turkish (T\e,A|\e(Brk\e,Ag\e(Be) input method with postfix modifiers.
+ "turkish-alt-postfix" "Turkish" "TR«" t
+ "Turkish (Türkçe) input method with postfix modifiers.
This input method differs from `turkish-postfix' in that
comma is not special (use ` instead).
-This is for those who use Latin-5 (ISO-8859-9) for Turkish. If you
-use Latin-3 (ISO-8859-3), you should use
-\"turkish-latin-3-alt-postfix\" instead.
+turkish-latin-3-alt-postfix is an obsolete alias for turkish-alt-postfix.
-Note for I, \e,M}\e(B, \e,M]\e(B, i.
+Note for I, ı, İ, i.
-A^ -> \e,MB\e(B
-C` -> \e,MG\e(B
-G^ -> \e,MP\e(B
+A^ -> Â
+C` -> Ç
+G^ -> Äž
I -> I
-i -> \e,M}\e(B
-I/ -> \e,M]\e(B
+i -> ı
+I/ -> Ä°
i/ -> i
-O\" -> \e,MV\e(B
-S` -> \e,M^\e(B
-U\" -> \e,M\\e(B
-U^ -> \e,M[\e(B
+O\" -> Ö
+S` -> Åž
+U\" -> Ü
+U^ -> Û
Doubling the postfix separates the letter and postfix: e.g. a^^ -> a^
" nil t nil nil nil nil nil nil nil nil t)
(quail-define-rules
- ("A^" ?\e,MB\e(B)
- ("a^" ?\e,Mb\e(B)
- ("C`" ?\e,MG\e(B)
- ("c`" ?\e,Mg\e(B)
- ("G^" ?\e,MP\e(B)
- ("g^" ?\e,Mp\e(B)
- ("I/" ?\e,M]\e(B)
- ("i" ?\e,M}\e(B)
+ ("A^" ?Â)
+ ("a^" ?â)
+ ("C`" ?Ç)
+ ("c`" ?ç)
+ ("G^" ?Äž)
+ ("g^" ?ÄŸ)
+ ("I/" ?Ä°)
+ ("i" ?ı)
("i/" ?i)
- ("O\"" ?\e,MV\e(B)
- ("o\"" ?\e,Cv\e(B)
- ("S`" ?\e,M^\e(B)
- ("s`" ?\e,M~\e(B)
- ("U\"" ?\e,M\\e(B)
- ("u\"" ?\e,M|\e(B)
- ("U^" ?\e,M[\e(B)
- ("u^" ?\e,M{\e(B)
+ ("O\"" ?Ö)
+ ("o\"" ?ö)
+ ("S`" ?Åž)
+ ("s`" ?ÅŸ)
+ ("U\"" ?Ü)
+ ("u\"" ?ü)
+ ("U^" ?Û)
+ ("u^" ?û)
("A^^" ["A^"])
("a^^" ["a^"])
("u^^" ["u^"])
)
+;; Backwards compatibility.
+(push (cons "turkish-latin-3-alt-postfix"
+ (cdr (assoc "turkish-alt-postfix" quail-package-alist)))
+ quail-package-alist)
+
;; Dutch Quail input method derived from the one in Yudit by Roman
;; Czyborra.
(quail-define-package
"dutch" "Dutch" "NL" t
"Dutch character mixfix input method.
-Uses the `mule-unicode-0100-24ff' charset to supplement Latin-1.
+Caters for French and Turkish as well as Dutch.
| | examples
------------+---------+----------
- others | | fl. -> \e$,1!R\e(B eur. -> \e$,1tL\e(B ij -> \e$,1 S\e(B IJ -> \e$,1 R\e(B
+ others | | fl. -> ƒ eur. -> € ij -> ij IJ -> IJ
------------+---------+----------
| postfix |
------------+---------+----------
- acute | ' | a' -> \e,Aa\e(B
- grave | ` | a` -> \e,A`\e(B
- circumflex | ^ | a^ -> \e,Ab\e(B
- Turkish | various | i/ -> \e$,1 Q\e(B s, -> \e$,1 \7f\e(B g^ -> \e$,1 ?\e(B I/ -> \e$,1 P\e(B
- | | S, -> \e$,1 ~\e(B G^ -> \e$,1 >\e(B
+ acute | ' | a' -> á
+ grave | ` | a` -> Ã
+ circumflex | ^ | a^ -> â
+ Turkish | various | i/ -> ı s, -> ş g^ -> ğ I/ -> İ
+ | | S, -> Åž G^ -> Äž
------------+---------+----------
| prefix |
------------+---------+----------
- diaeresis | \" | \"a -> \e,Ad\e(B
+ diaeresis | \" | \"a -> ä
Doubling the postfix separates the letter and postfix: e.g. a'' -> a'
" nil t nil nil nil nil nil nil nil nil t)
(quail-define-rules
- ("fl." ?\e$,1!R\e(B) ;; LATIN SMALL LETTER F WITH HOOK (florin currency symbol)
- ("eur." ?\e$,1tL\e(B) ;; EURO SIGN
- ;; \e$,1r|\e(BThe 25th letter of the Dutch alphabet.\e$,1r}\e(B
- ("ij" ?\e$,1 S\e(B) ;; LATIN SMALL LIGATURE IJ
- ("IJ" ?\e$,1 R\e(B) ;; LATIN CAPITAL LIGATURE IJ
- ;; \e$,1r|\e(BTrema on the second letter of vowel pair.\e$,1r}\e(B Yudit uses `:', not `"'.
- ("\"a" ?\e,Ad\e(B) ;; LATIN SMALL LETTER A WITH DIAERESIS
- ("\"e" ?\e,Ak\e(B) ;; LATIN SMALL LETTER E WITH DIAERESIS
- ("\"i" ?\e,Ao\e(B) ;; LATIN SMALL LETTER I WITH DIAERESIS
- ("\"o" ?\e,Av\e(B) ;; LATIN SMALL LETTER O WITH DIAERESIS
- ("\"u" ?\e,A|\e(B) ;; LATIN SMALL LETTER U WITH DIAERESIS
- ("\"A" ?\e,AD\e(B) ;; LATIN CAPITAL LETTER A WITH DIAERESIS
- ("\"E" ?\e,AK\e(B) ;; LATIN CAPITAL LETTER E WITH DIAERESIS
- ("\"I" ?\e,AO\e(B) ;; LATIN CAPITAL LETTER I WITH DIAERESIS
- ("\"O" ?\e,AV\e(B) ;; LATIN CAPITAL LETTER O WITH DIAERESIS
- ("\"U" ?\e,A\\e(B) ;; LATIN CAPITAL LETTER U WITH DIAERESIS
- ;; \e$,1r|\e(BAcute, marking emphasis on long vowels\e$,1r}\e(B:
- ("a'" ?\e,Aa\e(B) ;; LATIN SMALL LETTER A WITH ACUTE
- ("e'" ?\e,Ai\e(B) ;; LATIN SMALL LETTER E WITH ACUTE
- ("i'" ?\e,Am\e(B) ;; LATIN SMALL LETTER I WITH ACUTE
- ("o'" ?\e,As\e(B) ;; LATIN SMALL LETTER O WITH ACUTE
- ("u'" ?\e,Az\e(B) ;; LATIN SMALL LETTER U WITH ACUTE
- ("A'" ?\e,AA\e(B) ;; LATIN CAPITAL LETTER A WITH ACUTE
- ("E'" ?\e,AI\e(B) ;; LATIN CAPITAL LETTER E WITH ACUTE
- ("I'" ?\e,AM\e(B) ;; LATIN CAPITAL LETTER I WITH ACUTE
- ("O'" ?\e,AS\e(B) ;; LATIN CAPITAL LETTER O WITH ACUTE
- ("U'" ?\e,AZ\e(B) ;; LATIN CAPITAL LETTER U WITH ACUTE
- ;; \e$,1r|\e(BGrave, marking emphasis on short vowels\e$,1r}\e(B:
- ("a`" ?\e,A`\e(B) ;; LATIN SMALL LETTER A WITH GRAVE
- ("e`" ?\e,Ah\e(B) ;; LATIN SMALL LETTER E WITH GRAVE
- ("i`" ?\e,Al\e(B) ;; LATIN SMALL LETTER I WITH GRAVE
- ("o`" ?\e,Ar\e(B) ;; LATIN SMALL LETTER O WITH GRAVE
- ("u`" ?\e,Ay\e(B) ;; LATIN SMALL LETTER U WITH GRAVE
- ("A`" ?\e,A@\e(B) ;; LATIN CAPITAL LETTER A WITH GRAVE
- ("E`" ?\e,AH\e(B) ;; LATIN CAPITAL LETTER E WITH GRAVE
- ("I`" ?\e,AL\e(B) ;; LATIN CAPITAL LETTER I WITH GRAVE
- ("O`" ?\e,AR\e(B) ;; LATIN CAPITAL LETTER O WITH GRAVE
- ("U`" ?\e,AY\e(B) ;; LATIN CAPITAL LETTER U WITH GRAVE
- ;; \e$,1r|\e(BCater for the use of many French words and use of the circumflex
- ;; in Frisian.\e$,1r}\e(B Yudit used `;' for cedilla.
- ("c," ?\e,Ag\e(B) ;; LATIN SMALL LETTER C WITH CEDILLA
- ("C," ?\e,AG\e(B) ;; LATIN CAPITAL LETTER C WITH CEDILLA
- ("a^" ?\e,Ab\e(B) ;; LATIN SMALL LETTER A WITH CIRCUMFLEX
- ("e^" ?\e,Aj\e(B) ;; LATIN SMALL LETTER E WITH CIRCUMFLEX
- ("i^" ?\e,An\e(B) ;; LATIN SMALL LETTER I WITH CIRCUMFLEX
- ("o^" ?\e,At\e(B) ;; LATIN SMALL LETTER O WITH CIRCUMFLEX
- ("u^" ?\e,A{\e(B) ;; LATIN SMALL LETTER U WITH CIRCUMFLEX
- ("A^" ?\e,AB\e(B) ;; LATIN CAPITAL LETTER A WITH CIRCUMFLEX
- ("E^" ?\e,AJ\e(B) ;; LATIN CAPITAL LETTER E WITH CIRCUMFLEX
- ("I^" ?\e,AN\e(B) ;; LATIN CAPITAL LETTER I WITH CIRCUMFLEX
- ("O^" ?\e,AT\e(B) ;; LATIN CAPITAL LETTER O WITH CIRCUMFLEX
- ("U^" ?\e,A[\e(B) ;; LATIN CAPITAL LETTER U WITH CIRCUMFLEX
- ;; \e$,1r|\e(BFollow the example of the Dutch POSIX locale, using ISO-8859-9 to
- ;; cater to the many Turks in Dutch society.\e$,1r}\e(B Perhaps German methods
+ ("fl." ?Æ’) ;; LATIN SMALL LETTER F WITH HOOK (florin currency symbol)
+ ("eur." ?€) ;; EURO SIGN
+ ;; “The 25th letter of the Dutch alphabet.â€
+ ("ij" ?ij) ;; LATIN SMALL LIGATURE IJ
+ ("IJ" ?IJ) ;; LATIN CAPITAL LIGATURE IJ
+ ;; “Trema on the second letter of vowel pair.†Yudit uses `:', not `"'.
+ ("\"a" ?ä) ;; LATIN SMALL LETTER A WITH DIAERESIS
+ ("\"e" ?ë) ;; LATIN SMALL LETTER E WITH DIAERESIS
+ ("\"i" ?ï) ;; LATIN SMALL LETTER I WITH DIAERESIS
+ ("\"o" ?ö) ;; LATIN SMALL LETTER O WITH DIAERESIS
+ ("\"u" ?ü) ;; LATIN SMALL LETTER U WITH DIAERESIS
+ ("\"A" ?Ä) ;; LATIN CAPITAL LETTER A WITH DIAERESIS
+ ("\"E" ?Ë) ;; LATIN CAPITAL LETTER E WITH DIAERESIS
+ ("\"I" ?Ã) ;; LATIN CAPITAL LETTER I WITH DIAERESIS
+ ("\"O" ?Ö) ;; LATIN CAPITAL LETTER O WITH DIAERESIS
+ ("\"U" ?Ü) ;; LATIN CAPITAL LETTER U WITH DIAERESIS
+ ;; “Acute, marking emphasis on long vowelsâ€:
+ ("a'" ?á) ;; LATIN SMALL LETTER A WITH ACUTE
+ ("e'" ?é) ;; LATIN SMALL LETTER E WITH ACUTE
+ ("i'" ?Ã) ;; LATIN SMALL LETTER I WITH ACUTE
+ ("o'" ?ó) ;; LATIN SMALL LETTER O WITH ACUTE
+ ("u'" ?ú) ;; LATIN SMALL LETTER U WITH ACUTE
+ ("A'" ?Ã) ;; LATIN CAPITAL LETTER A WITH ACUTE
+ ("E'" ?É) ;; LATIN CAPITAL LETTER E WITH ACUTE
+ ("I'" ?Ã) ;; LATIN CAPITAL LETTER I WITH ACUTE
+ ("O'" ?Ó) ;; LATIN CAPITAL LETTER O WITH ACUTE
+ ("U'" ?Ú) ;; LATIN CAPITAL LETTER U WITH ACUTE
+ ;; “Grave, marking emphasis on short vowelsâ€:
+ ("a`" ?Ã ) ;; LATIN SMALL LETTER A WITH GRAVE
+ ("e`" ?è) ;; LATIN SMALL LETTER E WITH GRAVE
+ ("i`" ?ì) ;; LATIN SMALL LETTER I WITH GRAVE
+ ("o`" ?ò) ;; LATIN SMALL LETTER O WITH GRAVE
+ ("u`" ?ù) ;; LATIN SMALL LETTER U WITH GRAVE
+ ("A`" ?À) ;; LATIN CAPITAL LETTER A WITH GRAVE
+ ("E`" ?È) ;; LATIN CAPITAL LETTER E WITH GRAVE
+ ("I`" ?Ì) ;; LATIN CAPITAL LETTER I WITH GRAVE
+ ("O`" ?Ã’) ;; LATIN CAPITAL LETTER O WITH GRAVE
+ ("U`" ?Ù) ;; LATIN CAPITAL LETTER U WITH GRAVE
+ ;; “Cater for the use of many French words and use of the circumflex
+ ;; in Frisian.†Yudit used `;' for cedilla.
+ ("c," ?ç) ;; LATIN SMALL LETTER C WITH CEDILLA
+ ("C," ?Ç) ;; LATIN CAPITAL LETTER C WITH CEDILLA
+ ("a^" ?â) ;; LATIN SMALL LETTER A WITH CIRCUMFLEX
+ ("e^" ?ê) ;; LATIN SMALL LETTER E WITH CIRCUMFLEX
+ ("i^" ?î) ;; LATIN SMALL LETTER I WITH CIRCUMFLEX
+ ("o^" ?ô) ;; LATIN SMALL LETTER O WITH CIRCUMFLEX
+ ("u^" ?û) ;; LATIN SMALL LETTER U WITH CIRCUMFLEX
+ ("A^" ?Â) ;; LATIN CAPITAL LETTER A WITH CIRCUMFLEX
+ ("E^" ?Ê) ;; LATIN CAPITAL LETTER E WITH CIRCUMFLEX
+ ("I^" ?ÃŽ) ;; LATIN CAPITAL LETTER I WITH CIRCUMFLEX
+ ("O^" ?Ô) ;; LATIN CAPITAL LETTER O WITH CIRCUMFLEX
+ ("U^" ?Û) ;; LATIN CAPITAL LETTER U WITH CIRCUMFLEX
+ ;; “Follow the example of the Dutch POSIX locale, using ISO-8859-9 to
+ ;; cater to the many Turks in Dutch society.†Perhaps German methods
;; should do so too. Follow turkish-alt-postfix here.
- ("i/" ?\e$,1 Q\e(B) ;; LATIN SMALL LETTER I WITH NO DOT
- ("s," ?\e$,1 \7f\e(B) ;; LATIN SMALL LETTER S WITH CEDILLA
- ("g^" ?\e$,1 ?\e(B) ;; LATIN SMALL LETTER G WITH BREVE
- ("I/" ?\e$,1 P\e(B) ;; LATIN CAPITAL LETTER I WITH DOT ABOVE
- ("S," ?\e$,1 ~\e(B) ;; LATIN CAPITAL LETTER S WITH CEDILLA
- ("G^" ?\e$,1 >\e(B) ;; LATIN CAPITAL LETTER G WITH BREVE
+ ("i/" ?ı) ;; LATIN SMALL LETTER I WITH NO DOT
+ ("s," ?ÅŸ) ;; LATIN SMALL LETTER S WITH CEDILLA
+ ("g^" ?ÄŸ) ;; LATIN SMALL LETTER G WITH BREVE
+ ("I/" ?Ä°) ;; LATIN CAPITAL LETTER I WITH DOT ABOVE
+ ("S," ?Åž) ;; LATIN CAPITAL LETTER S WITH CEDILLA
+ ("G^" ?Äž) ;; LATIN CAPITAL LETTER G WITH BREVE
)
;; Originally from Yudit, discussed with Albertas Agejevas
" nil t t t t nil nil nil nil nil t)
(quail-define-rules
- ("1" ?\e$,1 %\e(B)
- ("2" ?\e$,1 -\e(B)
- ("3" ?\e$,1 9\e(B)
- ("4" ?\e$,1 7\e(B)
- ("5" ?\e$,1 O\e(B)
- ("6" ?\e$,1!!\e(B)
- ("7" ?\e$,1!3\e(B)
- ("8" ?\e$,1!+\e(B)
- ("9" ?\e$,1r~\e(B)
- ("0" ?\e$,1r|\e(B)
- ("=" ?\e$,1!>\e(B)
- ("!" ?\e$,1 $\e(B)
- ("@" ?\e$,1 ,\e(B)
- ("#" ?\e$,1 8\e(B)
- ("$" ?\e$,1 6\e(B)
- ("%" ?\e$,1 N\e(B)
- ("^" ?\e$,1! \e(B)
- ("&" ?\e$,1!2\e(B)
- ("*" ?\e$,1!*\e(B)
- ("+" ?\e$,1!=\e(B))
+ ("1" ?Ä…)
+ ("2" ?Ä)
+ ("3" ?Ä™)
+ ("4" ?Ä—)
+ ("5" ?į)
+ ("6" ?Å¡)
+ ("7" ?ų)
+ ("8" ?Å«)
+ ("9" ?„)
+ ("0" ?“)
+ ("=" ?ž)
+ ("!" ?Ä„)
+ ("@" ?Č)
+ ("#" ?Ę)
+ ("$" ?Ä–)
+ ("%" ?Ä®)
+ ("^" ?Å )
+ ("&" ?Ų)
+ ("*" ?Ū)
+ ("+" ?Ž))
;; From XFree 4.1 /usr/X11R6/lib/X11/xkb/symbols/lt, suggested by
;; Albertas Agejevas <alga@uosis.mif.vu.lt>
" nil t t t t nil nil nil nil nil t)
(quail-define-rules
- ("1" ?\e$,1 %\e(B)
- ("!" ?\e$,1 $\e(B)
- ("2" ?\e$,1 -\e(B)
- ("@" ?\e$,1 ,\e(B)
- ("#" ?\e$,1 8\e(B)
- ("4" ?\e$,1 7\e(B)
- ("$" ?\e$,1 6\e(B)
- ("5" ?\e$,1 O\e(B)
- ("%" ?\e$,1 N\e(B)
- ("6" ?\e$,1!!\e(B)
- ("^" ?\e$,1! \e(B)
- ("7" ?\e$,1!3\e(B)
- ("&" ?\e$,1!2\e(B)
- ("9" ?\e$,1r~\e(B)
- ("0" ?\e$,1r|\e(B)
- ("=" ?\e$,1!>\e(B)
- ("+" ?\e$,1!=\e(B))
+ ("1" ?Ä…)
+ ("!" ?Ä„)
+ ("2" ?Ä)
+ ("@" ?Č)
+ ("#" ?Ę)
+ ("4" ?Ä—)
+ ("$" ?Ä–)
+ ("5" ?į)
+ ("%" ?Ä®)
+ ("6" ?Å¡)
+ ("^" ?Å )
+ ("7" ?ų)
+ ("&" ?Ų)
+ ("9" ?„)
+ ("0" ?“)
+ ("=" ?ž)
+ ("+" ?Ž))
;; From XFree 4.1 /usr/X11R6/lib/X11/xkb/symbols/lv
(quail-define-package
" nil t t t t nil nil nil nil nil t)
(quail-define-rules
- ("4" ?\e$,1tL\e(B)
- ("$" ?\e,A"\e(B)
- ("e" ?\e$,1 3\e(B)
- ("E" ?\e$,1 2\e(B)
- ("r" ?\e$,1 w\e(B)
- ("R" ?\e$,1 v\e(B)
- ("u" ?\e$,1!+\e(B)
- ("U" ?\e$,1!*\e(B)
- ("i" ?\e$,1 K\e(B)
- ("I" ?\e$,1 J\e(B)
- ("o" ?\e$,1 m\e(B)
- ("O" ?\e$,1 l\e(B)
- ("a" ?\e$,1 !\e(B)
- ("A" ?\e$,1 \e(B)
- ("s" ?\e$,1!!\e(B)
- ("S" ?\e$,1! \e(B)
- ("g" ?\e$,1 C\e(B)
- ("G" ?\e$,1 B\e(B)
- ("k" ?\e$,1 W\e(B)
- ("K" ?\e$,1 V\e(B)
- ("l" ?\e$,1 \\e(B)
- ("L" ?\e$,1 [\e(B)
- ("\'" ?\e$,1r|\e(B)
- ("\"" ?\e$,1r~\e(B)
- ("z" ?\e$,1!>\e(B)
- ("Z" ?\e$,1!=\e(B)
- ("c" ?\e$,1 -\e(B)
- ("C" ?\e$,1 ,\e(B)
- ("n" ?\e$,1 f\e(B)
- ("N" ?\e$,1 e\e(B))
+ ("4" ?€)
+ ("$" ?¢)
+ ("e" ?Ä“)
+ ("E" ?Ä’)
+ ("r" ?Å—)
+ ("R" ?Å–)
+ ("u" ?Å«)
+ ("U" ?Ū)
+ ("i" ?Ä«)
+ ("I" ?Ī)
+ ("o" ?Å)
+ ("O" ?Ō)
+ ("a" ?Ä)
+ ("A" ?Ä€)
+ ("s" ?Å¡)
+ ("S" ?Å )
+ ("g" ?Ä£)
+ ("G" ?Ä¢)
+ ("k" ?Ä·)
+ ("K" ?Ķ)
+ ("l" ?ļ)
+ ("L" ?Ä»)
+ ("\'" ?“)
+ ("\"" ?„)
+ ("z" ?ž)
+ ("Z" ?Ž)
+ ("c" ?Ä)
+ ("C" ?Č)
+ ("n" ?ņ)
+ ("N" ?Å…))
(quail-define-package
"latin-alt-postfix" "Latin" "L<" t
| postfix | examples
------------+---------+----------
- acute | ' | a' -> \e,Aa\e(B
- grave | ` | a` -> \e,A`\e(B
- circumflex | ^ | a^ -> \e,Ab\e(B
- diaeresis | \" | a\" -> \e,Ad\e(B
- tilde | ~ | a~ -> \e,Ac\e(B
- cedilla | /` | c/ -> \e,Ag\e(B c` -> \e,Ag\e(B
- ogonek | ` | a` -> \e$,1 %\e(B
- breve | ~ | a~ -> \e$,1 #\e(B
- caron | ~ | c~ -> \e$,1 -\e(B
- dbl. acute | : | o: -> \e$,1 q\e(B
- ring | ` | u` -> \e$,1!/\e(B
- dot | ` | z` -> \e$,1!<\e(B
- stroke | / | d/ -> \e$,1 1\e(B
- nordic | / | d/ -> \e,Ap\e(B t/ -> \e,A~\e(B a/ -> \e,Ae\e(B e/ -> \e,Af\e(B o/ -> \e,Ax\e(B
- others | /<> | s/ -> \e,A_\e(B ?/ -> \e,A?\e(B !/ -> \e,A!\e(B
- | various | << -> \e,A+\e(B >> -> \e,A;\e(B o_ -> \e,A:\e(B a_ -> \e,A*\e(B
+ acute | ' | a' -> á
+ grave | ` | a` -> Ã
+ circumflex | ^ | a^ -> â
+ diaeresis | \" | a\" -> ä
+ tilde | ~ | a~ -> ã
+ cedilla | /` | c/ -> ç c` -> ç
+ ogonek | ` | a` -> Ä…
+ breve | ~ | a~ -> ă
+ caron | ~ | c~ -> Ä
+ dbl. acute | : | o: -> Å‘
+ ring | ` | u` -> ů
+ dot | ` | z` -> ż
+ stroke | / | d/ -> Ä‘
+ nordic | / | d/ -> ð t/ -> þ a/ -> å e/ -> æ o/ -> ø
+ others | /<> | s/ -> ß ?/ -> ¿ !/ -> ¡
+ | various | << -> « >> -> » o_ -> º a_ -> ª
It would be natural to use comma for cedillas, but that would be
inconvenient in practice because commas are needed very often after a
Doubling the postfix separates the letter and postfix: e.g. a'' -> a'
" nil t nil nil nil nil nil nil nil nil t)
-;; Fixme: \e,A&\e(B \e,A'\e(B \e,A(\e(B \e,A)\e(B \e,A,\e(B \e,A-\e(B \e,A.\e(B \e,A/\e(B \e,A0\e(B \e,A1\e(B \e,A2\e(B \e,A3\e(B \e,A4\e(B \e,A5\e(B \e,A6\e(B \e,A7\e(B \e,A8\e(B \e,A9\e(B \e,A<\e(B \e,A=\e(B \e,A>\e(B \e,AW\e(B \e,Aw\e(B
+;; Fixme: ¦ § ¨ © ¬  ® ¯ ° ± ² ³ ´ µ ¶ · ¸ ¹ ¼ ½ ¾ × ÷
(quail-define-rules
- (" _" ?\e,A \e(B)
- ("!/" ?\e,A!\e(B)
- ("//" ?\e,A0\e(B)
- ("<<" ?\e,A+\e(B)
- (">>" ?\e,A;\e(B)
- ("?/" ?\e,A?\e(B)
- ("$/" ?\e,A#\e(B)
- ("$/" ?\e,A$\e(B)
- ("A'" ?\e,AA\e(B)
- ("A-" ?\e$,1 \e(B)
- ("A/" ?\e,AE\e(B)
- ("A\"" ?\e,AD\e(B)
- ("A^" ?\e,AB\e(B)
- ("A`" ?\e,A@\e(B)
- ("A`" ?\e$,1 $\e(B)
- ("A~" ?\e,AC\e(B)
- ("A~" ?\e$,1 "\e(B)
- ("C'" ?\e$,1 &\e(B)
- ("C/" ?\e,AG\e(B)
- ("C/" ?\e$,1 *\e(B)
- ("C^" ?\e$,1 (\e(B)
- ("C`" ?\e,AG\e(B)
- ("C~" ?\e$,1 ,\e(B)
- ("D/" ?\e,AP\e(B)
- ("D/" ?\e$,1 0\e(B)
- ("D~" ?\e$,1 .\e(B)
- ("E'" ?\e,AI\e(B)
- ("E-" ?\e$,1 2\e(B)
- ("E/" ?\e,AF\e(B)
- ("E\"" ?\e,AK\e(B)
- ("E^" ?\e,AJ\e(B)
- ("E`" ?\e,AH\e(B)
- ("E`" ?\e$,1 8\e(B)
- ("E~" ?\e$,1 6\e(B)
- ("E~" ?\e$,1 :\e(B)
- ("G/" ?\e$,1 @\e(B)
- ("G^" ?\e$,1 <\e(B)
- ("G`" ?\e$,1 B\e(B)
- ("G~" ?\e$,1 >\e(B)
- ("H/" ?\e$,1 F\e(B)
- ("H^" ?\e$,1 D\e(B)
- ("I'" ?\e,AM\e(B)
- ("I-" ?\e$,1 J\e(B)
- ("I/" ?\e$,1 P\e(B)
- ("I\"" ?\e,AO\e(B)
- ("I^" ?\e,AN\e(B)
- ("I`" ?\e,AL\e(B)
- ("I`" ?\e$,1 N\e(B)
- ("I~" ?\e$,1 H\e(B)
- ("J^" ?\e$,1 T\e(B)
- ("K`" ?\e$,1 V\e(B)
- ("L'" ?\e$,1 Y\e(B)
- ("L/" ?\e$,1 a\e(B)
- ("L`" ?\e$,1 [\e(B)
- ("L~" ?\e$,1 ]\e(B)
- ("N'" ?\e$,1 c\e(B)
- ("N/" ?\e$,1 j\e(B)
- ("N`" ?\e$,1 e\e(B)
- ("N~" ?\e,AQ\e(B)
- ("N~" ?\e$,1 g\e(B)
- ("O'" ?\e,AS\e(B)
- ("O-" ?\e$,1 l\e(B)
- ("O/" ?\e,AX\e(B)
- ("O:" ?\e$,1 p\e(B)
- ("O\"" ?\e,AV\e(B)
- ("O^" ?\e,AT\e(B)
- ("O`" ?\e,AR\e(B)
- ("O~" ?\e,AU\e(B)
- ("R'" ?\e$,1 t\e(B)
- ("R`" ?\e$,1 v\e(B)
- ("R~" ?\e$,1 x\e(B)
- ("S'" ?\e$,1 z\e(B)
- ("S^" ?\e$,1 |\e(B)
- ("S`" ?\e$,1 ~\e(B)
- ("S~" ?\e$,1! \e(B)
- ("T/" ?\e,A^\e(B)
- ("T/" ?\e$,1!&\e(B)
- ("T`" ?\e$,1!"\e(B)
- ("T~" ?\e$,1!$\e(B)
- ("U'" ?\e,AZ\e(B)
- ("U-" ?\e$,1!*\e(B)
- ("U:" ?\e$,1!0\e(B)
- ("U\"" ?\e,A\\e(B)
- ("U^" ?\e,A[\e(B)
- ("U`" ?\e,AY\e(B)
- ("U`" ?\e$,1!.\e(B)
- ("U`" ?\e$,1!2\e(B)
- ("U~" ?\e$,1!(\e(B)
- ("U~" ?\e$,1!,\e(B)
- ("Y'" ?\e,A]\e(B)
- ("Y\"" ?\e$,1!8\e(B)
- ("Y=" ?\e,A%\e(B)
- ("Z'" ?\e$,1!9\e(B)
- ("Z/" ?\e$,1!;\e(B)
- ("Z`" ?\e$,1!;\e(B)
- ("Z~" ?\e$,1!=\e(B)
- ("a'" ?\e,Aa\e(B)
- ("a-" ?\e$,1 !\e(B)
- ("a/" ?\e,Ae\e(B)
- ("a\"" ?\e,Ad\e(B)
- ("a^" ?\e,Ab\e(B)
- ("a_" ?\e,A*\e(B)
- ("a`" ?\e,A`\e(B)
- ("a`" ?\e$,1 %\e(B)
- ("a~" ?\e,Ac\e(B)
- ("a~" ?\e$,1 #\e(B)
- ("c'" ?\e$,1 '\e(B)
- ("c/" ?\e,Ag\e(B)
- ("c/" ?\e$,1 +\e(B)
- ("c/" ?\e,A"\e(B)
- ("c^" ?\e$,1 )\e(B)
- ("c`" ?\e,Ag\e(B)
- ("c~" ?\e$,1 -\e(B)
- ("d/" ?\e,Ap\e(B)
- ("d/" ?\e$,1 1\e(B)
- ("d~" ?\e$,1 /\e(B)
- ("e'" ?\e,Ai\e(B)
- ("e-" ?\e$,1 3\e(B)
- ("e/" ?\e,Af\e(B)
- ("e\"" ?\e,Ak\e(B)
- ("e^" ?\e,Aj\e(B)
- ("e`" ?\e,Ah\e(B)
- ("e`" ?\e$,1 9\e(B)
- ("e~" ?\e$,1 7\e(B)
- ("e~" ?\e$,1 ;\e(B)
- ("e=" ?\e$,1tL\e(B)
- ("g/" ?\e$,1 A\e(B)
- ("g^" ?\e$,1 =\e(B)
- ("g`" ?\e$,1 C\e(B)
- ("g~" ?\e$,1 ?\e(B)
- ("h/" ?\e$,1 G\e(B)
- ("h^" ?\e$,1 E\e(B)
- ("i'" ?\e,Am\e(B)
- ("i-" ?\e$,1 K\e(B)
- ("i/" ?\e$,1 Q\e(B)
- ("i\"" ?\e,Ao\e(B)
- ("i^" ?\e,An\e(B)
- ("i`" ?\e,Al\e(B)
- ("i`" ?\e$,1 O\e(B)
- ("i~" ?\e$,1 I\e(B)
- ("j^" ?\e$,1 U\e(B)
- ("k/" ?\e$,1 X\e(B)
- ("k`" ?\e$,1 W\e(B)
- ("l'" ?\e$,1 Z\e(B)
- ("l/" ?\e$,1 b\e(B)
- ("l`" ?\e$,1 \\e(B)
- ("l~" ?\e$,1 ^\e(B)
- ("n'" ?\e$,1 d\e(B)
- ("n/" ?\e$,1 k\e(B)
- ("n`" ?\e$,1 f\e(B)
- ("n~" ?\e,Aq\e(B)
- ("n~" ?\e$,1 h\e(B)
- ("o'" ?\e,As\e(B)
- ("o-" ?\e$,1 m\e(B)
- ("o/" ?\e,Ax\e(B)
- ("o:" ?\e$,1 q\e(B)
- ("o\"" ?\e,Av\e(B)
- ("o^" ?\e,At\e(B)
- ("o_" ?\e,A:\e(B)
- ("o`" ?\e,Ar\e(B)
- ("o~" ?\e,Au\e(B)
- ("r'" ?\e$,1 u\e(B)
- ("r`" ?\e$,1 w\e(B)
- ("r~" ?\e$,1 y\e(B)
- ("s'" ?\e$,1 {\e(B)
- ("s/" ?\e,A_\e(B)
- ("s^" ?\e$,1 }\e(B)
- ("s`" ?\e$,1 \7f\e(B)
- ("s~" ?\e$,1!!\e(B)
- ("t/" ?\e,A~\e(B)
- ("t/" ?\e$,1!'\e(B)
- ("t`" ?\e$,1!#\e(B)
- ("t~" ?\e$,1!%\e(B)
- ("u'" ?\e,Az\e(B)
- ("u-" ?\e$,1!+\e(B)
- ("u:" ?\e$,1!1\e(B)
- ("u\"" ?\e,A|\e(B)
- ("u^" ?\e,A{\e(B)
- ("u`" ?\e,Ay\e(B)
- ("u`" ?\e$,1!/\e(B)
- ("u`" ?\e$,1!3\e(B)
- ("u~" ?\e$,1!)\e(B)
- ("u~" ?\e$,1!-\e(B)
- ("y'" ?\e,A}\e(B)
- ("y\"" ?\e,A\7f\e(B)
- ("z'" ?\e$,1!:\e(B)
- ("z/" ?\e$,1!<\e(B)
- ("z`" ?\e$,1!<\e(B)
- ("z~" ?\e$,1!>\e(B)
+ (" _" ? )
+ ("!/" ?¡)
+ ("//" ?°)
+ ("<<" ?«)
+ (">>" ?»)
+ ("?/" ?¿)
+ ("$/" ?£)
+ ("$/" ?¤)
+ ("A'" ?Ã)
+ ("A-" ?Ä€)
+ ("A/" ?Ã…)
+ ("A\"" ?Ä)
+ ("A^" ?Â)
+ ("A`" ?À)
+ ("A`" ?Ä„)
+ ("A~" ?Ã)
+ ("A~" ?Ä‚)
+ ("C'" ?Ć)
+ ("C/" ?Ç)
+ ("C/" ?ÄŠ)
+ ("C^" ?Ĉ)
+ ("C`" ?Ç)
+ ("C~" ?Č)
+ ("D/" ?Ã)
+ ("D/" ?Ä)
+ ("D~" ?ÄŽ)
+ ("E'" ?É)
+ ("E-" ?Ä’)
+ ("E/" ?Æ)
+ ("E\"" ?Ë)
+ ("E^" ?Ê)
+ ("E`" ?È)
+ ("E`" ?Ę)
+ ("E~" ?Ä–)
+ ("E~" ?Äš)
+ ("G/" ?Ä )
+ ("G^" ?Ĝ)
+ ("G`" ?Ä¢)
+ ("G~" ?Äž)
+ ("H/" ?Ħ)
+ ("H^" ?Ĥ)
+ ("I'" ?Ã)
+ ("I-" ?Ī)
+ ("I/" ?Ä°)
+ ("I\"" ?Ã)
+ ("I^" ?ÃŽ)
+ ("I`" ?Ì)
+ ("I`" ?Ä®)
+ ("I~" ?Ĩ)
+ ("J^" ?Ä´)
+ ("K`" ?Ķ)
+ ("L'" ?Ĺ)
+ ("L/" ?Å)
+ ("L`" ?Ä»)
+ ("L~" ?Ľ)
+ ("N'" ?Ń)
+ ("N/" ?ÅŠ)
+ ("N`" ?Å…)
+ ("N~" ?Ñ)
+ ("N~" ?Ň)
+ ("O'" ?Ó)
+ ("O-" ?Ō)
+ ("O/" ?Ø)
+ ("O:" ?Å)
+ ("O\"" ?Ö)
+ ("O^" ?Ô)
+ ("O`" ?Ã’)
+ ("O~" ?Õ)
+ ("R'" ?Å”)
+ ("R`" ?Å–)
+ ("R~" ?Ř)
+ ("S'" ?Åš)
+ ("S^" ?Ŝ)
+ ("S`" ?Åž)
+ ("S~" ?Å )
+ ("T/" ?Þ)
+ ("T/" ?Ŧ)
+ ("T`" ?Å¢)
+ ("T~" ?Ť)
+ ("U'" ?Ú)
+ ("U-" ?Ū)
+ ("U:" ?Å°)
+ ("U\"" ?Ü)
+ ("U^" ?Û)
+ ("U`" ?Ù)
+ ("U`" ?Å®)
+ ("U`" ?Ų)
+ ("U~" ?Ũ)
+ ("U~" ?Ŭ)
+ ("Y'" ?Ã)
+ ("Y\"" ?Ÿ)
+ ("Y=" ?Â¥)
+ ("Z'" ?Ź)
+ ("Z/" ?Å»)
+ ("Z`" ?Å»)
+ ("Z~" ?Ž)
+ ("a'" ?á)
+ ("a-" ?Ä)
+ ("a/" ?Ã¥)
+ ("a\"" ?ä)
+ ("a^" ?â)
+ ("a_" ?ª)
+ ("a`" ?Ã )
+ ("a`" ?Ä…)
+ ("a~" ?ã)
+ ("a~" ?ă)
+ ("c'" ?ć)
+ ("c/" ?ç)
+ ("c/" ?Ä‹)
+ ("c/" ?¢)
+ ("c^" ?ĉ)
+ ("c`" ?ç)
+ ("c~" ?Ä)
+ ("d/" ?ð)
+ ("d/" ?Ä‘)
+ ("d~" ?Ä)
+ ("e'" ?é)
+ ("e-" ?Ä“)
+ ("e/" ?æ)
+ ("e\"" ?ë)
+ ("e^" ?ê)
+ ("e`" ?è)
+ ("e`" ?Ä™)
+ ("e~" ?Ä—)
+ ("e~" ?Ä›)
+ ("e=" ?€)
+ ("g/" ?Ä¡)
+ ("g^" ?Ä)
+ ("g`" ?Ä£)
+ ("g~" ?ÄŸ)
+ ("h/" ?ħ)
+ ("h^" ?Ä¥)
+ ("i'" ?Ã)
+ ("i-" ?Ä«)
+ ("i/" ?ı)
+ ("i\"" ?ï)
+ ("i^" ?î)
+ ("i`" ?ì)
+ ("i`" ?į)
+ ("i~" ?Ä©)
+ ("j^" ?ĵ)
+ ("k/" ?ĸ)
+ ("k`" ?Ä·)
+ ("l'" ?ĺ)
+ ("l/" ?Å‚)
+ ("l`" ?ļ)
+ ("l~" ?ľ)
+ ("n'" ?Å„)
+ ("n/" ?Å‹)
+ ("n`" ?ņ)
+ ("n~" ?ñ)
+ ("n~" ?ň)
+ ("o'" ?ó)
+ ("o-" ?Å)
+ ("o/" ?ø)
+ ("o:" ?Å‘)
+ ("o\"" ?ö)
+ ("o^" ?ô)
+ ("o_" ?º)
+ ("o`" ?ò)
+ ("o~" ?õ)
+ ("r'" ?Å•)
+ ("r`" ?Å—)
+ ("r~" ?Å™)
+ ("s'" ?Å›)
+ ("s/" ?ß)
+ ("s^" ?Å)
+ ("s`" ?ÅŸ)
+ ("s~" ?Å¡)
+ ("t/" ?þ)
+ ("t/" ?ŧ)
+ ("t`" ?Å£)
+ ("t~" ?Å¥)
+ ("u'" ?ú)
+ ("u-" ?Å«)
+ ("u:" ?ű)
+ ("u\"" ?ü)
+ ("u^" ?û)
+ ("u`" ?ù)
+ ("u`" ?ů)
+ ("u`" ?ų)
+ ("u~" ?Å©)
+ ("u~" ?Å)
+ ("y'" ?ý)
+ ("y\"" ?ÿ)
+ ("z'" ?ź)
+ ("z/" ?ż)
+ ("z`" ?ż)
+ ("z~" ?ž)
(" __" [" _"])
("!//" ["!/"])
-;;; latin-post.el --- Quail packages for inputting various European characters -*-coding: iso-2022-7bit;-*-
+;;; latin-post.el --- Quail packages for inputting various European characters -*-coding: utf-8;-*-
- ;; Copyright (C) 1997, 1998, 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ ;; Copyright (C) 1997, 1998, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
;; Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
- ;; 2006, 2007
+ ;; 2006, 2007, 2008
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
+;; Copyright (C) 2003
+;; National Institute of Advanced Industrial Science and Technology (AIST)
+;; Registration Number H13PRO009
-;; Keywords: multilingual, input method, latin
+;; Keywords: multilingual, input method, latin, i18n
;; This file is part of GNU Emacs.
| postfix | examples
------------+---------+----------
- acute | ' | a' -> \e,Aa\e(B
- grave | ` | a` -> \e,A`\e(B
- circumflex | ^ | a^ -> \e,Ab\e(B
- diaeresis | \" | a\" -> \e,Ad\e(B
- tilde | ~ | a~ -> \e,Ac\e(B
- cedilla | , | c, -> \e,Ag\e(B
- nordic | / | d/ -> \e,Ap\e(B t/ -> \e,A~\e(B a/ -> \e,Ae\e(B e/ -> \e,Af\e(B o/ -> \e,Ax\e(B
- others | / | s/ -> \e,A_\e(B ?/ -> \e,A?\e(B !/ -> \e,A!\e(B // -> \e,A0\e(B
- | various | << -> \e,A+\e(B >> -> \e,A;\e(B o_ -> \e,A:\e(B a_ -> \e,A*\e(B
+ acute | ' | a' -> á
+ grave | ` | a` -> Ã
+ circumflex | ^ | a^ -> â
+ diaeresis | \" | a\" -> ä
+ tilde | ~ | a~ -> ã
+ cedilla | , | c, -> ç
+ nordic | / | d/ -> ð t/ -> þ a/ -> å e/ -> æ o/ -> ø
+ others | / | s/ -> ß ?/ -> ¿ !/ -> ¡ // -> °
+ | various | << -> « >> -> » o_ -> º a_ -> ª
Doubling the postfix separates the letter and postfix: e.g. a'' -> a'
" nil t nil nil nil nil nil nil nil nil t)
(quail-define-rules
- ("A`" ?\e,A@\e(B)
- ("A'" ?\e,AA\e(B)
- ("A^" ?\e,AB\e(B)
- ("A~" ?\e,AC\e(B)
- ("A\"" ?\e,AD\e(B)
- ("A/" ?\e,AE\e(B)
- ("a`" ?\e,A`\e(B)
- ("a'" ?\e,Aa\e(B)
- ("a^" ?\e,Ab\e(B)
- ("a~" ?\e,Ac\e(B)
- ("a\"" ?\e,Ad\e(B)
- ("a/" ?\e,Ae\e(B)
- ("E`" ?\e,AH\e(B)
- ("E'" ?\e,AI\e(B)
- ("E^" ?\e,AJ\e(B)
- ("E\"" ?\e,AK\e(B)
- ("E/" ?\e,AF\e(B)
- ("e`" ?\e,Ah\e(B)
- ("e'" ?\e,Ai\e(B)
- ("e^" ?\e,Aj\e(B)
- ("e\"" ?\e,Ak\e(B)
- ("e/" ?\e,Af\e(B)
- ("I`" ?\e,AL\e(B)
- ("i`" ?\e,Al\e(B)
- ("I'" ?\e,AM\e(B)
- ("i'" ?\e,Am\e(B)
- ("I^" ?\e,AN\e(B)
- ("i^" ?\e,An\e(B)
- ("I\"" ?\e,AO\e(B)
- ("i\"" ?\e,Ao\e(B)
- ("O`" ?\e,AR\e(B)
- ("o`" ?\e,Ar\e(B)
- ("O'" ?\e,AS\e(B)
- ("o'" ?\e,As\e(B)
- ("O^" ?\e,AT\e(B)
- ("o^" ?\e,At\e(B)
- ("O~" ?\e,AU\e(B)
- ("o~" ?\e,Au\e(B)
- ("O\"" ?\e,AV\e(B)
- ("o\"" ?\e,Av\e(B)
- ("O/" ?\e,AX\e(B)
- ("o/" ?\e,Ax\e(B)
- ("U`" ?\e,AY\e(B)
- ("u`" ?\e,Ay\e(B)
- ("U'" ?\e,AZ\e(B)
- ("u'" ?\e,Az\e(B)
- ("U^" ?\e,A[\e(B)
- ("u^" ?\e,A{\e(B)
- ("U\"" ?\e,A\\e(B)
- ("u\"" ?\e,A|\e(B)
- ("Y'" ?\e,A]\e(B)
- ("y'" ?\e,A}\e(B)
- ("y\"" ?\e,A\7f\e(B)
- ("D/" ?\e,AP\e(B)
- ("d/" ?\e,Ap\e(B)
- ("T/" ?\e,A^\e(B)
- ("t/" ?\e,A~\e(B)
- ("s/" ?\e,A_\e(B)
- ("C," ?\e,AG\e(B)
- ("c," ?\e,Ag\e(B)
- ("N~" ?\e,AQ\e(B)
- ("n~" ?\e,Aq\e(B)
- ("?/" ?\e,A?\e(B)
- ("!/" ?\e,A!\e(B)
- ("<<" ?\e,A+\e(B)
- (">>" ?\e,A;\e(B)
- ("o_" ?\e,A:\e(B)
- ("a_" ?\e,A*\e(B)
- ("//" ?\e,A0\e(B)
+ ("A`" ?À)
+ ("A'" ?Ã)
+ ("A^" ?Â)
+ ("A~" ?Ã)
+ ("A\"" ?Ä)
+ ("A/" ?Ã…)
+ ("a`" ?Ã )
+ ("a'" ?á)
+ ("a^" ?â)
+ ("a~" ?ã)
+ ("a\"" ?ä)
+ ("a/" ?Ã¥)
+ ("E`" ?È)
+ ("E'" ?É)
+ ("E^" ?Ê)
+ ("E\"" ?Ë)
+ ("E/" ?Æ)
+ ("e`" ?è)
+ ("e'" ?é)
+ ("e^" ?ê)
+ ("e\"" ?ë)
+ ("e/" ?æ)
+ ("I`" ?Ì)
+ ("i`" ?ì)
+ ("I'" ?Ã)
+ ("i'" ?Ã)
+ ("I^" ?ÃŽ)
+ ("i^" ?î)
+ ("I\"" ?Ã)
+ ("i\"" ?ï)
+ ("O`" ?Ã’)
+ ("o`" ?ò)
+ ("O'" ?Ó)
+ ("o'" ?ó)
+ ("O^" ?Ô)
+ ("o^" ?ô)
+ ("O~" ?Õ)
+ ("o~" ?õ)
+ ("O\"" ?Ö)
+ ("o\"" ?ö)
+ ("O/" ?Ø)
+ ("o/" ?ø)
+ ("U`" ?Ù)
+ ("u`" ?ù)
+ ("U'" ?Ú)
+ ("u'" ?ú)
+ ("U^" ?Û)
+ ("u^" ?û)
+ ("U\"" ?Ü)
+ ("u\"" ?ü)
+ ("Y'" ?Ã)
+ ("y'" ?ý)
+ ("y\"" ?ÿ)
+ ("D/" ?Ã)
+ ("d/" ?ð)
+ ("T/" ?Þ)
+ ("t/" ?þ)
+ ("s/" ?ß)
+ ("C," ?Ç)
+ ("c," ?ç)
+ ("N~" ?Ñ)
+ ("n~" ?ñ)
+ ("?/" ?¿)
+ ("!/" ?¡)
+ ("<<" ?«)
+ (">>" ?»)
+ ("o_" ?º)
+ ("a_" ?ª)
+ ("//" ?°)
("A``" ["A`"])
("A''" ["A'"])
| postfix | examples
------------+---------+----------
- acute | ' | a' -> \e,Ba\e(B
- ogonek | , | a, -> \e,B1\e(B
- diaeresis | \" | a\" -> \e,Bd\e(B
- circumflex | ^ | a^ -> \e,Bb\e(B
- breve | ~ | a~ -> \e,Bc\e(B
- cedilla | , | c, -> \e,Bg\e(B
- caron | ~ | c~ -> \e,Bh\e(B
- dbl. acute | : | o: -> \e,Bu\e(B
- ring | . | u. -> \e,By\e(B
- dot | . | z. -> \e,B?\e(B
- stroke | / | d/ -> \e,Bp\e(B
- others | / | s/ -> \e,B_\e(B
+ acute | ' | a' -> á
+ ogonek | , | a, -> Ä…
+ diaeresis | \" | a\" -> ä
+ circumflex | ^ | a^ -> â
+ breve | ~ | a~ -> ă
+ cedilla | , | c, -> ç
+ caron | ~ | c~ -> Ä
+ dbl. acute | : | o: -> Å‘
+ ring | . | u. -> ů
+ dot | . | z. -> ż
+ stroke | / | d/ -> Ä‘
+ others | / | s/ -> ß
Doubling the postfix separates the letter and postfix: e.g. a'' -> a'
" nil t nil nil nil nil nil nil nil nil t)
(quail-define-rules
- ("A'" ?\e,BA\e(B)
- ("A," ?\e,B!\e(B)
- ("A\"" ?\e,BD\e(B)
- ("A^" ?\e,BB\e(B)
- ("A~" ?\e,BC\e(B)
- ("C'" ?\e,BF\e(B)
- ("C," ?\e,BG\e(B)
- ("C~" ?\e,BH\e(B)
- ("D/" ?\e,BP\e(B)
- ("D~" ?\e,BO\e(B)
- ("E'" ?\e,BI\e(B)
- ("E," ?\e,BJ\e(B)
- ("E\"" ?\e,BK\e(B)
- ("E~" ?\e,BL\e(B)
- ("I'" ?\e,BM\e(B)
- ("I^" ?\e,BN\e(B)
- ("L'" ?\e,BE\e(B)
- ("L/" ?\e,B#\e(B)
- ("L~" ?\e,B%\e(B)
- ("N'" ?\e,BQ\e(B)
- ("N~" ?\e,BR\e(B)
- ("O'" ?\e,BS\e(B)
- ("O:" ?\e,BU\e(B)
- ("O\"" ?\e,BV\e(B)
- ("O^" ?\e,BT\e(B)
- ("R'" ?\e,B@\e(B)
- ("R~" ?\e,BX\e(B)
- ("S'" ?\e,B&\e(B)
- ("S," ?\e,B*\e(B)
- ("S~" ?\e,B)\e(B)
- ("T," ?\e,B^\e(B)
- ("T~" ?\e,B+\e(B)
- ("U'" ?\e,BZ\e(B)
- ("U:" ?\e,B[\e(B)
- ("U\"" ?\e,B\\e(B)
- ("U." ?\e,BY\e(B)
- ("Y'" ?\e,B]\e(B)
- ("Z'" ?\e,B,\e(B)
- ("Z." ?\e,B/\e(B)
- ("Z~" ?\e,B.\e(B)
- ("a'" ?\e,Ba\e(B)
- ("a," ?\e,B1\e(B)
- ("a\"" ?\e,Bd\e(B)
- ("a^" ?\e,Bb\e(B)
- ("a~" ?\e,Bc\e(B)
- ("c'" ?\e,Bf\e(B)
- ("c," ?\e,Bg\e(B)
- ("c~" ?\e,Bh\e(B)
- ("d/" ?\e,Bp\e(B)
- ("d~" ?\e,Bo\e(B)
- ("e'" ?\e,Bi\e(B)
- ("e," ?\e,Bj\e(B)
- ("e\"" ?\e,Bk\e(B)
- ("e~" ?\e,Bl\e(B)
- ("i'" ?\e,Bm\e(B)
- ("i^" ?\e,Bn\e(B)
- ("l'" ?\e,Be\e(B)
- ("l/" ?\e,B3\e(B)
- ("l~" ?\e,B5\e(B)
- ("n'" ?\e,Bq\e(B)
- ("n~" ?\e,Br\e(B)
- ("o'" ?\e,Bs\e(B)
- ("o:" ?\e,Bu\e(B)
- ("o\"" ?\e,Bv\e(B)
- ("o^" ?\e,Bt\e(B)
- ("r'" ?\e,B`\e(B)
- ("r~" ?\e,Bx\e(B)
- ("s'" ?\e,B6\e(B)
- ("s," ?\e,B:\e(B)
- ("s/" ?\e,B_\e(B)
- ("s~" ?\e,B9\e(B)
- ("t," ?\e,B~\e(B)
- ("t~" ?\e,B;\e(B)
- ("u'" ?\e,Bz\e(B)
- ("u:" ?\e,B{\e(B)
- ("u\"" ?\e,B|\e(B)
- ("u." ?\e,By\e(B)
- ("y'" ?\e,B}\e(B)
- ("z'" ?\e,B<\e(B)
- ("z." ?\e,B?\e(B)
- ("z~" ?\e,B>\e(B)
+ ("A'" ?Ã)
+ ("A," ?Ä„)
+ ("A\"" ?Ä)
+ ("A^" ?Â)
+ ("A~" ?Ä‚)
+ ("C'" ?Ć)
+ ("C," ?Ç)
+ ("C~" ?Č)
+ ("D/" ?Ä)
+ ("D~" ?ÄŽ)
+ ("E'" ?É)
+ ("E," ?Ę)
+ ("E\"" ?Ë)
+ ("E~" ?Äš)
+ ("I'" ?Ã)
+ ("I^" ?ÃŽ)
+ ("L'" ?Ĺ)
+ ("L/" ?Å)
+ ("L~" ?Ľ)
+ ("N'" ?Ń)
+ ("N~" ?Ň)
+ ("O'" ?Ó)
+ ("O:" ?Å)
+ ("O\"" ?Ö)
+ ("O^" ?Ô)
+ ("R'" ?Å”)
+ ("R~" ?Ř)
+ ("S'" ?Åš)
+ ("S," ?Åž)
+ ("S~" ?Å )
+ ("T," ?Å¢)
+ ("T~" ?Ť)
+ ("U'" ?Ú)
+ ("U:" ?Å°)
+ ("U\"" ?Ü)
+ ("U." ?Å®)
+ ("Y'" ?Ã)
+ ("Z'" ?Ź)
+ ("Z." ?Å»)
+ ("Z~" ?Ž)
+ ("a'" ?á)
+ ("a," ?Ä…)
+ ("a\"" ?ä)
+ ("a^" ?â)
+ ("a~" ?ă)
+ ("c'" ?ć)
+ ("c," ?ç)
+ ("c~" ?Ä)
+ ("d/" ?Ä‘)
+ ("d~" ?Ä)
+ ("e'" ?é)
+ ("e," ?Ä™)
+ ("e\"" ?ë)
+ ("e~" ?Ä›)
+ ("i'" ?Ã)
+ ("i^" ?î)
+ ("l'" ?ĺ)
+ ("l/" ?Å‚)
+ ("l~" ?ľ)
+ ("n'" ?Å„)
+ ("n~" ?ň)
+ ("o'" ?ó)
+ ("o:" ?Å‘)
+ ("o\"" ?ö)
+ ("o^" ?ô)
+ ("r'" ?Å•)
+ ("r~" ?Å™)
+ ("s'" ?Å›)
+ ("s," ?ÅŸ)
+ ("s/" ?ß)
+ ("s~" ?Å¡)
+ ("t," ?Å£)
+ ("t~" ?Å¥)
+ ("u'" ?ú)
+ ("u:" ?ű)
+ ("u\"" ?ü)
+ ("u." ?ů)
+ ("y'" ?ý)
+ ("z'" ?ź)
+ ("z." ?ż)
+ ("z~" ?ž)
("A''" ["A'"])
("A,," ["A,"])
| postfix | examples
------------+---------+----------
- acute | ' | a' -> \e,Ca\e(B
- grave | ` | a` -> \e,C`\e(B
- circumflex | ^ | a^ -> \e,Cb\e(B
- diaeresis | \" | a\" -> \e,Cd\e(B
- dot | . | c. -> \e,Ce\e(B i. -> \e,C9\e(B I. -> \e,C)\e(B
- cedilla | , | c, -> \e,Cg\e(B
- breve | ~ | g~ -> \e,C;\e(B
- tilde | ~ | n~ -> \e,Cq\e(B
- stroke | / | h/ -> \e,C1\e(B
- others | / | s/ -> \e,C_\e(B
+ acute | ' | a' -> á
+ grave | ` | a` -> Ã
+ circumflex | ^ | a^ -> â
+ diaeresis | \" | a\" -> ä
+ dot | . | c. -> ċ i. -> ı I. -> İ
+ cedilla | , | c, -> ç
+ breve | ~ | g~ -> ÄŸ
+ tilde | ~ | n~ -> ñ
+ stroke | / | h/ -> ħ
+ others | / | s/ -> ß
Doubling the postfix separates the letter and postfix: e.g. a'' -> a'
" nil t nil nil nil nil nil nil nil nil t)
(quail-define-rules
- ("A`" ?\e,C@\e(B)
- ("A'" ?\e,CA\e(B)
- ("A^" ?\e,CB\e(B)
- ("A\"" ?\e,CD\e(B)
- ("C." ?\e,CE\e(B)
- ("C^" ?\e,CF\e(B)
- ("C," ?\e,CG\e(B)
- ("E`" ?\e,CH\e(B)
- ("E'" ?\e,CI\e(B)
- ("E^" ?\e,CJ\e(B)
- ("E\"" ?\e,CK\e(B)
- ("G~" ?\e,C+\e(B)
- ("G." ?\e,CU\e(B)
- ("G^" ?\e,CX\e(B)
- ("H/" ?\e,C!\e(B)
- ("H^" ?\e,C&\e(B)
- ("I." ?\e,C)\e(B)
- ("I`" ?\e,CL\e(B)
- ("I'" ?\e,CM\e(B)
- ("I^" ?\e,CN\e(B)
- ("I\"" ?\e,CO\e(B)
- ("J^" ?\e,C,\e(B)
- ("N~" ?\e,CQ\e(B)
- ("O`" ?\e,CR\e(B)
- ("O'" ?\e,CS\e(B)
- ("O^" ?\e,CT\e(B)
- ("O\"" ?\e,CV\e(B)
- ("S," ?\e,C*\e(B)
- ("S^" ?\e,C^\e(B)
- ("U`" ?\e,CY\e(B)
- ("U'" ?\e,CZ\e(B)
- ("U^" ?\e,C[\e(B)
- ("U\"" ?\e,C\\e(B)
- ("U~" ?\e,C]\e(B)
- ("Z." ?\e,C/\e(B)
- ("a`" ?\e,C`\e(B)
- ("a'" ?\e,Ca\e(B)
- ("a^" ?\e,Cb\e(B)
- ("a\"" ?\e,Cd\e(B)
- ("c." ?\e,Ce\e(B)
- ("c^" ?\e,Cf\e(B)
- ("c," ?\e,Cg\e(B)
- ("e`" ?\e,Ch\e(B)
- ("e'" ?\e,Ci\e(B)
- ("e^" ?\e,Cj\e(B)
- ("e\"" ?\e,Ck\e(B)
- ("g~" ?\e,C;\e(B)
- ("g." ?\e,Cu\e(B)
- ("g^" ?\e,Cx\e(B)
- ("h/" ?\e,C1\e(B)
- ("h^" ?\e,C6\e(B)
- ("i." ?\e,C9\e(B)
- ("i`" ?\e,Cl\e(B)
- ("i'" ?\e,Cm\e(B)
- ("i^" ?\e,Cn\e(B)
- ("i\"" ?\e,Co\e(B)
- ("j^" ?\e,C<\e(B)
- ("n~" ?\e,Cq\e(B)
- ("o`" ?\e,Cr\e(B)
- ("o'" ?\e,Cs\e(B)
- ("o^" ?\e,Ct\e(B)
- ("o\"" ?\e,Cv\e(B)
- ("s," ?\e,C:\e(B)
- ("s/" ?\e,C_\e(B)
- ("s^" ?\e,C~\e(B)
- ("u`" ?\e,Cy\e(B)
- ("u'" ?\e,Cz\e(B)
- ("u^" ?\e,C{\e(B)
- ("u\"" ?\e,C|\e(B)
- ("u~" ?\e,C}\e(B)
- ("z." ?\e,C?\e(B)
+ ("A`" ?À)
+ ("A'" ?Ã)
+ ("A^" ?Â)
+ ("A\"" ?Ä)
+ ("C." ?ÄŠ)
+ ("C^" ?Ĉ)
+ ("C," ?Ç)
+ ("E`" ?È)
+ ("E'" ?É)
+ ("E^" ?Ê)
+ ("E\"" ?Ë)
+ ("G~" ?Äž)
+ ("G." ?Ä )
+ ("G^" ?Ĝ)
+ ("H/" ?Ħ)
+ ("H^" ?Ĥ)
+ ("I." ?Ä°)
+ ("I`" ?Ì)
+ ("I'" ?Ã)
+ ("I^" ?ÃŽ)
+ ("I\"" ?Ã)
+ ("J^" ?Ä´)
+ ("N~" ?Ñ)
+ ("O`" ?Ã’)
+ ("O'" ?Ó)
+ ("O^" ?Ô)
+ ("O\"" ?Ö)
+ ("S," ?Åž)
+ ("S^" ?Ŝ)
+ ("U`" ?Ù)
+ ("U'" ?Ú)
+ ("U^" ?Û)
+ ("U\"" ?Ü)
+ ("U~" ?Ŭ)
+ ("Z." ?Å»)
+ ("a`" ?Ã )
+ ("a'" ?á)
+ ("a^" ?â)
+ ("a\"" ?ä)
+ ("c." ?Ä‹)
+ ("c^" ?ĉ)
+ ("c," ?ç)
+ ("e`" ?è)
+ ("e'" ?é)
+ ("e^" ?ê)
+ ("e\"" ?ë)
+ ("g~" ?ÄŸ)
+ ("g." ?Ä¡)
+ ("g^" ?Ä)
+ ("h/" ?ħ)
+ ("h^" ?Ä¥)
+ ("i." ?ı)
+ ("i`" ?ì)
+ ("i'" ?Ã)
+ ("i^" ?î)
+ ("i\"" ?ï)
+ ("j^" ?ĵ)
+ ("n~" ?ñ)
+ ("o`" ?ò)
+ ("o'" ?ó)
+ ("o^" ?ô)
+ ("o\"" ?ö)
+ ("s," ?ÅŸ)
+ ("s/" ?ß)
+ ("s^" ?Å)
+ ("u`" ?ù)
+ ("u'" ?ú)
+ ("u^" ?û)
+ ("u\"" ?ü)
+ ("u~" ?Å)
+ ("z." ?ż)
("A``" ["A`"])
("A''" ["A'"])
| postfix | examples
------------+---------+----------
- acute | ' | a' -> \e,Da\e(B
- circumflex | ^ | a^ -> \e,Db\e(B
- diaeresis | \" | a\" -> \e,Dd\e(B
- ogonek | , | a, -> \e,D1\e(B
- macron | - | a- -> \e,D`\e(B
- tilde | ~ | a~ -> \e,Dc\e(B
- caron | ~ | c~ -> \e,Dh\e(B
- dot | . | e. -> \e,Dl\e(B
- cedilla | , | k, -> \e,Ds\e(B g, -> \e,D;\e(B
- stroke | / | d/ -> \e,Dp\e(B
- nordic | / | a/ -> \e,De\e(B e/ -> \e,Df\e(B o/ -> \e,Dx\e(B
- others | / | s/ -> \e,D_\e(B n/ -> \e,D?\e(B k/ -> \e,D"\e(B
+ acute | ' | a' -> á
+ circumflex | ^ | a^ -> â
+ diaeresis | \" | a\" -> ä
+ ogonek | , | a, -> Ä…
+ macron | - | a- -> Ä
+ tilde | ~ | a~ -> ã
+ caron | ~ | c~ -> Ä
+ dot | . | e. -> Ä—
+ cedilla | , | k, -> ķ g, -> ģ
+ stroke | / | d/ -> Ä‘
+ nordic | / | a/ -> å e/ -> æ o/ -> ø
+ others | / | s/ -> ß n/ -> ŋ k/ -> ĸ
Doubling the postfix separates the letter and postfix: e.g. a'' -> a'
" nil t nil nil nil nil nil nil nil nil t)
(quail-define-rules
- ("A," ?\e,D!\e(B)
- ("A-" ?\e,D@\e(B)
- ("A'" ?\e,DA\e(B)
- ("A^" ?\e,DB\e(B)
- ("A~" ?\e,DC\e(B)
- ("A\"" ?\e,DD\e(B)
- ("A/" ?\e,DE\e(B)
- ("C~" ?\e,DH\e(B)
- ("D/" ?\e,DP\e(B)
- ("E/" ?\e,DF\e(B)
- ("E-" ?\e,D*\e(B)
- ("E'" ?\e,DI\e(B)
- ("E," ?\e,DJ\e(B)
- ("E\"" ?\e,DK\e(B)
- ("E." ?\e,DL\e(B)
- ("G," ?\e,D+\e(B)
- ("I~" ?\e,D%\e(B)
- ("I," ?\e,DG\e(B)
- ("I'" ?\e,DM\e(B)
- ("I^" ?\e,DN\e(B)
- ("I-" ?\e,DO\e(B)
- ("K," ?\e,DS\e(B)
- ("L," ?\e,D&\e(B)
- ("N/" ?\e,D=\e(B)
- ("N," ?\e,DQ\e(B)
- ("O-" ?\e,DR\e(B)
- ("O^" ?\e,DT\e(B)
- ("O~" ?\e,DU\e(B)
- ("O\"" ?\e,DV\e(B)
- ("O/" ?\e,DX\e(B)
- ("R," ?\e,D#\e(B)
- ("S~" ?\e,D)\e(B)
- ("T/" ?\e,D,\e(B)
- ("U," ?\e,DY\e(B)
- ("U'" ?\e,DZ\e(B)
- ("U^" ?\e,D[\e(B)
- ("U\"" ?\e,D\\e(B)
- ("U~" ?\e,D]\e(B)
- ("U-" ?\e,D^\e(B)
- ("Z~" ?\e,D.\e(B)
- ("a," ?\e,D1\e(B)
- ("a-" ?\e,D`\e(B)
- ("a'" ?\e,Da\e(B)
- ("a^" ?\e,Db\e(B)
- ("a~" ?\e,Dc\e(B)
- ("a\"" ?\e,Dd\e(B)
- ("a/" ?\e,De\e(B)
- ("c~" ?\e,Dh\e(B)
- ("d/" ?\e,Dp\e(B)
- ("e/" ?\e,Df\e(B)
- ("e-" ?\e,D:\e(B)
- ("e'" ?\e,Di\e(B)
- ("e," ?\e,Dj\e(B)
- ("e\"" ?\e,Dk\e(B)
- ("e." ?\e,Dl\e(B)
- ("g," ?\e,D;\e(B)
- ("i~" ?\e,D5\e(B)
- ("i," ?\e,Dg\e(B)
- ("i'" ?\e,Dm\e(B)
- ("i^" ?\e,Dn\e(B)
- ("i-" ?\e,Do\e(B)
- ("k/" ?\e,D"\e(B)
- ("k," ?\e,Ds\e(B)
- ("l," ?\e,D6\e(B)
- ("n/" ?\e,D?\e(B)
- ("n," ?\e,Dq\e(B)
- ("o-" ?\e,Dr\e(B)
- ("o^" ?\e,Dt\e(B)
- ("o~" ?\e,Du\e(B)
- ("o\"" ?\e,Dv\e(B)
- ("o/" ?\e,Dx\e(B)
- ("r," ?\e,D3\e(B)
- ("s/" ?\e,D_\e(B)
- ("s~" ?\e,D9\e(B)
- ("t/" ?\e,D<\e(B)
- ("u," ?\e,Dy\e(B)
- ("u'" ?\e,Dz\e(B)
- ("u^" ?\e,D{\e(B)
- ("u\"" ?\e,D|\e(B)
- ("u~" ?\e,D}\e(B)
- ("u-" ?\e,D~\e(B)
- ("z~" ?\e,D>\e(B)
+ ("A," ?Ä„)
+ ("A-" ?Ä€)
+ ("A'" ?Ã)
+ ("A^" ?Â)
+ ("A~" ?Ã)
+ ("A\"" ?Ä)
+ ("A/" ?Ã…)
+ ("C~" ?Č)
+ ("D/" ?Ä)
+ ("E/" ?Æ)
+ ("E-" ?Ä’)
+ ("E'" ?É)
+ ("E," ?Ę)
+ ("E\"" ?Ë)
+ ("E." ?Ä–)
+ ("G," ?Ä¢)
+ ("I~" ?Ĩ)
+ ("I," ?Ä®)
+ ("I'" ?Ã)
+ ("I^" ?ÃŽ)
+ ("I-" ?Ī)
+ ("K," ?Ķ)
+ ("L," ?Ä»)
+ ("N/" ?ÅŠ)
+ ("N," ?Å…)
+ ("O-" ?Ō)
+ ("O^" ?Ô)
+ ("O~" ?Õ)
+ ("O\"" ?Ö)
+ ("O/" ?Ø)
+ ("R," ?Å–)
+ ("S~" ?Å )
+ ("T/" ?Ŧ)
+ ("U," ?Ų)
+ ("U'" ?Ú)
+ ("U^" ?Û)
+ ("U\"" ?Ü)
+ ("U~" ?Ũ)
+ ("U-" ?Ū)
+ ("Z~" ?Ž)
+ ("a," ?Ä…)
+ ("a-" ?Ä)
+ ("a'" ?á)
+ ("a^" ?â)
+ ("a~" ?ã)
+ ("a\"" ?ä)
+ ("a/" ?Ã¥)
+ ("c~" ?Ä)
+ ("d/" ?Ä‘)
+ ("e/" ?æ)
+ ("e-" ?Ä“)
+ ("e'" ?é)
+ ("e," ?Ä™)
+ ("e\"" ?ë)
+ ("e." ?Ä—)
+ ("g," ?Ä£)
+ ("i~" ?Ä©)
+ ("i," ?į)
+ ("i'" ?Ã)
+ ("i^" ?î)
+ ("i-" ?Ä«)
+ ("k/" ?ĸ)
+ ("k," ?Ä·)
+ ("l," ?ļ)
+ ("n/" ?Å‹)
+ ("n," ?ņ)
+ ("o-" ?Å)
+ ("o^" ?ô)
+ ("o~" ?õ)
+ ("o\"" ?ö)
+ ("o/" ?ø)
+ ("r," ?Å—)
+ ("s/" ?ß)
+ ("s~" ?Å¡)
+ ("t/" ?ŧ)
+ ("u," ?ų)
+ ("u'" ?ú)
+ ("u^" ?û)
+ ("u\"" ?ü)
+ ("u~" ?Å©)
+ ("u-" ?Å«)
+ ("z~" ?ž)
("A,," ["A,"])
("A--" ["A-"])
| postfix | examples
------------+---------+----------
- acute | ' | a' -> \e,Ma\e(B
- grave | ` | a` -> \e,M`\e(B
- circumflex | ^ | a^ -> \e,Mb\e(B
- diaeresis | \" | a\" -> \e,Md\e(B
- tilde | ~ | a~ -> \e,Mc\e(B
- breve | ~ | g~ -> \e,Mp\e(B
- cedilla | , | c, -> \e,Mg\e(B
- dot | . | i. -> \e,M}\e(B I. -> \e,M]\e(B
- nordic | / | a/ -> \e,Me\e(B e/ -> \e,Mf\e(B o/ -> \e,Mx\e(B
- others | / | s/ -> \e,M_\e(B
+ acute | ' | a' -> á
+ grave | ` | a` -> Ã
+ circumflex | ^ | a^ -> â
+ diaeresis | \" | a\" -> ä
+ tilde | ~ | a~ -> ã
+ breve | ~ | g~ -> ÄŸ
+ cedilla | , | c, -> ç
+ dot | . | i. -> ı I. -> İ
+ nordic | / | a/ -> å e/ -> æ o/ -> ø
+ others | / | s/ -> ß
Doubling the postfix separates the letter and postfix: e.g. a'' -> a'
" nil t nil nil nil nil nil nil nil nil t)
(quail-define-rules
- ("A'" ?\e,MA\e(B)
- ("A/" ?\e,ME\e(B)
- ("A\"" ?\e,MD\e(B)
- ("A^" ?\e,MB\e(B)
- ("A`" ?\e,M@\e(B)
- ("A~" ?\e,MC\e(B)
- ("C," ?\e,MG\e(B)
- ("E'" ?\e,MI\e(B)
- ("E/" ?\e,MF\e(B)
- ("E\"" ?\e,MK\e(B)
- ("E^" ?\e,MJ\e(B)
- ("E`" ?\e,MH\e(B)
- ("G~" ?\e,MP\e(B)
- ("I'" ?\e,MM\e(B)
- ("I." ?\e,M]\e(B)
- ("I\"" ?\e,MO\e(B)
- ("I^" ?\e,MN\e(B)
- ("I`" ?\e,ML\e(B)
- ("N~" ?\e,MQ\e(B)
- ("O'" ?\e,MS\e(B)
- ("O/" ?\e,MX\e(B)
- ("O\"" ?\e,MV\e(B)
- ("O^" ?\e,MT\e(B)
- ("O`" ?\e,MR\e(B)
- ("O~" ?\e,MU\e(B)
- ("S," ?\e,M^\e(B)
- ("U'" ?\e,MZ\e(B)
- ("U\"" ?\e,M\\e(B)
- ("U^" ?\e,M[\e(B)
- ("U`" ?\e,MY\e(B)
- ("a'" ?\e,Ma\e(B)
- ("a/" ?\e,Me\e(B)
- ("a\"" ?\e,Md\e(B)
- ("a^" ?\e,Mb\e(B)
- ("a`" ?\e,M`\e(B)
- ("a~" ?\e,Mc\e(B)
- ("c," ?\e,Mg\e(B)
- ("e'" ?\e,Mi\e(B)
- ("e/" ?\e,Mf\e(B)
- ("e\"" ?\e,Mk\e(B)
- ("e^" ?\e,Mj\e(B)
- ("e`" ?\e,Mh\e(B)
- ("g~" ?\e,Mp\e(B)
- ("i'" ?\e,Mm\e(B)
- ("i." ?\e,M}\e(B)
- ("i\"" ?\e,Mo\e(B)
- ("i^" ?\e,Mn\e(B)
- ("i`" ?\e,Ml\e(B)
- ("n~" ?\e,Mq\e(B)
- ("o'" ?\e,Ms\e(B)
- ("o/" ?\e,Mx\e(B)
- ("o\"" ?\e,Mv\e(B)
- ("o^" ?\e,Mt\e(B)
- ("o`" ?\e,Mr\e(B)
- ("o~" ?\e,Mu\e(B)
- ("s," ?\e,M~\e(B)
- ("s/" ?\e,M_\e(B)
- ("u'" ?\e,Mz\e(B)
- ("u\"" ?\e,M|\e(B)
- ("u^" ?\e,M{\e(B)
- ("u`" ?\e,My\e(B)
- ("y\"" ?\e,M\7f\e(B)
+ ("A'" ?Ã)
+ ("A/" ?Ã…)
+ ("A\"" ?Ä)
+ ("A^" ?Â)
+ ("A`" ?À)
+ ("A~" ?Ã)
+ ("C," ?Ç)
+ ("E'" ?É)
+ ("E/" ?Æ)
+ ("E\"" ?Ë)
+ ("E^" ?Ê)
+ ("E`" ?È)
+ ("G~" ?Äž)
+ ("I'" ?Ã)
+ ("I." ?Ä°)
+ ("I\"" ?Ã)
+ ("I^" ?ÃŽ)
+ ("I`" ?Ì)
+ ("N~" ?Ñ)
+ ("O'" ?Ó)
+ ("O/" ?Ø)
+ ("O\"" ?Ö)
+ ("O^" ?Ô)
+ ("O`" ?Ã’)
+ ("O~" ?Õ)
+ ("S," ?Åž)
+ ("U'" ?Ú)
+ ("U\"" ?Ü)
+ ("U^" ?Û)
+ ("U`" ?Ù)
+ ("a'" ?á)
+ ("a/" ?Ã¥)
+ ("a\"" ?ä)
+ ("a^" ?â)
+ ("a`" ?Ã )
+ ("a~" ?ã)
+ ("c," ?ç)
+ ("e'" ?é)
+ ("e/" ?æ)
+ ("e\"" ?ë)
+ ("e^" ?ê)
+ ("e`" ?è)
+ ("g~" ?ÄŸ)
+ ("i'" ?Ã)
+ ("i." ?ı)
+ ("i\"" ?ï)
+ ("i^" ?î)
+ ("i`" ?ì)
+ ("n~" ?ñ)
+ ("o'" ?ó)
+ ("o/" ?ø)
+ ("o\"" ?ö)
+ ("o^" ?ô)
+ ("o`" ?ò)
+ ("o~" ?õ)
+ ("s," ?ÅŸ)
+ ("s/" ?ß)
+ ("u'" ?ú)
+ ("u\"" ?ü)
+ ("u^" ?û)
+ ("u`" ?ù)
+ ("y\"" ?ÿ)
("A''" ["A'"])
("A//" ["A/"])
(quail-define-package
"danish-postfix" "Latin-1" "DA<" t
- "Danish input method (rule: AE -> \e,AF\e(B, OE -> \e,AX\e(B, AA -> \e,AE\e(B, E' -> \e,AI\e(B)
+ "Danish input method (rule: AE -> Æ, OE -> Ø, AA -> Å, E' -> É)
Doubling the postfix separates the letter and postfix: e.g. aee -> ae
"
nil t nil nil nil nil nil nil nil nil t)
(quail-define-rules
- ("AE" ?\e,AF\e(B)
- ("ae" ?\e,Af\e(B)
- ("OE" ?\e,AX\e(B)
- ("oe" ?\e,Ax\e(B)
- ("AA" ?\e,AE\e(B)
- ("aa" ?\e,Ae\e(B)
- ("E'" ?\e,AI\e(B)
- ("e'" ?\e,Ai\e(B)
+ ("AE" ?Æ)
+ ("ae" ?æ)
+ ("OE" ?Ø)
+ ("oe" ?ø)
+ ("AA" ?Ã…)
+ ("aa" ?Ã¥)
+ ("E'" ?É)
+ ("e'" ?é)
("AEE" ["AE"])
("aee" ["ae"])
"Esperanto input method with postfix modifiers
A following ^ or x will produce an accented character,
-e.g. c^ -> \e,Cf\e(B gx -> \e,Cx\e(B u^ -> \e,C}\e(B.
+e.g. c^ -> ĉ gx -> Ä u^ -> Å.
Doubling the postfix separates the letter and postfix,
e.g. a'' -> a'.
" nil t nil nil nil nil nil nil nil nil t)
(quail-define-rules
- ("Cx" ?\e,CF\e(B)
- ("C^" ?\e,CF\e(B)
- ("cx" ?\e,Cf\e(B)
- ("c^" ?\e,Cf\e(B)
- ("Gx" ?\e,CX\e(B)
- ("G^" ?\e,CX\e(B)
- ("gx" ?\e,Cx\e(B)
- ("g^" ?\e,Cx\e(B)
- ("Hx" ?\e,C&\e(B)
- ("H^" ?\e,C&\e(B)
- ("hx" ?\e,C6\e(B)
- ("h^" ?\e,C6\e(B)
- ("Jx" ?\e,C,\e(B)
- ("J^" ?\e,C,\e(B)
- ("jx" ?\e,C<\e(B)
- ("j^" ?\e,C<\e(B)
- ("Sx" ?\e,C^\e(B)
- ("S^" ?\e,C^\e(B)
- ("sx" ?\e,C~\e(B)
- ("s^" ?\e,C~\e(B)
- ("Ux" ?\e,C]\e(B)
- ("U^" ?\e,C]\e(B)
- ("ux" ?\e,C}\e(B)
- ("u^" ?\e,C}\e(B)
+ ("Cx" ?Ĉ)
+ ("C^" ?Ĉ)
+ ("cx" ?ĉ)
+ ("c^" ?ĉ)
+ ("Gx" ?Ĝ)
+ ("G^" ?Ĝ)
+ ("gx" ?Ä)
+ ("g^" ?Ä)
+ ("Hx" ?Ĥ)
+ ("H^" ?Ĥ)
+ ("hx" ?Ä¥)
+ ("h^" ?Ä¥)
+ ("Jx" ?Ä´)
+ ("J^" ?Ä´)
+ ("jx" ?ĵ)
+ ("j^" ?ĵ)
+ ("Sx" ?Ŝ)
+ ("S^" ?Ŝ)
+ ("sx" ?Å)
+ ("s^" ?Å)
+ ("Ux" ?Ŭ)
+ ("U^" ?Ŭ)
+ ("ux" ?Å)
+ ("u^" ?Å)
("Cxx" ["Cx"])
("C^^" ["C^"])
"finnish-postfix" "Latin-1" "FI<" t
"Finnish (Suomi) input method
-AE -> \e,AD\e(B
+AE -> Ä
AEE -> AE
-OE -> \e,AV\e(B
+OE -> Ö
OEE -> OE
"
nil t nil nil nil nil nil nil nil nil t)
(quail-define-rules
- ("AE" ?\e,AD\e(B)
- ("ae" ?\e,Ad\e(B)
- ("OE" ?\e,AV\e(B)
- ("oe" ?\e,Av\e(B)
+ ("AE" ?Ä)
+ ("ae" ?ä)
+ ("OE" ?Ö)
+ ("oe" ?ö)
("AEE" ["AE"])
("aee" ["ae"])
(quail-define-package
"french-postfix" "French" "FR<" t
- "French (Fran\e,Ag\e(Bais) input method with postfix modifiers
+ "French (Français) input method with postfix modifiers
-` pour grave, ' pour aigu, ^ pour circonflexe, et \" pour tr\e,Ai\e(Bma.
-Par exemple: a` -> \e,A`\e(B e' -> \e,Ai\e(B.
+` pour grave, ' pour aigu, ^ pour circonflexe, et \" pour tréma.
+Par exemple: a` -> à e' -> é.
-\e,AG\e(B, \e,A+\e(B, et \e,A;\e(B sont produits par C,, <<, et >>.
+Ç, «, et » sont produits par C,, <<, et >>.
En doublant la frappe des diacritiques, ils s'isoleront de la lettre.
Par exemple: e'' -> e'
nil t nil nil nil nil nil nil nil nil t)
(quail-define-rules
- ("A`" ?\e,A@\e(B)
- ("A^" ?\e,AB\e(B)
- ("a`" ?\e,A`\e(B)
- ("a^" ?\e,Ab\e(B)
- ("E`" ?\e,AH\e(B)
- ("E'" ?\e,AI\e(B)
- ("E^" ?\e,AJ\e(B)
- ("E\"" ?\e,AK\e(B)
- ("e`" ?\e,Ah\e(B)
- ("e'" ?\e,Ai\e(B)
- ("e^" ?\e,Aj\e(B)
- ("e\"" ?\e,Ak\e(B)
- ("I^" ?\e,AN\e(B)
- ("I\"" ?\e,AO\e(B)
- ("i^" ?\e,An\e(B)
- ("i\"" ?\e,Ao\e(B)
- ("O^" ?\e,AT\e(B)
- ("o^" ?\e,At\e(B)
- ("U`" ?\e,AY\e(B)
- ("U^" ?\e,A[\e(B)
- ("U\"" ?\e,A\\e(B)
- ("u`" ?\e,Ay\e(B)
- ("u^" ?\e,A{\e(B)
- ("u\"" ?\e,A|\e(B)
- ("C," ?\e,AG\e(B)
- ("c," ?\e,Ag\e(B)
- ("<<" ?\e,A+\e(B)
- (">>" ?\e,A;\e(B)
+ ("A`" ?À)
+ ("A^" ?Â)
+ ("a`" ?Ã )
+ ("a^" ?â)
+ ("E`" ?È)
+ ("E'" ?É)
+ ("E^" ?Ê)
+ ("E\"" ?Ë)
+ ("e`" ?è)
+ ("e'" ?é)
+ ("e^" ?ê)
+ ("e\"" ?ë)
+ ("I^" ?ÃŽ)
+ ("I\"" ?Ã)
+ ("i^" ?î)
+ ("i\"" ?ï)
+ ("O^" ?Ô)
+ ("o^" ?ô)
+ ("U`" ?Ù)
+ ("U^" ?Û)
+ ("U\"" ?Ü)
+ ("u`" ?ù)
+ ("u^" ?û)
+ ("u\"" ?ü)
+ ("C," ?Ç)
+ ("c," ?ç)
+ ("<<" ?«)
+ (">>" ?»)
("A``" ["A`"])
("A^^" ["A^"])
"german-postfix" "German" "DE<" t
"German (Deutsch) input method
-ae -> \e,Ad\e(B
+ae -> ä
aee -> ae
-oe -> \e,Av\e(B
+oe -> ö
oee -> oe
-ue -> \e,A|\e(B
+ue -> ü
uee -> ue
-sz -> \e,A_\e(B
+sz -> ß
szz -> sz
"
nil t nil nil nil nil nil nil nil nil t)
(quail-define-rules
- ("AE" ?\e,AD\e(B)
- ("ae" ?\e,Ad\e(B)
- ("OE" ?\e,AV\e(B)
- ("oe" ?\e,Av\e(B)
- ("UE" ?\e,A\\e(B)
- ("ue" ?\e,A|\e(B)
- ("sz" ?\e,A_\e(B)
+ ("AE" ?Ä)
+ ("ae" ?ä)
+ ("OE" ?Ö)
+ ("oe" ?ö)
+ ("UE" ?Ü)
+ ("ue" ?ü)
+ ("sz" ?ß)
("AEE" ["AE"])
("aee" ["ae"])
(quail-define-package
"icelandic-postfix" "Latin-1" "IS<" t
- "Icelandic (\e,AM\e(Bslenska) input method with postfix modifiers
-
-A' -> \e,AA\e(B
-E' -> \e,AI\e(B
-I' -> \e,AM\e(B
-O' -> \e,AS\e(B
-U' -> \e,AZ\e(B
-Y' -> \e,A]\e(B
-AE -> \e,AF\e(B
-OE -> \e,AV\e(B
-D/ -> \e,AP\e(B (eth)
-T/ -> \e,A^\e(B (thorn)
+ "Icelandic (Ãslenska) input method with postfix modifiers
+
+A' -> Ã
+E' -> É
+I' -> Ã
+O' -> Ó
+U' -> Ú
+Y' -> Ã
+AE -> Æ
+OE -> Ö
+D/ -> Ã (eth)
+T/ -> Þ (thorn)
Doubling the postfix separates the letter and postfix: e.g. a'' -> a'
" nil t nil nil nil nil nil nil nil nil t)
(quail-define-rules
- ("A'" ?\e,AA\e(B)
- ("a'" ?\e,Aa\e(B)
- ("E'" ?\e,AI\e(B)
- ("e'" ?\e,Ai\e(B)
- ("I'" ?\e,AM\e(B)
- ("i'" ?\e,Am\e(B)
- ("O'" ?\e,AS\e(B)
- ("o'" ?\e,As\e(B)
- ("U'" ?\e,AZ\e(B)
- ("u'" ?\e,Az\e(B)
- ("Y'" ?\e,A]\e(B)
- ("y'" ?\e,A}\e(B)
- ("AE" ?\e,AF\e(B)
- ("ae" ?\e,Af\e(B)
- ("OE" ?\e,AV\e(B)
- ("oe" ?\e,Av\e(B)
- ("D/" ?\e,AP\e(B)
- ("d/" ?\e,Ap\e(B)
- ("T/" ?\e,A^\e(B)
- ("t/" ?\e,A~\e(B)
+ ("A'" ?Ã)
+ ("a'" ?á)
+ ("E'" ?É)
+ ("e'" ?é)
+ ("I'" ?Ã)
+ ("i'" ?Ã)
+ ("O'" ?Ó)
+ ("o'" ?ó)
+ ("U'" ?Ú)
+ ("u'" ?ú)
+ ("Y'" ?Ã)
+ ("y'" ?ý)
+ ("AE" ?Æ)
+ ("ae" ?æ)
+ ("OE" ?Ö)
+ ("oe" ?ö)
+ ("D/" ?Ã)
+ ("d/" ?ð)
+ ("T/" ?Þ)
+ ("t/" ?þ)
("A''" ["A'"])
("a''" ["a'"])
"italian-postfix" "Latin-1" "IT<" t
"Italian (Italiano) input method with postfix modifiers
-a` -> \e,A`\e(B A` -> \e,A@\e(B e' -> \e,Ai\e(B << -> \e,A+\e(B
-e` -> \e,Ah\e(B E` -> \e,AH\e(B E' -> \e,AI\e(B >> -> \e,A;\e(B
-i` -> \e,Al\e(B I` -> \e,AL\e(B o_ -> \e,A:\e(B
-o` -> \e,Ar\e(B O` -> \e,AR\e(B a_ -> \e,A*\e(B
-u` -> \e,Ay\e(B U` -> \e,AY\e(B
+a` -> à A` -> À e' -> é << -> «
+e` -> è E` -> È E' -> É >> -> »
+i` -> ì I` -> Ì o_ -> º
+o` -> ò O` -> Ò a_ -> ª
+u` -> ù U` -> Ù
Typewriter-style italian characters.
" nil t nil nil nil nil nil nil nil nil t)
(quail-define-rules
- ("A`" ?\e,A@\e(B)
- ("a`" ?\e,A`\e(B)
- ("E`" ?\e,AH\e(B)
- ("E'" ?\e,AI\e(B)
- ("e`" ?\e,Ah\e(B)
- ("e'" ?\e,Ai\e(B)
- ("I`" ?\e,AL\e(B)
- ("i`" ?\e,Al\e(B)
- ("O`" ?\e,AR\e(B)
- ("o`" ?\e,Ar\e(B)
- ("U`" ?\e,AY\e(B)
- ("u`" ?\e,Ay\e(B)
- ("<<" ?\e,A+\e(B)
- (">>" ?\e,A;\e(B)
- ("o_" ?\e,A:\e(B)
- ("a_" ?\e,A*\e(B)
+ ("A`" ?À)
+ ("a`" ?Ã )
+ ("E`" ?È)
+ ("E'" ?É)
+ ("e`" ?è)
+ ("e'" ?é)
+ ("I`" ?Ì)
+ ("i`" ?ì)
+ ("O`" ?Ã’)
+ ("o`" ?ò)
+ ("U`" ?Ù)
+ ("u`" ?ù)
+ ("<<" ?«)
+ (">>" ?»)
+ ("o_" ?º)
+ ("a_" ?ª)
("A``" ["A`"])
("a``" ["a`"])
(quail-define-package
"norwegian-postfix" "Latin-1" "NO<" t
- "Norwegian (Norsk) input method (rule: AE->\e,AF\e(B OE->\e,AX\e(B AA->\e,AE\e(B E'->\e,AI\e(B)
+ "Norwegian (Norsk) input method (rule: AE->Æ OE->Ø AA->Å E'->É)
Doubling the postfix separates the letter and postfix: e.g. aee -> ae
"
nil t nil nil nil nil nil nil nil nil t)
(quail-define-rules
- ("AE" ?\e,AF\e(B)
- ("ae" ?\e,Af\e(B)
- ("OE" ?\e,AX\e(B)
- ("oe" ?\e,Ax\e(B)
- ("AA" ?\e,AE\e(B)
- ("aa" ?\e,Ae\e(B)
- ("E'" ?\e,AI\e(B)
- ("e'" ?\e,Ai\e(B)
+ ("AE" ?Æ)
+ ("ae" ?æ)
+ ("OE" ?Ø)
+ ("oe" ?ø)
+ ("AA" ?Ã…)
+ ("aa" ?Ã¥)
+ ("E'" ?É)
+ ("e'" ?é)
("AEE" ["AE"])
("aee" ["ae"])
"Scandinavian input method with postfix modifiers
Supported languages are Swedish, Norwegian, Danish, and Finnish.
-ae -> \e,Af\e(B
-oe -> \e,Ax\e(B
-aa -> \e,Ae\e(B
-a\" -> \e,Ad\e(B
-o\" -> \e,Av\e(B
-e' -> \e,Ai\e(B
+ae -> æ
+oe -> ø
+aa -> å
+a\" -> ä
+o\" -> ö
+e' -> é
Doubling the postfix separates the letter and postfix:
aee -> ae o\"\" -> o\" etc.
" nil t nil nil nil nil nil nil nil nil t)
(quail-define-rules
- ("AE" ?\e,AF\e(B)
- ("ae" ?\e,Af\e(B)
- ("OE" ?\e,AX\e(B)
- ("oe" ?\e,Ax\e(B)
- ("AA" ?\e,AE\e(B)
- ("aa" ?\e,Ae\e(B)
- ("A\"" ?\e,AD\e(B)
- ("a\"" ?\e,Ad\e(B)
- ("O\"" ?\e,AV\e(B)
- ("o\"" ?\e,Av\e(B)
- ("E'" ?\e,AI\e(B)
- ("e'" ?\e,Ai\e(B)
+ ("AE" ?Æ)
+ ("ae" ?æ)
+ ("OE" ?Ø)
+ ("oe" ?ø)
+ ("AA" ?Ã…)
+ ("aa" ?Ã¥)
+ ("A\"" ?Ä)
+ ("a\"" ?ä)
+ ("O\"" ?Ö)
+ ("o\"" ?ö)
+ ("E'" ?É)
+ ("e'" ?é)
("AEE" ["AE"])
("aee" ["ae"])
(quail-define-package
"spanish-postfix" "Spanish" "ES<" t
- "Spanish (Espa\e,Aq\e(Bol) input method with postfix modifiers
+ "Spanish (Español) input method with postfix modifiers
-A' -> \e,AA\e(B
-E' -> \e,AI\e(B
-I' -> \e,AM\e(B
-O' -> \e,AS\e(B
-U' -> \e,AZ\e(B
-N~ -> \e,AQ\e(B
-!/ -> \e,A!\e(B
-?/ -> \e,A?\e(B
+A' -> Ã
+E' -> É
+I' -> Ã
+O' -> Ó
+U' -> Ú
+N~ -> Ñ
+!/ -> ¡
+?/ -> ¿
Doubling the postfix separates the letter and postfix:
a'' -> a' n~~ -> n~, etc.
" nil t nil nil nil nil nil nil nil nil t)
(quail-define-rules
- ("A'" ?\e,AA\e(B)
- ("a'" ?\e,Aa\e(B)
- ("E'" ?\e,AI\e(B)
- ("e'" ?\e,Ai\e(B)
- ("I'" ?\e,AM\e(B)
- ("i'" ?\e,Am\e(B)
- ("O'" ?\e,AS\e(B)
- ("o'" ?\e,As\e(B)
- ("U'" ?\e,AZ\e(B)
- ("u'" ?\e,Az\e(B)
- ("U\"" ?\e,C\\e(B)
- ("u\"" ?\e,C|\e(B)
- ("N~" ?\e,AQ\e(B)
- ("n~" ?\e,Aq\e(B)
- ("?/" ?\e,A?\e(B)
- ("!/" ?\e,A!\e(B)
+ ("A'" ?Ã)
+ ("a'" ?á)
+ ("E'" ?É)
+ ("e'" ?é)
+ ("I'" ?Ã)
+ ("i'" ?Ã)
+ ("O'" ?Ó)
+ ("o'" ?ó)
+ ("U'" ?Ú)
+ ("u'" ?ú)
+ ("U\"" ?Ü)
+ ("u\"" ?ü)
+ ("N~" ?Ñ)
+ ("n~" ?ñ)
+ ("?/" ?¿)
+ ("!/" ?¡)
("A''" ["A'"])
("a''" ["a'"])
(quail-define-package
"swedish-postfix" "Latin-1" "SV<" t
- "Swedish (Svenska) input method (rule: AA -> \e,AE\e(B AE -> \e,AD\e(B OE -> \e,AV\e(B E' -> \e,AI\e(B)
+ "Swedish (Svenska) input method (rule: AA -> Å AE -> Ä OE -> Ö E' -> É)
Doubling the postfix separates the letter and postfix: e.g. aee -> ae
" nil t nil nil nil nil nil nil nil nil t)
(quail-define-rules
- ("AA" ?\e,AE\e(B)
- ("aa" ?\e,Ae\e(B)
- ("AE" ?\e,AD\e(B)
- ("ae" ?\e,Ad\e(B)
- ("OE" ?\e,AV\e(B)
- ("oe" ?\e,Av\e(B)
- ("E'" ?\e,AI\e(B)
- ("e'" ?\e,Ai\e(B)
+ ("AA" ?Ã…)
+ ("aa" ?Ã¥)
+ ("AE" ?Ä)
+ ("ae" ?ä)
+ ("OE" ?Ö)
+ ("oe" ?ö)
+ ("E'" ?É)
+ ("e'" ?é)
("AAA" ["AA"])
("aaa" ["aa"])
("e''" ["e'"])
)
-(quail-define-package
- "turkish-latin-3-postfix" "Turkish" "TR3<" t
- "Turkish (T\e,C|\e(Brk\e,Cg\e(Be) input method with postfix modifiers.
-
-This is for those who use Latin-3 (ISO-8859-3) for Turkish. If you
-use Latin-5 (ISO-8859-9), you should use \"turkish-postfix\" instead.
-
-Note for I, \e,C9\e(B, \e,C)\e(B, i.
-
-A^ -> \e,CB\e(B
-C, -> \e,CG\e(B
-G^ -> \e,C+\e(B
-I -> I
-i -> \e,C9\e(B
-I. -> \e,C)\e(B
-i. -> i
-O\" -> \e,CV\e(B
-S, -> \e,C*\e(B
-U\" -> \e,C\\e(B
-U^ -> \e,C[\e(B
-
-Doubling the postfix separates the letter and postfix: e.g. a^^ -> a^
-" nil t nil nil nil nil nil nil nil nil t)
-
-(quail-define-rules
- ("A^" ?\e,CB\e(B)
- ("a^" ?\e,Cb\e(B)
- ("C," ?\e,CG\e(B)
- ("c," ?\e,Cg\e(B)
- ("G^" ?\e,C+\e(B)
- ("g^" ?\e,C;\e(B)
- ("I." ?\e,C)\e(B)
- ("i" ?\e,C9\e(B)
- ("i." ?i)
- ("O\"" ?\e,CV\e(B)
- ("o\"" ?\e,Cv\e(B)
- ("S," ?\e,C*\e(B)
- ("s," ?\e,C:\e(B)
- ("U\"" ?\e,C\\e(B)
- ("u\"" ?\e,C|\e(B)
- ("U^" ?\e,C[\e(B)
- ("u^" ?\e,C{\e(B)
-
- ("A^^" ["A^"])
- ("a^^" ["a^"])
- ("C,," ["C,"])
- ("c,," ["c,"])
- ("G^^" ["G^"])
- ("g^^" ["g^"])
- ("I.." ["I."])
- ("i" ["i"])
- ("i.." ["i."])
- ("O\"\"" ["O\""])
- ("o\"\"" ["o\""])
- ("S,," ["S,"])
- ("s,," ["s,"])
- ("U\"\"" ["U\""])
- ("u\"\"" ["u\""])
- ("U^^" ["U^"])
- ("u^^" ["u^"])
- )
-
(quail-define-package
"turkish-postfix" "Turkish" "TR<" t
- "Turkish (T\e,M|\e(Brk\e,Mg\e(Be) input method with postfix modifiers.
+ "Turkish (Türkçe) input method with postfix modifiers.
+turkish-latin-3-postfix is an obsolete alias for turkish-postfix.
-This is for those who use Latin-5 (ISO-8859-9) for Turkish. If you
-use Latin-3 (ISO-8859-3), you should use \"turkish-latin-3-postfix\"
-instead.
+Note for I, ı, İ, i.
-Note for I, \e,M}\e(B, \e,M]\e(B, i.
-
-A^ -> \e,MB\e(B
-C, -> \e,MG\e(B
-G^ -> \e,MP\e(B
+A^ -> Â
+C, -> Ç
+G^ -> Äž
I -> I
-i -> \e,M}\e(B
-I. -> \e,M]\e(B
+i -> ı
+I. -> Ä°
i. -> i
-O\" -> \e,MV\e(B
-S, -> \e,M^\e(B
-U\" -> \e,M\\e(B
-U^ -> \e,M[\e(B
+O\" -> Ö
+S, -> Åž
+U\" -> Ü
+U^ -> Û
Doubling the postfix separates the letter and postfix: e.g. a^^ -> a^
" nil t nil nil nil nil nil nil nil nil t)
(quail-define-rules
- ("A^" ?\e,MB\e(B)
- ("a^" ?\e,Mb\e(B)
- ("C," ?\e,MG\e(B)
- ("c," ?\e,Mg\e(B)
- ("G^" ?\e,MP\e(B)
- ("g^" ?\e,Mp\e(B)
- ("I." ?\e,M]\e(B)
- ("i" ?\e,M}\e(B)
+ ("A^" ?Â)
+ ("a^" ?â)
+ ("C," ?Ç)
+ ("c," ?ç)
+ ("G^" ?Äž)
+ ("g^" ?ÄŸ)
+ ("I." ?Ä°)
+ ("i" ?ı)
("i." ?i)
- ("O\"" ?\e,MV\e(B)
- ("o\"" ?\e,Mv\e(B)
- ("S," ?\e,M^\e(B)
- ("s," ?\e,M~\e(B)
- ("U\"" ?\e,M\\e(B)
- ("u\"" ?\e,M|\e(B)
- ("U^" ?\e,M[\e(B)
- ("u^" ?\e,M{\e(B)
+ ("O\"" ?Ö)
+ ("o\"" ?ö)
+ ("S," ?Åž)
+ ("s," ?ÅŸ)
+ ("U\"" ?Ü)
+ ("u\"" ?ü)
+ ("U^" ?Û)
+ ("u^" ?û)
("A^^" ["A^"])
("a^^" ["a^"])
("u^^" ["u^"])
)
+;; Backwards compatibility.
+(push (cons "turkish-latin-3-postfix"
+ (cdr (assoc "turkish-postfix" quail-package-alist)))
+ quail-package-alist)
+
(quail-define-package
- "british" "Latin-1" "\e,A#\e(B@" t
- "British English input method with Latin-1 character \e,A#\e(B (# -> \e,A#\e(B)"
+ "british" "Latin-1" "£@" t
+ "British English input method with Latin-1 character £ (# -> £)"
nil t nil nil nil nil nil nil nil nil t)
(quail-define-rules
- ("#" [?\e,A#\e(B ?#])
+ ("#" [?£ ?#])
)
;; The following are various quail packages for those who think
-;; the aboves are too awkward. Supported languages and their
+;; the above are too awkward. Supported languages and their
;; package name are:
;;
;; French (frnch, azerty)
;;
(quail-define-package
"french-keyboard" "French" "FR@" t
- "French (Fran\e,Ag\e(Bais) input method simulating some French keyboard
+ "French (Français) input method simulating some French keyboard
<e dans l'o> n'est pas disponible." nil t t t t nil nil nil nil nil t)
-;; \e,Aj\e(B1 \e,Ai\e(B2 \e,Ah\e(B3 \e,At\e(B4 \e,An\e(B5 \e,Ao\e(B6 \e,Ab\e(B7 \e,A{\e(B8 \e,Ay\e(B9 \e,A`\e(B0 -_ \e,Ak\e(B+ `~
-;; qQ wW eE rR tT yY uU iI oO pP \e,AgG\e(B \e,A|\e(B&
+;; ê1 é2 è3 ô4 î5 ï6 â7 û8 ù9 à 0 -_ ë+ `~
+;; qQ wW eE rR tT yY uU iI oO pP çÇ ü&
;; aA sS dD fF gG hH jJ kK lL ;: '" \|
;; zZ xX cC vV bB nN mM ,( .) !?
(quail-define-rules
- ("1" ?\e,Aj\e(B)
- ("2" ?\e,Ai\e(B)
- ("3" ?\e,Ah\e(B)
- ("4" ?\e,At\e(B)
- ("5" ?\e,An\e(B)
- ("6" ?\e,Ao\e(B)
- ("7" ?\e,Ab\e(B)
- ("8" ?\e,A{\e(B)
- ("9" ?\e,Ay\e(B)
- ("0" ?\e,A`\e(B)
- ("=" ?\e,Ak\e(B)
- ("[" ?\e,Ag\e(B)
- ("]" ?\e,A|\e(B)
+ ("1" ?ê)
+ ("2" ?é)
+ ("3" ?è)
+ ("4" ?ô)
+ ("5" ?î)
+ ("6" ?ï)
+ ("7" ?â)
+ ("8" ?û)
+ ("9" ?ù)
+ ("0" ?Ã )
+ ("=" ?ë)
+ ("[" ?ç)
+ ("]" ?ü)
("!" ?1)
("@" ?2)
("*" ?8)
("(" ?9)
(")" ?0)
- ("{" ?\e,AG\e(B)
+ ("{" ?Ç)
("}" ?&)
("<" ?\()
(">" ?\))
;;
(quail-define-package
"french-azerty" "French" "AZ@" t
- "French (Fran\e,Ag\e(Bais) input method simulating Azerty keyboard
+ "French (Français) input method simulating Azerty keyboard
-Similaire au clavier fran\e,Ag\e(Bais de SUN.
-pr\e,Ai\e(Bfixes: ^ pour circonflexe, \e,A(\e(B pour tr\e,Ai\e(Bma.
+Similaire au clavier français de SUN.
+préfixes: ^ pour circonflexe, ¨ pour tréma.
<e dans l'o> n'est pas disponible." nil t t t t nil nil nil nil nil t)
-;; &1 \e,Ai\e(B2 "3 '4 (5 \e,A'\e(B6 \e,Ah\e(B7 !8 \e,Ag\e(B9 \e,A`\e(B0 )\e,A0\e(B -_ @~
-;; aA zZ eE rR tT yY uU iI oO pP ^\e,A(\e(B `$
-;; qQ sS dD fF gG hH jJ kK lL mM \e,Ay\e(B% *|
+;; &1 é2 "3 '4 (5 §6 è7 !8 ç9 à 0 )° -_ @~
+;; aA zZ eE rR tT yY uU iI oO pP ^¨ `$
+;; qQ sS dD fF gG hH jJ kK lL mM ù% *|
;; wW xX cC vV bB nN ,? ;. :/ =+
(quail-define-rules
("1" ?&)
- ("2" ?\e,Ai\e(B)
+ ("2" ?é)
("3" ?\")
("4" ?')
("5" ?\()
- ("6" ?\e,A'\e(B)
- ("7" ?\e,Ah\e(B)
+ ("6" ?§)
+ ("7" ?è)
("8" ?!)
- ("9" ?\e,Ag\e(B)
- ("0" ?\e,A`\e(B)
+ ("9" ?ç)
+ ("0" ?Ã )
("-" ?\))
("=" ?-)
("`" ?@)
("k" ?k)
("l" ?l)
(";" ?m)
- ("'" ?\e,Ay\e(B)
+ ("'" ?ù)
("\\" ?*)
("z" ?w)
("x" ?x)
("*" ?8)
("(" ?9)
(")" ?0)
- ("_" ?\e,A0\e(B)
+ ("_" ?°)
("+" ?_)
("~" ?~)
("Q" ?A)
("I" ?I)
("O" ?O)
("P" ?P)
- ("{" ?\e,A(\e(B)
+ ("{" ?¨)
("}" ?$)
("A" ?Q)
("S" ?S)
(">" ?/)
("?" ?+)
- ("[q" ?\e,Ab\e(B)
- ("[e" ?\e,Aj\e(B)
- ("[i" ?\e,An\e(B)
- ("[o" ?\e,At\e(B)
- ("[u" ?\e,A{\e(B)
+ ("[q" ?â)
+ ("[e" ?ê)
+ ("[i" ?î)
+ ("[o" ?ô)
+ ("[u" ?û)
- ("{e" ?\e,Ak\e(B)
- ("{i" ?\e,Ao\e(B)
- ("{u" ?\e,A|\e(B)
+ ("{e" ?ë)
+ ("{i" ?ï)
+ ("{u" ?ü)
("[[" ?^)
- ("{{" ?\e,A(\e(B)
+ ("{{" ?¨)
)
;;
(quail-define-package
"icelandic-keyboard" "Latin-1" "IS@" t
- "Icelandic (\e,AM\e(Bslenska) input method simulating some Icelandic keyboard
+ "Icelandic (Ãslenska) input method simulating some Icelandic keyboard
-Dead accent is right to \e,Af\e(B." nil t t t t nil nil nil nil nil t)
+Dead accent is right to æ." nil t t t t nil nil nil nil nil t)
-;; 1! 2" 3# 4$ 5% 6^ 7& 8* 9( 0) \e,AvV\e(B -_ `~
-;; qQ wW eE rR tT yY uU iI oO pP \e,ApP\e(B '?
-;; aA sS dD fF gG hH jJ kK lL \e,AfF\e(B \e,A44\e(B +*
-;; zZ xX cC vV bB nN mM ,; .: \e,A~^\e(B
+;; 1! 2" 3# 4$ 5% 6^ 7& 8* 9( 0) öÖ -_ `~
+;; qQ wW eE rR tT yY uU iI oO pP ðà '?
+;; aA sS dD fF gG hH jJ kK lL æÆ ´´ +*
+;; zZ xX cC vV bB nN mM ,; .: þÞ
(quail-define-rules
- ("-" ?\e,Av\e(B)
+ ("-" ?ö)
("=" ?-)
- ("[" ?\e,Ap\e(B)
+ ("[" ?ð)
("]" ?')
- (";" ?\e,Af\e(B)
- ("'" ?\e,A4\e(B)
+ (";" ?æ)
+ ("'" ?´)
("\\" ?+)
- ("/" ?\e,A~\e(B)
+ ("/" ?þ)
("@" ?\")
- ("_" ?\e,AV\e(B)
+ ("_" ?Ö)
("+" ?_)
- ("{" ?\e,AP\e(B)
+ ("{" ?Ã)
("}" ??)
- (":" ?\e,AF\e(B)
- ("\"" ?\e,A4\e(B)
+ (":" ?Æ)
+ ("\"" ?´)
("|" ?*)
("<" ?\;)
(">" ?:)
- ("?" ?\e,A^\e(B)
-
- ("'a" ?\e,Aa\e(B)
- ("'e" ?\e,Ai\e(B)
- ("'i" ?\e,Am\e(B)
- ("'o" ?\e,As\e(B)
- ("'u" ?\e,Az\e(B)
- ("'y" ?\e,A}\e(B)
- ("'A" ?\e,AA\e(B)
- ("'E" ?\e,AI\e(B)
- ("'I" ?\e,AM\e(B)
- ("'O" ?\e,AS\e(B)
- ("'U" ?\e,AZ\e(B)
- ("'Y" ?\e,A]\e(B)
-
- ("''" ?\e,A4\e(B)
+ ("?" ?Þ)
+
+ ("'a" ?á)
+ ("'e" ?é)
+ ("'i" ?Ã)
+ ("'o" ?ó)
+ ("'u" ?ú)
+ ("'y" ?ý)
+ ("'A" ?Ã)
+ ("'E" ?É)
+ ("'I" ?Ã)
+ ("'O" ?Ó)
+ ("'U" ?Ú)
+ ("'Y" ?Ã)
+
+ ("''" ?´)
)
;;
"Danish input method simulating SUN Danish keyboard"
nil t t t t nil nil nil nil nil t)
-;; 1! 2" 3# 4\e,A$\e(B 5% 6& 7/ 8( 9) 0= +? \e,A='\e(B ~^
-;; qQ wW eE rR tT yY uU iI oO pP \e,AeE\e(B \e,AiI\e(B
-;; aA sS dD fF gG hH jJ kK lL \e,AfF\e(B \e,AxX\e(B '*
+;; 1! 2" 3# 4¤ 5% 6& 7/ 8( 9) 0= +? ½§ ~^
+;; qQ wW eE rR tT yY uU iI oO pP åÅ éÉ
+;; aA sS dD fF gG hH jJ kK lL æÆ øØ '*
;; zZ xX cC vV bB nN mM ,; .: -_
(quail-define-rules
("-" ?+)
- ("=" ?\e,A=\e(B)
+ ("=" ?½)
("`" ?~)
- ("[" ?\e,Ae\e(B)
- ("]" ?\e,Ai\e(B)
- (";" ?\e,Af\e(B)
- ("'" ?\e,Ax\e(B)
+ ("[" ?Ã¥)
+ ("]" ?é)
+ (";" ?æ)
+ ("'" ?ø)
("\\" ?')
("/" ?-)
("@" ?\")
- ("$" ?\e,A$\e(B)
+ ("$" ?¤)
("^" ?&)
("&" ?/)
("*" ?\()
("(" ?\))
(")" ?=)
("_" ??)
- ("+" ?\e,A'\e(B)
+ ("+" ?§)
("~" ?^)
- ("{" ?\e,AE\e(B)
- ("}" ?\e,AI\e(B)
- (":" ?\e,AF\e(B)
- ("\"" ?\e,AX\e(B)
+ ("{" ?Ã…)
+ ("}" ?É)
+ (":" ?Æ)
+ ("\"" ?Ø)
("|" ?*)
("<" ?\;)
(">" ?:)
"Norwegian (Norsk) input method simulating SUN Norwegian keyboard"
nil t t t t nil nil nil nil nil t)
-;; 1! 2" 3# 4\e,A$\e(B 5% 6& 7/ 8( 9) 0= +? |\e,A'\e(B ~^
-;; qQ wW eE rR tT yY uU iI oO pP \e,AeE\e(B \e,AiI\e(B
-;; aA sS dD fF gG hH jJ kK lL \e,AxX\e(B \e,AfF\e(B '*
+;; 1! 2" 3# 4¤ 5% 6& 7/ 8( 9) 0= +? |§ ~^
+;; qQ wW eE rR tT yY uU iI oO pP åÅ éÉ
+;; aA sS dD fF gG hH jJ kK lL øØ æÆ '*
;; zZ xX cC vV bB nN mM ,; .: '?
(quail-define-rules
("-" ?+)
("=" ?|)
("`" ?~)
- ("[" ?\e,Ae\e(B)
- ("]" ?\e,Ai\e(B)
- (";" ?\e,Ax\e(B)
- ("'" ?\e,Af\e(B)
+ ("[" ?Ã¥)
+ ("]" ?é)
+ (";" ?ø)
+ ("'" ?æ)
("\\" ?')
("/" ?-)
("!" ?!)
("@" ?\")
- ("$" ?\e,A$\e(B)
+ ("$" ?¤)
("^" ?&)
("&" ?/)
("*" ?\()
("(" ?\))
(")" ?=)
("_" ??)
- ("+" ?\e,A'\e(B)
+ ("+" ?§)
("~" ?^)
- ("{" ?\e,AE\e(B)
- ("}" ?\e,AI\e(B)
- (":" ?\e,AX\e(B)
- ("\"" ?\e,AF\e(B)
+ ("{" ?Ã…)
+ ("}" ?É)
+ (":" ?Ø)
+ ("\"" ?Æ)
("|" ?*)
("<" ?\;)
(">" ?:)
"Swedish (Svenska) input method simulating SUN Swedish/Finnish keyboard"
nil t t t t nil nil nil nil nil t)
-;; 1! 2" 3# 4\e,A$\e(B 5% 6& 7/ 8( 9) 0= +? \e,A'=\e(B ~^
-;; qQ wW eE rR tT yY uU iI oO pP \e,AeE\e(B \e,AiI\e(B
-;; aA sS dD fF gG hH jJ kK lL \e,AvV\e(B \e,AdD\e(B '*
+;; 1! 2" 3# 4¤ 5% 6& 7/ 8( 9) 0= +? §½ ~^
+;; qQ wW eE rR tT yY uU iI oO pP åÅ éÉ
+;; aA sS dD fF gG hH jJ kK lL öÖ äÄ '*
;; zZ xX cC vV bB nN mM ,; .: -_
(quail-define-rules
("-" ?+)
- ("=" ?\e,A'\e(B)
+ ("=" ?§)
("`" ?~)
- ("[" ?\e,Ae\e(B)
- ("]" ?\e,Ai\e(B)
- (";" ?\e,Av\e(B)
- ("'" ?\e,Ad\e(B)
+ ("[" ?Ã¥)
+ ("]" ?é)
+ (";" ?ö)
+ ("'" ?ä)
("\\" ?')
("/" ?-)
("@" ?\")
- ("$" ?\e,A$\e(B)
+ ("$" ?¤)
("^" ?&)
("&" ?/)
("*" ?\()
("(" ?\))
(")" ?=)
("_" ??)
- ("+" ?\e,A=\e(B)
+ ("+" ?½)
("~" ?^)
- ("{" ?\e,AE\e(B)
- ("}" ?\e,AI\e(B)
- (":" ?\e,AV\e(B)
- ("\"" ?\e,AD\e(B)
+ ("{" ?Ã…)
+ ("}" ?É)
+ (":" ?Ö)
+ ("\"" ?Ä)
("|" ?*)
("<" ?\;)
(">" ?:)
"Finnish input method simulating SUN Finnish/Swedish keyboard"
nil t t t t nil nil nil nil nil t)
-;; 1! 2" 3# 4\e,A$\e(B 5% 6& 7/ 8( 9) 0= +? \e,A'=\e(B ~^
-;; qQ wW eE rR tT yY uU iI oO pP \e,AeE\e(B \e,AiI\e(B
-;; aA sS dD fF gG hH jJ kK lL \e,AvV\e(B \e,AdD\e(B '*
+;; 1! 2" 3# 4¤ 5% 6& 7/ 8( 9) 0= +? §½ ~^
+;; qQ wW eE rR tT yY uU iI oO pP åÅ éÉ
+;; aA sS dD fF gG hH jJ kK lL öÖ äÄ '*
;; zZ xX cC vV bB nN mM ,; .: -_
(quail-define-rules
("-" ?+)
- ("=" ?\e,A'\e(B)
+ ("=" ?§)
("`" ?~)
- ("[" ?\e,Ae\e(B)
- ("]" ?\e,Ai\e(B)
- (";" ?\e,Av\e(B)
- ("'" ?\e,Ad\e(B)
+ ("[" ?Ã¥)
+ ("]" ?é)
+ (";" ?ö)
+ ("'" ?ä)
("\\" ?')
("/" ?-)
("@" ?\")
- ("$" ?\e,A$\e(B)
+ ("$" ?¤)
("^" ?&)
("&" ?/)
("*" ?\()
("(" ?\))
(")" ?=)
("_" ??)
- ("+" ?\e,A=\e(B)
+ ("+" ?½)
("~" ?^)
- ("{" ?\e,AE\e(B)
- ("}" ?\e,AI\e(B)
- (":" ?\e,AV\e(B)
- ("\"" ?\e,AD\e(B)
+ ("{" ?Ã…)
+ ("}" ?É)
+ (":" ?Ö)
+ ("\"" ?Ä)
("|" ?*)
("<" ?\;)
(">" ?:)
"German (Deutsch) input method simulating SUN German keyboard"
nil t t t t nil nil nil nil nil t)
-;; 1! 2" 3\e,A'\e(B 4$ 5% 6& 7/ 8( 9) 0= \e,A_\e(B? [{ ]}
-;; qQ wW eE rR tT zZ uU iI oO pP \e,A|\\e(B +*
-;; aA sS dD fF gG hH jJ kK lL \e,AvV\e(B \e,AdD\e(B #^
+;; 1! 2" 3§ 4$ 5% 6& 7/ 8( 9) 0= ß? [{ ]}
+;; qQ wW eE rR tT zZ uU iI oO pP üÜ +*
+;; aA sS dD fF gG hH jJ kK lL öÖ äÄ #^
;; yY xX cC vV bB nN mM ,; .: -_
(quail-define-rules
- ("-" ?\e,A_\e(B)
+ ("-" ?ß)
("=" ?\[)
("`" ?\])
("y" ?z)
- ("[" ?\e,A|\e(B)
+ ("[" ?ü)
("]" ?+)
- (";" ?\e,Av\e(B)
- ("'" ?\e,Ad\e(B)
+ (";" ?ö)
+ ("'" ?ä)
("\\" ?#)
("z" ?y)
("/" ?-)
("@" ?\")
- ("#" ?\e,A'\e(B)
+ ("#" ?§)
("^" ?&)
("&" ?/)
("*" ?\()
("_" ??)
("+" ?{)
("~" ?})
- ("{" ?\e,A\\e(B)
+ ("{" ?Ü)
("}" ?*)
- (":" ?\e,AV\e(B)
- ("\"" ?\e,AD\e(B)
+ (":" ?Ö)
+ ("\"" ?Ä)
("|" ?^)
("Z" ?Y)
("<" ?\;)
"Italian (Italiano) input method simulating SUN Italian keyboard"
nil t t t t nil nil nil nil nil t)
-;; 1! 2" 3\e,A#\e(B 4$ 5% 6& 7/ 8( 9) 0= '? \e,Al\e(B^ `~
-;; qQ wW eE rR tT yY uU iI oO pP \e,Ahi\e(B +*
-;; aA sS dD fF gG hH jJ kK lL \e,Arg\e(B \e,A`0\e(B \e,Ay'\e(B
+;; 1! 2" 3£ 4$ 5% 6& 7/ 8( 9) 0= '? ì^ `~
+;; qQ wW eE rR tT yY uU iI oO pP èé +*
+;; aA sS dD fF gG hH jJ kK lL òç à ° ù§
;; zZ xX cC vV bB nN mM ,; .: -_
(quail-define-rules
("-" ?')
- ("=" ?\e,Al\e(B)
- ("[" ?\e,Ah\e(B)
+ ("=" ?ì)
+ ("[" ?è)
("]" ?+)
- (";" ?\e,Ar\e(B)
- ("'" ?\e,A`\e(B)
- ("\\" ?\e,Ay\e(B)
+ (";" ?ò)
+ ("'" ?Ã )
+ ("\\" ?ù)
("/" ?-)
("@" ?\")
- ("#" ?\e,A#\e(B)
+ ("#" ?£)
("^" ?&)
("&" ?/)
("*" ?\()
("_" ??)
("+" ?^)
("~" ?~)
- ("{" ?\e,Ai\e(B)
+ ("{" ?é)
("}" ?*)
- (":" ?\e,Ag\e(B)
- ("\"" ?\e,A0\e(B)
- ("|" ?\e,A'\e(B)
+ (":" ?ç)
+ ("\"" ?°)
+ ("|" ?§)
("<" ?\;)
(">" ?:)
("?" ?_)
;;
(quail-define-package
"spanish-keyboard" "Spanish" "ES@" t
- "Spanish (Espa\e,Aq\e(Bol) input method simulating SUN Spanish keyboard"
+ "Spanish (Español) input method simulating SUN Spanish keyboard"
nil t t t t nil nil nil nil nil t)
-;; 1! 2" 3\e,A7\e(B 4$ 5% 6& 7/ 8( 9) 0= '? \e,A!?\e(B \e,AmM\e(B
-;; qQ wW eE rR tT yY uU iI oO pP \e,AiI\e(B \e,AsS\e(B
-;; aA sS dD fF gG hH jJ kK lL \e,AqQ\e(B \e,AaA\e(B \e,AzZ\e(B
+;; 1! 2" 3· 4$ 5% 6& 7/ 8( 9) 0= '? ¡¿ ÃÃ
+;; qQ wW eE rR tT yY uU iI oO pP éÉ óÓ
+;; aA sS dD fF gG hH jJ kK lL ñÑ áà úÚ
;; zZ xX cC vV bB nN mM ,; .: -_
(quail-define-rules
("-" ?')
- ("=" ?\e,A!\e(B)
- ("`" ?\e,Am\e(B)
- ("[" ?\e,Ai\e(B)
- ("]" ?\e,As\e(B)
- (";" ?\e,Aq\e(B)
- ("'" ?\e,Aa\e(B)
- ("\\" ?\e,Az\e(B)
+ ("=" ?¡)
+ ("`" ?Ã)
+ ("[" ?é)
+ ("]" ?ó)
+ (";" ?ñ)
+ ("'" ?á)
+ ("\\" ?ú)
("/" ?-)
("@" ?\")
- ("#" ?\e,A7\e(B)
+ ("#" ?·)
("^" ?&)
("&" ?/)
("*" ?\()
("(" ?\))
(")" ?=)
("_" ??)
- ("+" ?\e,A?\e(B)
- ("~" ?\e,AM\e(B)
- ("{" ?\e,AI\e(B)
- ("}" ?\e,AS\e(B)
- (":" ?\e,AQ\e(B)
- ("\"" ?\e,AA\e(B)
- ("|" ?\e,AZ\e(B)
+ ("+" ?¿)
+ ("~" ?Ã)
+ ("{" ?É)
+ ("}" ?Ó)
+ (":" ?Ñ)
+ ("\"" ?Ã)
+ ("|" ?Ú)
("<" ?\;)
(">" ?:)
("?" ?_)
| postfix | examples
------------+---------+----------
- acute | ' | a' -> \e,Aa\e(B
- grave | ` | a` -> \e,A`\e(B
- circumflex | ^ | a^ -> \e,Ab\e(B
- diaeresis | \" | a\" -> \e,Ad\e(B
- tilde | ~ | a~ -> \e,Ac\e(B
- cedilla | , | c, -> \e,Ag\e(B
- ogonek | , | a, -> \e$,1 %\e(B
- breve | ~ | a~ -> \e$,1 #\e(B
- caron | ~ | c~ -> \e$,1 -\e(B
- dbl. acute | : | o: -> \e$,1 q\e(B
- ring | . | u. -> \e$,1!/\e(B
- dot | . | z. -> \e$,1!<\e(B
- stroke | / | d/ -> \e$,1 1\e(B
- nordic | / | d/ -> \e,Ap\e(B t/ -> \e,A~\e(B a/ -> \e,Ae\e(B e/ -> \e,Af\e(B o/ -> \e,Ax\e(B
- others | / | s/ -> \e,A_\e(B ?/ -> \e,A?\e(B !/ -> \e,A!\e(B // -> \e,A0\e(B
- | various | << -> \e,A+\e(B >> -> \e,A;\e(B o_ -> \e,A:\e(B a_ -> \e,A*\e(B
+ acute | ' | a' -> á
+ grave | ` | a` -> Ã
+ circumflex | ^ | a^ -> â
+ diaeresis | \" | a\" -> ä
+ tilde | ~ | a~ -> ã
+ cedilla | , | c, -> ç
+ ogonek | , | a, -> Ä…
+ breve | ~ | a~ -> ă
+ caron | ~ | c~ -> Ä
+ dbl. acute | : | o: -> Å‘
+ ring | . | u. -> ů
+ dot | . | z. -> ż
+ stroke | / | d/ -> Ä‘
+ nordic | / | d/ -> ð t/ -> þ a/ -> å e/ -> æ o/ -> ø
+ others | / | s/ -> ß ?/ -> ¿ !/ -> ¡ // -> °
+ | various | << -> « >> -> » o_ -> º a_ -> ª
Doubling the postfix separates the letter and postfix: e.g. a'' -> a'
" nil t nil nil nil nil nil nil nil nil t)
-;; Fixme: \e,A&\e(B \e,A'\e(B \e,A(\e(B \e,A)\e(B \e,A,\e(B \e,A-\e(B \e,A.\e(B \e,A/\e(B \e,A1\e(B \e,A2\e(B \e,A3\e(B \e,A4\e(B \e,A5\e(B \e,A6\e(B \e,A7\e(B \e,A8\e(B \e,A9\e(B \e,A<\e(B \e,A=\e(B \e,A>\e(B \e,AW\e(B \e,Aw\e(B
+;; Fixme: ¦ § ¨ © ¬  ® ¯ ± ² ³ ´ µ ¶ · ¸ ¹ ¼ ½ ¾ × ÷
(quail-define-rules
- (" _" ?\e,A \e(B)
- ("!/" ?\e,A!\e(B)
- ("//" ?\e,A0\e(B)
- ("<<" ?\\e,A+\e(B)
- (">>" ?\\e,A;\e(B)
- ("?/" ?\e,A?\e(B)
- ("$/" ?\e,A#\e(B)
- ("$/" ?\e,A$\e(B)
- ("A'" ?\e,AA\e(B)
- ("A," ?\e$,1 $\e(B)
- ("A-" ?\e$,1 \e(B)
- ("A/" ?\e,AE\e(B)
- ("A\"" ?\e,AD\e(B)
- ("A^" ?\e,AB\e(B)
- ("A`" ?\e,A@\e(B)
- ("A~" ?\e,AC\e(B)
- ("A~" ?\e$,1 "\e(B)
- ("C'" ?\e$,1 &\e(B)
- ("C," ?\e,AG\e(B)
- ("C." ?\e$,1 *\e(B)
- ("C^" ?\e$,1 (\e(B)
- ("C~" ?\e$,1 ,\e(B)
- ("D/" ?\e,AP\e(B)
- ("D/" ?\e$,1 0\e(B)
- ("D~" ?\e$,1 .\e(B)
- ("E'" ?\e,AI\e(B)
- ("E," ?\e$,1 8\e(B)
- ("E-" ?\e$,1 2\e(B)
- ("E." ?\e$,1 6\e(B)
- ("E/" ?\e,AF\e(B)
- ("E\"" ?\e,AK\e(B)
- ("E^" ?\e,AJ\e(B)
- ("E`" ?\e,AH\e(B)
- ("E~" ?\e$,1 :\e(B)
- ("G," ?\e$,1 B\e(B)
- ("G." ?\e$,1 @\e(B)
- ("G^" ?\e$,1 <\e(B)
- ("G~" ?\e$,1 >\e(B)
- ("H/" ?\e$,1 F\e(B)
- ("H^" ?\e$,1 D\e(B)
- ("I'" ?\e,AM\e(B)
- ("I," ?\e$,1 N\e(B)
- ("I-" ?\e$,1 J\e(B)
- ("I." ?\e$,1 P\e(B)
- ("I\"" ?\e,AO\e(B)
- ("I^" ?\e,AN\e(B)
- ("I`" ?\e,AL\e(B)
- ("I~" ?\e$,1 H\e(B)
- ("J^" ?\e$,1 T\e(B)
- ("K," ?\e$,1 V\e(B)
- ("L'" ?\e$,1 Y\e(B)
- ("L," ?\e$,1 [\e(B)
- ("L/" ?\e$,1 a\e(B)
- ("L~" ?\e$,1 ]\e(B)
- ("N'" ?\e$,1 c\e(B)
- ("N," ?\e$,1 e\e(B)
- ("N/" ?\e$,1 j\e(B)
- ("N~" ?\e,AQ\e(B)
- ("N~" ?\e$,1 g\e(B)
- ("O'" ?\e,AS\e(B)
- ("O-" ?\e$,1 l\e(B)
- ("O/" ?\e,AX\e(B)
- ("O/" ?\e$,1 r\e(B)
- ("O:" ?\e$,1 p\e(B)
- ("O\"" ?\e,AV\e(B)
- ("O^" ?\e,AT\e(B)
- ("O`" ?\e,AR\e(B)
- ("O~" ?\e,AU\e(B)
- ("R'" ?\e$,1 t\e(B)
- ("R," ?\e$,1 v\e(B)
- ("R~" ?\e$,1 x\e(B)
- ("S'" ?\e$,1 z\e(B)
- ("S," ?\e$,1 ~\e(B)
- ("S^" ?\e$,1 |\e(B)
- ("S~" ?\e$,1! \e(B)
- ("T," ?\e$,1!"\e(B)
- ("T/" ?\e,A^\e(B)
- ("T/" ?\e$,1!&\e(B)
- ("T~" ?\e$,1!$\e(B)
- ("U'" ?\e,AZ\e(B)
- ("U," ?\e$,1!2\e(B)
- ("U-" ?\e$,1!*\e(B)
- ("U." ?\e$,1!.\e(B)
- ("U:" ?\e$,1!0\e(B)
- ("U\"" ?\e,A\\e(B)
- ("U^" ?\e,A[\e(B)
- ("U`" ?\e,AY\e(B)
- ("U~" ?\e$,1!(\e(B)
- ("U~" ?\e$,1!,\e(B)
- ("Y'" ?\e,A]\e(B)
- ("Y\"" ?\e$,1!8\e(B)
- ("Y=" ?\e,A%\e(B)
- ("Z'" ?\e$,1!9\e(B)
- ("Z." ?\e$,1!;\e(B)
- ("Z~" ?\e$,1!=\e(B)
- ("a'" ?\e,Aa\e(B)
- ("a," ?\e$,1 %\e(B)
- ("a-" ?\e$,1 !\e(B)
- ("a/" ?\e,Ae\e(B)
- ("a\"" ?\e,Ad\e(B)
- ("a^" ?\e,Ab\e(B)
- ("a_" ?\e,A*\e(B)
- ("a`" ?\e,A`\e(B)
- ("a~" ?\e,Ac\e(B)
- ("a~" ?\e$,1 #\e(B)
- ("c'" ?\e$,1 '\e(B)
- ("c," ?\e,Ag\e(B)
- ("c." ?\e$,1 +\e(B)
- ("c^" ?\e$,1 )\e(B)
- ("c~" ?\e$,1 -\e(B)
- ("c/" ?\e,A"\e(B)
- ("d/" ?\e,Ap\e(B)
- ("d/" ?\e$,1 1\e(B)
- ("d~" ?\e$,1 /\e(B)
- ("e'" ?\e,Ai\e(B)
- ("e," ?\e$,1 9\e(B)
- ("e-" ?\e$,1 3\e(B)
- ("e." ?\e$,1 7\e(B)
- ("e/" ?\e,Af\e(B)
- ("e\"" ?\e,Ak\e(B)
- ("e^" ?\e,Aj\e(B)
- ("e`" ?\e,Ah\e(B)
- ("e~" ?\e$,1 ;\e(B)
- ("e=" ?\e$,1tL\e(B)
- ("g," ?\e$,1 C\e(B)
- ("g." ?\e$,1 A\e(B)
- ("g^" ?\e$,1 =\e(B)
- ("g~" ?\e$,1 ?\e(B)
- ("h/" ?\e$,1 G\e(B)
- ("h^" ?\e$,1 E\e(B)
- ("i'" ?\e,Am\e(B)
- ("i," ?\e$,1 O\e(B)
- ("i-" ?\e$,1 K\e(B)
- ("i." ?\e$,1 Q\e(B)
- ("i\"" ?\e,Ao\e(B)
- ("i^" ?\e,An\e(B)
- ("i`" ?\e,Al\e(B)
- ("i~" ?\e$,1 I\e(B)
- ("j^" ?\e$,1 U\e(B)
- ("k," ?\e$,1 W\e(B)
- ("k/" ?\e$,1 X\e(B)
- ("l'" ?\e$,1 Z\e(B)
- ("l," ?\e$,1 \\e(B)
- ("l/" ?\e$,1 b\e(B)
- ("l~" ?\e$,1 ^\e(B)
- ("n'" ?\e$,1 d\e(B)
- ("n," ?\e$,1 f\e(B)
- ("n/" ?\e$,1 k\e(B)
- ("n~" ?\e,Aq\e(B)
- ("n~" ?\e$,1 h\e(B)
- ("o'" ?\e,As\e(B)
- ("o-" ?\e$,1 m\e(B)
- ("o/" ?\e,Ax\e(B)
- ("o/" ?\e$,1 s\e(B)
- ("o:" ?\e$,1 q\e(B)
- ("o\"" ?\e,Av\e(B)
- ("o^" ?\e,At\e(B)
- ("o_" ?\e,A:\e(B)
- ("o`" ?\e,Ar\e(B)
- ("o~" ?\e,Au\e(B)
- ("r'" ?\e$,1 u\e(B)
- ("r," ?\e$,1 w\e(B)
- ("r~" ?\e$,1 y\e(B)
- ("s'" ?\e$,1 {\e(B)
- ("s," ?\e$,1 \7f\e(B)
- ("s/" ?\e,A_\e(B)
- ("s^" ?\e$,1 }\e(B)
- ("s~" ?\e$,1!!\e(B)
- ("t," ?\e$,1!#\e(B)
- ("t/" ?\e,A~\e(B)
- ("t/" ?\e$,1!'\e(B)
- ("t~" ?\e$,1!%\e(B)
- ("u'" ?\e,Az\e(B)
- ("u," ?\e$,1!3\e(B)
- ("u-" ?\e$,1!+\e(B)
- ("u." ?\e$,1!/\e(B)
- ("u:" ?\e$,1!1\e(B)
- ("u\"" ?\e,A|\e(B)
- ("u^" ?\e,A{\e(B)
- ("u`" ?\e,Ay\e(B)
- ("u~" ?\e$,1!)\e(B)
- ("u~" ?\e$,1!-\e(B)
- ("y'" ?\e,A}\e(B)
- ("y\"" ?\e,A\7f\e(B)
- ("z'" ?\e$,1!:\e(B)
- ("z." ?\e$,1!<\e(B)
- ("z~" ?\e$,1!>\e(B)
+ (" _" ? )
+ ("!/" ?¡)
+ ("//" ?°)
+ ("<<" ?\«)
+ (">>" ?\»)
+ ("?/" ?¿)
+ ("$/" ?£)
+ ("$/" ?¤)
+ ("A'" ?Ã)
+ ("A," ?Ä„)
+ ("A-" ?Ä€)
+ ("A/" ?Ã…)
+ ("A\"" ?Ä)
+ ("A^" ?Â)
+ ("A`" ?À)
+ ("A~" ?Ã)
+ ("A~" ?Ä‚)
+ ("C'" ?Ć)
+ ("C," ?Ç)
+ ("C." ?ÄŠ)
+ ("C^" ?Ĉ)
+ ("C~" ?Č)
+ ("D/" ?Ã)
+ ("D/" ?Ä)
+ ("D~" ?ÄŽ)
+ ("E'" ?É)
+ ("E," ?Ę)
+ ("E-" ?Ä’)
+ ("E." ?Ä–)
+ ("E/" ?Æ)
+ ("E\"" ?Ë)
+ ("E^" ?Ê)
+ ("E`" ?È)
+ ("E~" ?Äš)
+ ("G," ?Ä¢)
+ ("G." ?Ä )
+ ("G^" ?Ĝ)
+ ("G~" ?Äž)
+ ("H/" ?Ħ)
+ ("H^" ?Ĥ)
+ ("I'" ?Ã)
+ ("I," ?Ä®)
+ ("I-" ?Ī)
+ ("I." ?Ä°)
+ ("I\"" ?Ã)
+ ("I^" ?ÃŽ)
+ ("I`" ?Ì)
+ ("I~" ?Ĩ)
+ ("J^" ?Ä´)
+ ("K," ?Ķ)
+ ("L'" ?Ĺ)
+ ("L," ?Ä»)
+ ("L/" ?Å)
+ ("L~" ?Ľ)
+ ("N'" ?Ń)
+ ("N," ?Å…)
+ ("N/" ?ÅŠ)
+ ("N~" ?Ñ)
+ ("N~" ?Ň)
+ ("O'" ?Ó)
+ ("O-" ?Ō)
+ ("O/" ?Ø)
+ ("O/" ?Å’)
+ ("O:" ?Å)
+ ("O\"" ?Ö)
+ ("O^" ?Ô)
+ ("O`" ?Ã’)
+ ("O~" ?Õ)
+ ("R'" ?Å”)
+ ("R," ?Å–)
+ ("R~" ?Ř)
+ ("S'" ?Åš)
+ ("S," ?Åž)
+ ("S^" ?Ŝ)
+ ("S~" ?Å )
+ ("T," ?Å¢)
+ ("T/" ?Þ)
+ ("T/" ?Ŧ)
+ ("T~" ?Ť)
+ ("U'" ?Ú)
+ ("U," ?Ų)
+ ("U-" ?Ū)
+ ("U." ?Å®)
+ ("U:" ?Å°)
+ ("U\"" ?Ü)
+ ("U^" ?Û)
+ ("U`" ?Ù)
+ ("U~" ?Ũ)
+ ("U~" ?Ŭ)
+ ("Y'" ?Ã)
+ ("Y\"" ?Ÿ)
+ ("Y=" ?Â¥)
+ ("Z'" ?Ź)
+ ("Z." ?Å»)
+ ("Z~" ?Ž)
+ ("a'" ?á)
+ ("a," ?Ä…)
+ ("a-" ?Ä)
+ ("a/" ?Ã¥)
+ ("a\"" ?ä)
+ ("a^" ?â)
+ ("a_" ?ª)
+ ("a`" ?Ã )
+ ("a~" ?ã)
+ ("a~" ?ă)
+ ("c'" ?ć)
+ ("c," ?ç)
+ ("c." ?Ä‹)
+ ("c^" ?ĉ)
+ ("c~" ?Ä)
+ ("c/" ?¢)
+ ("d/" ?ð)
+ ("d/" ?Ä‘)
+ ("d~" ?Ä)
+ ("e'" ?é)
+ ("e," ?Ä™)
+ ("e-" ?Ä“)
+ ("e." ?Ä—)
+ ("e/" ?æ)
+ ("e\"" ?ë)
+ ("e^" ?ê)
+ ("e`" ?è)
+ ("e~" ?Ä›)
+ ("e=" ?€)
+ ("g," ?Ä£)
+ ("g." ?Ä¡)
+ ("g^" ?Ä)
+ ("g~" ?ÄŸ)
+ ("h/" ?ħ)
+ ("h^" ?Ä¥)
+ ("i'" ?Ã)
+ ("i," ?į)
+ ("i-" ?Ä«)
+ ("i." ?ı)
+ ("i\"" ?ï)
+ ("i^" ?î)
+ ("i`" ?ì)
+ ("i~" ?Ä©)
+ ("j^" ?ĵ)
+ ("k," ?Ä·)
+ ("k/" ?ĸ)
+ ("l'" ?ĺ)
+ ("l," ?ļ)
+ ("l/" ?Å‚)
+ ("l~" ?ľ)
+ ("n'" ?Å„)
+ ("n," ?ņ)
+ ("n/" ?Å‹)
+ ("n~" ?ñ)
+ ("n~" ?ň)
+ ("o'" ?ó)
+ ("o-" ?Å)
+ ("o/" ?ø)
+ ("o/" ?Å“)
+ ("o:" ?Å‘)
+ ("o\"" ?ö)
+ ("o^" ?ô)
+ ("o_" ?º)
+ ("o`" ?ò)
+ ("o~" ?õ)
+ ("r'" ?Å•)
+ ("r," ?Å—)
+ ("r~" ?Å™)
+ ("s'" ?Å›)
+ ("s," ?ÅŸ)
+ ("s/" ?ß)
+ ("s^" ?Å)
+ ("s~" ?Å¡)
+ ("t," ?Å£)
+ ("t/" ?þ)
+ ("t/" ?ŧ)
+ ("t~" ?Å¥)
+ ("u'" ?ú)
+ ("u," ?ų)
+ ("u-" ?Å«)
+ ("u." ?ů)
+ ("u:" ?ű)
+ ("u\"" ?ü)
+ ("u^" ?û)
+ ("u`" ?ù)
+ ("u~" ?Å©)
+ ("u~" ?Å)
+ ("y'" ?ý)
+ ("y\"" ?ÿ)
+ ("z'" ?ź)
+ ("z." ?ż)
+ ("z~" ?ž)
("!//" ["!/"])
("///" ["//"])
nil t t t nil nil nil nil nil nil t)
(quail-define-rules
- ("C<" ?\e,BH\e(B)
- ("C'" ?\e,BF\e(B)
- ("D;" ?\e,BP\e(B)
- ("S<" ?\e,B)\e(B)
- ("Z<" ?\e,B.\e(B)
- ("c<" ?\e,Bh\e(B)
- ("c'" ?\e,Bf\e(B)
- ("d;" ?\e,Bp\e(B)
- ("s<" ?\e,B9\e(B)
- ("z<" ?\e,B>\e(B))
+ ("C<" ?Č)
+ ("C'" ?Ć)
+ ("D;" ?Ä)
+ ("S<" ?Å )
+ ("Z<" ?Ž)
+ ("c<" ?Ä)
+ ("c'" ?ć)
+ ("d;" ?Ä‘)
+ ("s<" ?Å¡)
+ ("z<" ?ž))
;;; arch-tag: 170180fb-9617-4d58-9d51-65ca23c05d94
;;; latin-post.el ends here
-;;; latin-pre.el --- Quail packages for inputting various European characters -*-coding: iso-2022-7bit;-*-
+;;; latin-pre.el --- Quail packages for inputting various European characters -*-coding: utf-8;-*-
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
- ;; 2006, 2007
+ ;; 2006, 2007, 2008
;; Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
- ;; 2006, 2007
+ ;; 2006, 2007, 2008
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
;; by R.F. Smith <rsmith@xs4all.nl>
;;
;; polish-slash:
-;; Author: W\e,B3\e(Bodek Bzyl <matwb@univ.gda.pl>
-;; Maintainer: W\e,B3\e(Bodek Bzyl <matwb@univ.gda.pl>
+;; Author: WÅ‚odek Bzyl <matwb@univ.gda.pl>
+;; Maintainer: WÅ‚odek Bzyl <matwb@univ.gda.pl>
;;
;; latin-[89]-prefix: Dave Love <fx@gnu.org>
effect | prefix | examples
------------+--------+----------
- acute | ' | 'a -> \e,Aa\e(B, '' -> \e,A4\e(B
- grave | ` | `a -> \e,A`\e(B
- circumflex | ^ | ^a -> \e,Ab\e(B
- diaeresis | \" | \"a -> \e,Ad\e(B \"\" -> \e,A(\e(B
- tilde | ~ | ~a -> \e,Ac\e(B
- cedilla | ~ | ~c -> \e,Ag\e(B
- misc | \" ~ / | \"s -> \e,A_\e(B ~d -> \e,Ap\e(B ~t -> \e,A~\e(B /a -> \e,Ae\e(B /e -> \e,Af\e(B /o -> \e,Ax\e(B
- symbol | ~ | ~> -> \e,A;\e(B ~< -> \e,A+\e(B ~! -> \e,A!\e(B ~? -> \e,A?\e(B ~~ -> \e,A8\e(B
- | ~ | ~s -> \e,A'\e(B ~x -> \e,A$\e(B ~. -> \e,A7\e(B ~$ -> \e,A#\e(B ~u -> \e,A5\e(B
- | ~ | ~p -> \e,A6\e(B ~- -> \e,A-\e(B ~= -> \e,A/\e(B ~| -> \e,A&\e(B
- symbol | _ / | _o -> \e,A:\e(B _a -> \e,A*\e(B // -> \e,A0\e(B /\\ -> \e,AW\e(B _y -> \e,A%\e(B
- | _ / | _: -> \e,Aw\e(B /c -> \e,A"\e(B /2 -> \e,A=\e(B /4 -> \e,A<\e(B /3 -> \e,A>\e(B
- | _ / | /= -> \e,A,\e(B
- symbol | ^ | ^r -> \e,A.\e(B ^c -> \e,A)\e(B ^1 -> \e,A9\e(B ^2 -> \e,A2\e(B ^3 -> \e,A3\e(B
+ acute | ' | 'a -> á, '' -> ´
+ grave | ` | `a -> Ã
+ circumflex | ^ | ^a -> â
+ diaeresis | \" | \"a -> ä \"\" -> ¨
+ tilde | ~ | ~a -> ã
+ cedilla | ~ | ~c -> ç
+ misc | \" ~ / | \"s -> ß ~d -> ð ~t -> þ /a -> å /e -> æ /o -> ø
+ symbol | ~ | ~> -> » ~< -> « ~! -> ¡ ~? -> ¿ ~~ -> ¸
+ | ~ | ~s -> § ~x -> ¤ ~. -> · ~$ -> £ ~u -> µ
+ | ~ | ~p -> ¶ ~- ->  ~= -> ¯ ~| -> ¦
+ symbol | _ / | _o -> º _a -> ª // -> ° /\\ -> × _y -> ¥
+ | _ / | _: -> ÷ /c -> ¢ /2 -> ½ /4 -> ¼ /3 -> ¾
+ | _ / | /= -> ¬
+ symbol | ^ | ^r -> ® ^c -> © ^1 -> ¹ ^2 -> ² ^3 -> ³
" nil t nil nil nil nil nil nil nil nil t)
(quail-define-rules
- ("'A" ?\e,AA\e(B)
- ("'E" ?\e,AI\e(B)
- ("'I" ?\e,AM\e(B)
- ("'O" ?\e,AS\e(B)
- ("'U" ?\e,AZ\e(B)
- ("'Y" ?\e,A]\e(B)
- ("'a" ?\e,Aa\e(B)
- ("'e" ?\e,Ai\e(B)
- ("'i" ?\e,Am\e(B)
- ("'o" ?\e,As\e(B)
- ("'u" ?\e,Az\e(B)
- ("'y" ?\e,A}\e(B)
- ("''" ?\e,A4\e(B)
+ ("'A" ?Ã)
+ ("'E" ?É)
+ ("'I" ?Ã)
+ ("'O" ?Ó)
+ ("'U" ?Ú)
+ ("'Y" ?Ã)
+ ("'a" ?á)
+ ("'e" ?é)
+ ("'i" ?Ã)
+ ("'o" ?ó)
+ ("'u" ?ú)
+ ("'y" ?ý)
+ ("''" ?´)
("' " ?')
- ("`A" ?\e,A@\e(B)
- ("`E" ?\e,AH\e(B)
- ("`I" ?\e,AL\e(B)
- ("`O" ?\e,AR\e(B)
- ("`U" ?\e,AY\e(B)
- ("`a" ?\e,A`\e(B)
- ("`e" ?\e,Ah\e(B)
- ("`i" ?\e,Al\e(B)
- ("`o" ?\e,Ar\e(B)
- ("`u" ?\e,Ay\e(B)
+ ("`A" ?À)
+ ("`E" ?È)
+ ("`I" ?Ì)
+ ("`O" ?Ã’)
+ ("`U" ?Ù)
+ ("`a" ?Ã )
+ ("`e" ?è)
+ ("`i" ?ì)
+ ("`o" ?ò)
+ ("`u" ?ù)
("``" ?`)
("` " ?`)
- ("^A" ?\e,AB\e(B)
- ("^E" ?\e,AJ\e(B)
- ("^I" ?\e,AN\e(B)
- ("^O" ?\e,AT\e(B)
- ("^U" ?\e,A[\e(B)
- ("^a" ?\e,Ab\e(B)
- ("^e" ?\e,Aj\e(B)
- ("^i" ?\e,An\e(B)
- ("^o" ?\e,At\e(B)
- ("^u" ?\e,A{\e(B)
+ ("^A" ?Â)
+ ("^E" ?Ê)
+ ("^I" ?ÃŽ)
+ ("^O" ?Ô)
+ ("^U" ?Û)
+ ("^a" ?â)
+ ("^e" ?ê)
+ ("^i" ?î)
+ ("^o" ?ô)
+ ("^u" ?û)
("^^" ?^)
("^ " ?^)
- ("\"A" ?\e,AD\e(B)
- ("\"E" ?\e,AK\e(B)
- ("\"I" ?\e,AO\e(B)
- ("\"O" ?\e,AV\e(B)
- ("\"U" ?\e,A\\e(B)
- ("\"a" ?\e,Ad\e(B)
- ("\"e" ?\e,Ak\e(B)
- ("\"i" ?\e,Ao\e(B)
- ("\"o" ?\e,Av\e(B)
- ("\"s" ?\e,A_\e(B)
- ("\"u" ?\e,A|\e(B)
- ("\"y" ?\e,A\7f\e(B)
- ("\"\"" ?\e,A(\e(B)
+ ("\"A" ?Ä)
+ ("\"E" ?Ë)
+ ("\"I" ?Ã)
+ ("\"O" ?Ö)
+ ("\"U" ?Ü)
+ ("\"a" ?ä)
+ ("\"e" ?ë)
+ ("\"i" ?ï)
+ ("\"o" ?ö)
+ ("\"s" ?ß)
+ ("\"u" ?ü)
+ ("\"y" ?ÿ)
+ ("\"\"" ?¨)
("\" " ?\")
- ("~A" ?\e,AC\e(B)
- ("~C" ?\e,AG\e(B)
- ("~D" ?\e,AP\e(B)
- ("~N" ?\e,AQ\e(B)
- ("~O" ?\e,AU\e(B)
- ("~T" ?\e,A^\e(B)
- ("~a" ?\e,Ac\e(B)
- ("~c" ?\e,Ag\e(B)
- ("~d" ?\e,Ap\e(B)
- ("~n" ?\e,Aq\e(B)
- ("~o" ?\e,Au\e(B)
- ("~t" ?\e,A~\e(B)
- ("~>" ?\\e,A;\e(B)
- ("~<" ?\\e,A+\e(B)
- ("~!" ?\e,A!\e(B)
- ("~?" ?\e,A?\e(B)
- ("~~" ?\e,A8\e(B)
+ ("~A" ?Ã)
+ ("~C" ?Ç)
+ ("~D" ?Ã)
+ ("~N" ?Ñ)
+ ("~O" ?Õ)
+ ("~T" ?Þ)
+ ("~a" ?ã)
+ ("~c" ?ç)
+ ("~d" ?ð)
+ ("~n" ?ñ)
+ ("~o" ?õ)
+ ("~t" ?þ)
+ ("~>" ?\»)
+ ("~<" ?\«)
+ ("~!" ?¡)
+ ("~?" ?¿)
+ ("~~" ?¸)
("~ " ?~)
- ("/A" ?\e,AE\e(B)
- ("/E" ?\e,AF\e(B)
- ("/O" ?\e,AX\e(B)
- ("/a" ?\e,Ae\e(B)
- ("/e" ?\e,Af\e(B)
- ("/o" ?\e,Ax\e(B)
- ("//" ?\e,A0\e(B)
+ ("/A" ?Ã…)
+ ("/E" ?Æ)
+ ("/O" ?Ø)
+ ("/a" ?Ã¥)
+ ("/e" ?æ)
+ ("/o" ?ø)
+ ("//" ?°)
("/ " ?/)
- ("_o" ?\e,A:\e(B)
- ("_a" ?\e,A*\e(B)
- ("_ " ?\e,A \e(B)
+ ("_o" ?º)
+ ("_a" ?ª)
+ ("_ " ? )
;; Symbols added by Roland Smith <rsmith@xs4all.nl>
- ("_+" ?\e,A1\e(B)
- ("_y" ?\e,A%\e(B)
- ("_:" ?\e,Aw\e(B)
+ ("_+" ?±)
+ ("_y" ?Â¥)
+ ("_:" ?÷)
("__" ?_)
- ("/c" ?\e,A"\e(B)
- ("/\\" ?\e,AW\e(B)
- ("/2" ?\e,A=\e(B)
- ("/4" ?\e,A<\e(B)
- ("/3" ?\e,A>\e(B)
- ("~s" ?\e,A'\e(B)
- ("~p" ?\e,A6\e(B)
- ("~x" ?\e,A$\e(B)
- ("~." ?\e,A7\e(B)
- ("~$" ?\e,A#\e(B)
- ("~u" ?\e,A5\e(B)
- ("^r" ?\e,A.\e(B)
- ("^c" ?\e,A)\e(B)
- ("^1" ?\e,A9\e(B)
- ("^2" ?\e,A2\e(B)
- ("^3" ?\e,A3\e(B)
- ("~-" ?\e,A-\e(B)
- ("~|" ?\e,A&\e(B)
- ("/=" ?\e,A,\e(B)
- ("~=" ?\e,A/\e(B)
+ ("/c" ?¢)
+ ("/\\" ?×)
+ ("/2" ?½)
+ ("/4" ?¼)
+ ("/3" ?¾)
+ ("~s" ?§)
+ ("~p" ?¶)
+ ("~x" ?¤)
+ ("~." ?·)
+ ("~$" ?£)
+ ("~u" ?µ)
+ ("^r" ?®)
+ ("^c" ?©)
+ ("^1" ?¹)
+ ("^2" ?²)
+ ("^3" ?³)
+ ("~-" ?Â)
+ ("~|" ?¦)
+ ("/=" ?¬)
+ ("~=" ?¯)
)
(quail-define-package
effect | prefix | examples
------------+--------+----------
- acute | ' | 'a -> \e,Aa\e(B '' -> \e,A4\e(B
- grave | ` | `a -> \e,A`\e(B
- diaeresis | \" | \"i -> \e,Ao\e(B \"\" -> \e,A(\e(B
- tilde | ~ | ~n -> \e,Aq\e(B
- cedilla | ~ | ~c -> \e,Ag\e(B
- symbol | ~ | ~> -> \e,A;\e(B ~< -> \e,A+\e(B ~! -> \e,A!\e(B ~? -> \e,A?\e(B
+ acute | ' | 'a -> á '' -> ´
+ grave | ` | `a -> Ã
+ diaeresis | \" | \"i -> ï \"\" -> ¨
+ tilde | ~ | ~n -> ñ
+ cedilla | ~ | ~c -> ç
+ symbol | ~ | ~> -> » ~< -> « ~! -> ¡ ~? -> ¿
" nil t nil nil nil nil nil nil nil nil t)
(quail-define-rules
- ("'A" ?\e,AA\e(B)
- ("'E" ?\e,AI\e(B)
- ("'I" ?\e,AM\e(B)
- ("'O" ?\e,AS\e(B)
- ("'U" ?\e,AZ\e(B)
- ("'a" ?\e,Aa\e(B)
- ("'e" ?\e,Ai\e(B)
- ("'i" ?\e,Am\e(B)
- ("'o" ?\e,As\e(B)
- ("'u" ?\e,Az\e(B)
+ ("'A" ?Ã)
+ ("'E" ?É)
+ ("'I" ?Ã)
+ ("'O" ?Ó)
+ ("'U" ?Ú)
+ ("'a" ?á)
+ ("'e" ?é)
+ ("'i" ?Ã)
+ ("'o" ?ó)
+ ("'u" ?ú)
("' " ?')
- ("`A" ?\e,A@\e(B)
- ("`E" ?\e,AH\e(B)
- ("`O" ?\e,AR\e(B)
- ("`a" ?\e,A`\e(B)
- ("`e" ?\e,Ah\e(B)
- ("`o" ?\e,Ar\e(B)
+ ("`A" ?À)
+ ("`E" ?È)
+ ("`O" ?Ã’)
+ ("`a" ?Ã )
+ ("`e" ?è)
+ ("`o" ?ò)
("` " ?`)
- ("\"I" ?\e,AO\e(B)
- ("\"U" ?\e,A\\e(B)
- ("\"i" ?\e,Ao\e(B)
- ("\"u" ?\e,A|\e(B)
+ ("\"I" ?Ã)
+ ("\"U" ?Ü)
+ ("\"i" ?ï)
+ ("\"u" ?ü)
("\" " ?\")
- ("~C" ?\e,AG\e(B)
- ("~N" ?\e,AQ\e(B)
- ("~c" ?\e,Ag\e(B)
- ("~n" ?\e,Aq\e(B)
- ("~>" ?\\e,A;\e(B)
- ("~<" ?\\e,A+\e(B)
- ("~!" ?\e,A!\e(B)
- ("~?" ?\e,A?\e(B)
+ ("~C" ?Ç)
+ ("~N" ?Ñ)
+ ("~c" ?ç)
+ ("~n" ?ñ)
+ ("~>" ?\»)
+ ("~<" ?\«)
+ ("~!" ?¡)
+ ("~?" ?¿)
("~ " ?~)
)
"esperanto-prefix" "Latin-3" "EO>" t
"Esperanto input method with prefix modifiers
Key translation rules are:
- ^H -> ?\e,C&\e(B ^J -> ?\e,C,\e(B ^h -> ?\e,C6\e(B ^j -> ?\e,C<\e(B ^C -> ?\e,CF\e(B ^G -> ?\e,CX\e(B,
- ^S -> ?\e,C^\e(B ^c -> ?\e,Cf\e(B ^g -> ?\e,Cx\e(B ^s -> ?\e,C~\e(B ~U -> ?\e,C]\e(B ~u -> ?\e,C}\e(B
+ ^H -> ?Ĥ ^J -> ?Ĵ ^h -> ?ĥ ^j -> ?ĵ ^C -> ?Ĉ ^G -> ?Ĝ,
+ ^S -> ?Åœ ^c -> ?ĉ ^g -> ?Ä ^s -> ?Å ~U -> ?Ŭ ~u -> ?Å
" nil t nil nil nil nil nil nil nil nil t)
(quail-define-rules
- ("^H" ?\e,C&\e(B)
- ("^J" ?\e,C,\e(B)
- ("^h" ?\e,C6\e(B)
- ("^j" ?\e,C<\e(B)
- ("^C" ?\e,CF\e(B)
- ("^G" ?\e,CX\e(B)
- ("^S" ?\e,C^\e(B)
- ("^c" ?\e,Cf\e(B)
- ("^g" ?\e,Cx\e(B)
- ("^s" ?\e,C~\e(B)
+ ("^H" ?Ĥ)
+ ("^J" ?Ä´)
+ ("^h" ?Ä¥)
+ ("^j" ?ĵ)
+ ("^C" ?Ĉ)
+ ("^G" ?Ĝ)
+ ("^S" ?Ŝ)
+ ("^c" ?ĉ)
+ ("^g" ?Ä)
+ ("^s" ?Å)
("^^" ?^)
("^ " ?^)
- ("~U" ?\e,C]\e(B)
- ("~u" ?\e,C}\e(B)
+ ("~U" ?Ŭ)
+ ("~u" ?Å)
("~ " ?~)
)
(quail-define-package
"french-prefix" "French" "FR>" t
- "French (Fran\e,Ag\e(Bais) input method with prefix modifiers
+ "French (Français) input method with prefix modifiers
effect | prefix | examples
------------+--------+----------
- acute | ' | 'e -> \e,Ai\e(B
- grave | ` | `a -> \e,A`\e(B
- circumflex | ^ | ^a -> \e,Ab\e(B
- diaeresis | \" | \"i -> \e,Ao\e(B
- cedilla | ~ or , | ~c -> \e,Ag\e(B ,c -> \e,Ag\e(B
- symbol | ~ | ~> -> \e,A;\e(B ~< -> \e,A+\e(B
+ acute | ' | 'e -> é
+ grave | ` | `a -> Ã
+ circumflex | ^ | ^a -> â
+ diaeresis | \" | \"i -> ï
+ cedilla | ~ or , | ~c -> ç ,c -> ç
+ symbol | ~ | ~> -> » ~< -> «
" nil t nil nil nil nil nil nil nil nil t)
(quail-define-rules
- ("'E" ?\e,AI\e(B)
- ("'C" ?\e,AG\e(B)
- ("'e" ?\e,Ai\e(B)
- ("'c" ?\e,Ag\e(B)
+ ("'E" ?É)
+ ("'C" ?Ç)
+ ("'e" ?é)
+ ("'c" ?ç)
("' " ?')
- ("`A" ?\e,A@\e(B)
- ("`E" ?\e,AH\e(B)
- ("`U" ?\e,AY\e(B)
- ("`a" ?\e,A`\e(B)
- ("`e" ?\e,Ah\e(B)
- ("`u" ?\e,Ay\e(B)
+ ("`A" ?À)
+ ("`E" ?È)
+ ("`U" ?Ù)
+ ("`a" ?Ã )
+ ("`e" ?è)
+ ("`u" ?ù)
("` " ?`)
- ("^A" ?\e,AB\e(B)
- ("^E" ?\e,AJ\e(B)
- ("^I" ?\e,AN\e(B)
- ("^O" ?\e,AT\e(B)
- ("^U" ?\e,A[\e(B)
- ("^a" ?\e,Ab\e(B)
- ("^e" ?\e,Aj\e(B)
- ("^i" ?\e,An\e(B)
- ("^o" ?\e,At\e(B)
- ("^u" ?\e,A{\e(B)
+ ("^A" ?Â)
+ ("^E" ?Ê)
+ ("^I" ?ÃŽ)
+ ("^O" ?Ô)
+ ("^U" ?Û)
+ ("^a" ?â)
+ ("^e" ?ê)
+ ("^i" ?î)
+ ("^o" ?ô)
+ ("^u" ?û)
("^ " ?^)
- ("\"E" ?\e,AK\e(B)
- ("\"I" ?\e,AO\e(B)
- ("\"e" ?\e,Ak\e(B)
- ("\"i" ?\e,Ao\e(B)
+ ("\"E" ?Ë)
+ ("\"I" ?Ã)
+ ("\"e" ?ë)
+ ("\"i" ?ï)
("\" " ?\")
- ("~<" ?\\e,A+\e(B)
- ("~>" ?\\e,A;\e(B)
- ("~C" ?\e,AG\e(B)
- ("~c" ?\e,Ag\e(B)
+ ("~<" ?\«)
+ ("~>" ?\»)
+ ("~C" ?Ç)
+ ("~c" ?ç)
("~ " ?~)
- (",C" ?\e,AG\e(B)
- (",c" ?\e,Ag\e(B)
+ (",C" ?Ç)
+ (",c" ?ç)
(", " ?,)
)
(quail-define-package
"romanian-prefix" "Romanian" "RO>" t
- "Romanian (rom\e,Bb\e(Bne\e,B:\e(Bte) input method with prefix modifiers
+ "Romanian (româneşte) input method with prefix modifiers
effect | prefix | examples
------------+--------+------------------
- tilde | ~ | ~a -> \e,Bc\e(B
- circumflex | ^ | ^a -> \e,Bb\e(B, ^i -> \e,Bn\e(B
- cedilla | , | ,s -> \e,B:\e(B, ,t -> \e,B~\e(B
+ tilde | ~ | ~a -> ă
+ circumflex | ^ | ^a -> â, ^i -> î
+ cedilla | , | ,s -> ş, ,t -> ţ
~ | ~ | ~~ -> ~
^ | ^ | ^^ -> ^
, | , | ,, -> ,
" nil t nil nil nil nil nil nil nil nil t)
(quail-define-rules
- ("~A" ?\e,BC\e(B) ("~a" ?\e,Bc\e(B)
- ("^A" ?\e,BB\e(B) ("^a" ?\e,Bb\e(B)
- ("^I" ?\e,BN\e(B) ("^i" ?\e,Bn\e(B)
- (",S" ?\e,B*\e(B) (",s" ?\e,B:\e(B)
- (",T" ?\e,B^\e(B) (",t" ?\e,B~\e(B)
+ ("~A" ?Ă) ("~a" ?ă)
+ ("^A" ?Â) ("^a" ?â)
+ ("^I" ?Î) ("^i" ?î)
+ (",S" ?Åž) (",s" ?ÅŸ)
+ (",T" ?Å¢) (",t" ?Å£)
("^^" ?^) ("~~" ?~) (",," ?,))
(quail-define-package
"romanian-alt-prefix" "Romanian" "RO>" t
- "Alternative Romanian (rom\e,Bb\e(Bne\e,B:\e(Bte) input method with prefix modifiers
+ "Alternative Romanian (româneşte) input method with prefix modifiers
effect | prefix | examples
------------+--------+------------------
- tilde | \" | \"a -> \e,Bb\e(B
- circumflex | ' | 'a -> \e,Bb\e(B, 'i -> \e,Bn\e(B
- cedilla | ' | 's -> \e,B:\e(B, 't -> \e,B~\e(B
+ tilde | \" | \"a -> â
+ circumflex | ' | 'a -> â, 'i -> î
+ cedilla | ' | 's -> ş, 't -> ţ
' | ' | '' -> '
\" | \" | \"\" -> \"
" nil t nil nil nil nil nil nil nil nil t)
(quail-define-rules
- ("'A" ?\e,BC\e(B) ("'a" ?\e,Bc\e(B)
- ("\"A" ?\e,BB\e(B) ("\"a" ?\e,Bb\e(B)
- ("'I" ?\e,BN\e(B) ("'i" ?\e,Bn\e(B)
- ("'S" ?\e,B*\e(B) ("'s" ?\e,B:\e(B)
- ("'T" ?\e,B^\e(B) ("'t" ?\e,B~\e(B)
+ ("'A" ?Ă) ("'a" ?ă)
+ ("\"A" ?Â) ("\"a" ?â)
+ ("'I" ?Î) ("'i" ?î)
+ ("'S" ?Åž) ("'s" ?ÅŸ)
+ ("'T" ?Å¢) ("'t" ?Å£)
("''" ?') ("\"\"" ?\"))
(quail-define-package
"german-prefix" "German" "DE>" t
"German (Deutsch) input method with prefix modifiers
Key translation rules are:
- \"A -> \e,AD\e(B -> \"O -> \e,AV\e(B \"U -> \e,A\\e(B \"s -> \e,A_\e(B
+ \"A -> Ä -> \"O -> Ö \"U -> Ü \"s -> ß
" nil t nil nil nil nil nil nil nil nil t)
(quail-define-rules
- ("\"A" ?\e,AD\e(B)
- ("\"O" ?\e,AV\e(B)
- ("\"U" ?\e,A\\e(B)
- ("\"a" ?\e,Ad\e(B)
- ("\"o" ?\e,Av\e(B)
- ("\"u" ?\e,A|\e(B)
- ("\"s" ?\e,A_\e(B)
+ ("\"A" ?Ä)
+ ("\"O" ?Ö)
+ ("\"U" ?Ü)
+ ("\"a" ?ä)
+ ("\"o" ?ö)
+ ("\"u" ?ü)
+ ("\"s" ?ß)
("\" " ?\")
)
"irish-prefix" "Latin-1" "GA>" t
"Irish input method with prefix modifiers
Key translation rules are:
- 'A -> \e,AA\e(B 'E -> \e,AI\e(B 'I -> \e,AM\e(B 'O -> \e,AS\e(B 'U -> \e,AZ\e(B
+ 'A -> à 'E -> É 'I -> à 'O -> Ó 'U -> Ú
" nil t nil nil nil nil nil nil nil nil t)
(quail-define-rules
- ("'A" ?\e,AA\e(B)
- ("'E" ?\e,AI\e(B)
- ("'I" ?\e,AM\e(B)
- ("'O" ?\e,AS\e(B)
- ("'U" ?\e,AZ\e(B)
- ("'a" ?\e,Aa\e(B)
- ("'e" ?\e,Ai\e(B)
- ("'i" ?\e,Am\e(B)
- ("'o" ?\e,As\e(B)
- ("'u" ?\e,Az\e(B)
+ ("'A" ?Ã)
+ ("'E" ?É)
+ ("'I" ?Ã)
+ ("'O" ?Ó)
+ ("'U" ?Ú)
+ ("'a" ?á)
+ ("'e" ?é)
+ ("'i" ?Ã)
+ ("'o" ?ó)
+ ("'u" ?ú)
("' " ?')
)
effect | prefix | examples
------------+--------+----------
- acute | ' | 'a -> \e,Aa\e(B '' -> \e,A4\e(B
- grave | ` | `a -> \e,A`\e(B
- circumflex | ^ | ^a -> \e,Ab\e(B
- diaeresis | \" | \"u -> \e,A|\e(B
- tilde | ~ | ~a -> \e,Ac\e(B
- cedilla | ' or , | 'c -> \e,Ag\e(B ,c -> \e,Ag\e(B
+ acute | ' | 'a -> á '' -> ´
+ grave | ` | `a -> Ã
+ circumflex | ^ | ^a -> â
+ diaeresis | \" | \"u -> ü
+ tilde | ~ | ~a -> ã
+ cedilla | ' or , | 'c -> ç ,c -> ç
" nil t nil nil nil nil nil nil nil nil t)
(quail-define-rules
- ("'A" ?\e,AA\e(B)
- ("'E" ?\e,AI\e(B)
- ("'I" ?\e,AM\e(B)
- ("'O" ?\e,AS\e(B)
- ("'U" ?\e,AZ\e(B)
- ("'C" ?\e,AG\e(B)
- ("'a" ?\e,Aa\e(B)
- ("'e" ?\e,Ai\e(B)
- ("'i" ?\e,Am\e(B)
- ("'o" ?\e,As\e(B)
- ("'u" ?\e,Az\e(B)
- ("'c" ?\e,Ag\e(B)
+ ("'A" ?Ã)
+ ("'E" ?É)
+ ("'I" ?Ã)
+ ("'O" ?Ó)
+ ("'U" ?Ú)
+ ("'C" ?Ç)
+ ("'a" ?á)
+ ("'e" ?é)
+ ("'i" ?Ã)
+ ("'o" ?ó)
+ ("'u" ?ú)
+ ("'c" ?ç)
("' " ?')
- ("`A" ?\e,A@\e(B)
- ("`a" ?\e,A`\e(B)
+ ("`A" ?À)
+ ("`a" ?Ã )
("` " ?`)
- ("^A" ?\e,AB\e(B)
- ("^E" ?\e,AJ\e(B)
- ("^O" ?\e,AT\e(B)
- ("^a" ?\e,Ab\e(B)
- ("^e" ?\e,Aj\e(B)
- ("^o" ?\e,At\e(B)
+ ("^A" ?Â)
+ ("^E" ?Ê)
+ ("^O" ?Ô)
+ ("^a" ?â)
+ ("^e" ?ê)
+ ("^o" ?ô)
("^ " ?^)
- ("\"U" ?\e,A\\e(B)
- ("\"u" ?\e,A|\e(B)
+ ("\"U" ?Ü)
+ ("\"u" ?ü)
("\" " ?\")
- ("~A" ?\e,AC\e(B)
- ("~O" ?\e,AU\e(B)
- ("~a" ?\e,Ac\e(B)
- ("~o" ?\e,Au\e(B)
+ ("~A" ?Ã)
+ ("~O" ?Õ)
+ ("~a" ?ã)
+ ("~o" ?õ)
("~ " ?~)
- (",c" ?\e,Ag\e(B)
- (",C" ?\e,AG\e(B)
+ (",c" ?ç)
+ (",C" ?Ç)
(",," ?,)
)
(quail-define-package
"spanish-prefix" "Spanish" "ES>" t
- "Spanish (Espa\e,Aq\e(Bol) input method with prefix modifiers
+ "Spanish (Español) input method with prefix modifiers
effect | prefix | examples
------------+--------+----------
- acute | ' | 'a -> \e,Aa\e(B
- diaeresis | \" | \"u -> \e,A|\e(B
- tilde | ~ | ~n -> \e,Aq\e(B
- symbol | ~ | ~> -> \e,A;\e(B ~< -> \e,A+\e(B ~! -> \e,A!\e(B ~? -> \e,A?\e(B
+ acute | ' | 'a -> á
+ diaeresis | \" | \"u -> ü
+ tilde | ~ | ~n -> ñ
+ symbol | ~ | ~> -> » ~< -> « ~! -> ¡ ~? -> ¿
" nil t nil nil nil nil nil nil nil nil t)
(quail-define-rules
- ("'A" ?\e,AA\e(B)
- ("'E" ?\e,AI\e(B)
- ("'I" ?\e,AM\e(B)
- ("'O" ?\e,AS\e(B)
- ("'U" ?\e,AZ\e(B)
- ("'a" ?\e,Aa\e(B)
- ("'e" ?\e,Ai\e(B)
- ("'i" ?\e,Am\e(B)
- ("'o" ?\e,As\e(B)
- ("'u" ?\e,Az\e(B)
+ ("'A" ?Ã)
+ ("'E" ?É)
+ ("'I" ?Ã)
+ ("'O" ?Ó)
+ ("'U" ?Ú)
+ ("'a" ?á)
+ ("'e" ?é)
+ ("'i" ?Ã)
+ ("'o" ?ó)
+ ("'u" ?ú)
("' " ?')
- ("\"U" ?\e,A\\e(B)
- ("\"u" ?\e,A|\e(B)
+ ("\"U" ?Ü)
+ ("\"u" ?ü)
("\" " ?\")
- ("~N" ?\e,AQ\e(B)
- ("~n" ?\e,Aq\e(B)
- ("~>" ?\\e,A;\e(B)
- ("~<" ?\\e,A+\e(B)
- ("~!" ?\e,A!\e(B)
- ("~?" ?\e,A?\e(B)
+ ("~N" ?Ñ)
+ ("~n" ?ñ)
+ ("~>" ?\»)
+ ("~<" ?\«)
+ ("~!" ?¡)
+ ("~?" ?¿)
("~ " ?~)
)
effect | prefix | examples
------------+--------+----------
- acute | ' | 'a -> \e,Ba\e(B '' -> ?\e,B4\e(B
- circumflex | ^ | ^a -> \e,Bb\e(B
- diaeresis | \" | \"a -> \e,Bd\e(B \"\" -> \e,B(\e(B
- breve | ~ | ~a -> \e,Bc\e(B
- caron | ~ | ~c -> \e,Bh\e(B
- cedilla | ` | `c -> \e,Bg\e(B `e -> ?\e,Bj\e(B
- misc | ' ` ~ | 'd -> \e,Bp\e(B `l -> \e,B3\e(B `z -> \e,B?\e(B ~o -> \e,Bu\e(B ~u -> \e,B{\e(B
- symbol | ~ | `. -> \e,B\7f\e(B ~~ -> \e,B"\e(B ~. -> ?\e,B8\e(B
+ acute | ' | 'a -> á '' -> ?´
+ circumflex | ^ | ^a -> â
+ diaeresis | \" | \"a -> ä \"\" -> ¨
+ breve | ~ | ~a -> ă
+ caron | ~ | ~c -> Ä
+ cedilla | ` | `c -> ç `e -> ?ę
+ misc | ' ` ~ | 'd -> đ `l -> ł `z -> ż ~o -> ő ~u -> ű
+ symbol | ~ | `. -> ˙ ~~ -> ˘ ~. -> ?¸
" nil t nil nil nil nil nil nil nil nil t)
(quail-define-rules
- ("'A" ?\e,BA\e(B)
- ("'C" ?\e,BF\e(B)
- ("'D" ?\e,BP\e(B)
- ("'E" ?\e,BI\e(B)
- ("'I" ?\e,BM\e(B)
- ("'L" ?\e,BE\e(B)
- ("'N" ?\e,BQ\e(B)
- ("'O" ?\e,BS\e(B)
- ("'R" ?\e,B@\e(B)
- ("'S" ?\e,B&\e(B)
- ("'U" ?\e,BZ\e(B)
- ("'Y" ?\e,B]\e(B)
- ("'Z" ?\e,B,\e(B)
- ("'a" ?\e,Ba\e(B)
- ("'c" ?\e,Bf\e(B)
- ("'d" ?\e,Bp\e(B)
- ("'e" ?\e,Bi\e(B)
- ("'i" ?\e,Bm\e(B)
- ("'l" ?\e,Be\e(B)
- ("'n" ?\e,Bq\e(B)
- ("'o" ?\e,Bs\e(B)
- ("'r" ?\e,B`\e(B)
- ("'s" ?\e,B6\e(B)
- ("'u" ?\e,Bz\e(B)
- ("'y" ?\e,B}\e(B)
- ("'z" ?\e,B<\e(B)
- ("''" ?\e,B4\e(B)
+ ("'A" ?Ã)
+ ("'C" ?Ć)
+ ("'D" ?Ä)
+ ("'E" ?É)
+ ("'I" ?Ã)
+ ("'L" ?Ĺ)
+ ("'N" ?Ń)
+ ("'O" ?Ó)
+ ("'R" ?Å”)
+ ("'S" ?Åš)
+ ("'U" ?Ú)
+ ("'Y" ?Ã)
+ ("'Z" ?Ź)
+ ("'a" ?á)
+ ("'c" ?ć)
+ ("'d" ?Ä‘)
+ ("'e" ?é)
+ ("'i" ?Ã)
+ ("'l" ?ĺ)
+ ("'n" ?Å„)
+ ("'o" ?ó)
+ ("'r" ?Å•)
+ ("'s" ?Å›)
+ ("'u" ?ú)
+ ("'y" ?ý)
+ ("'z" ?ź)
+ ("''" ?´)
("' " ?')
- ("`A" ?\e,B!\e(B)
- ("`C" ?\e,BG\e(B)
- ("`E" ?\e,BJ\e(B)
- ("`L" ?\e,B#\e(B)
- ("`S" ?\e,B*\e(B)
- ("`T" ?\e,B^\e(B)
- ("`Z" ?\e,B/\e(B)
- ("`a" ?\e,B1\e(B)
- ("`l" ?\e,B3\e(B)
- ("`c" ?\e,Bg\e(B)
- ("`e" ?\e,Bj\e(B)
- ("`s" ?\e,B:\e(B)
- ("`t" ?\e,B~\e(B)
- ("`z" ?\e,B?\e(B)
- ("``" ?\e,B*\e(B)
- ("`." ?\e,B\7f\e(B)
+ ("`A" ?Ä„)
+ ("`C" ?Ç)
+ ("`E" ?Ę)
+ ("`L" ?Å)
+ ("`S" ?Åž)
+ ("`T" ?Å¢)
+ ("`Z" ?Å»)
+ ("`a" ?Ä…)
+ ("`l" ?Å‚)
+ ("`c" ?ç)
+ ("`e" ?Ä™)
+ ("`s" ?ÅŸ)
+ ("`t" ?Å£)
+ ("`z" ?ż)
+ ("``" ?Åž)
+ ("`." ?Ë™)
("` " ?`)
- ("^A" ?\e,BB\e(B)
- ("^I" ?\e,BN\e(B)
- ("^O" ?\e,BT\e(B)
- ("^a" ?\e,Bb\e(B)
- ("^i" ?\e,Bn\e(B)
- ("^o" ?\e,Bt\e(B)
+ ("^A" ?Â)
+ ("^I" ?ÃŽ)
+ ("^O" ?Ô)
+ ("^a" ?â)
+ ("^i" ?î)
+ ("^o" ?ô)
("^^" ?^)
("^ " ?^)
- ("\"A" ?\e,BD\e(B)
- ("\"E" ?\e,BK\e(B)
- ("\"O" ?\e,BV\e(B)
- ("\"U" ?\e,B\\e(B)
- ("\"a" ?\e,Bd\e(B)
- ("\"e" ?\e,Bk\e(B)
- ("\"o" ?\e,Bv\e(B)
- ("\"s" ?\e,B_\e(B)
- ("\"u" ?\e,B|\e(B)
- ("\"\"" ?\e,B(\e(B)
+ ("\"A" ?Ä)
+ ("\"E" ?Ë)
+ ("\"O" ?Ö)
+ ("\"U" ?Ü)
+ ("\"a" ?ä)
+ ("\"e" ?ë)
+ ("\"o" ?ö)
+ ("\"s" ?ß)
+ ("\"u" ?ü)
+ ("\"\"" ?¨)
("\" " ?\")
- ("~A" ?\e,BC\e(B)
- ("~C" ?\e,BH\e(B)
- ("~D" ?\e,BO\e(B)
- ("~E" ?\e,BL\e(B)
- ("~L" ?\e,B%\e(B)
- ("~N" ?\e,BR\e(B)
- ("~O" ?\e,BU\e(B)
- ("~R" ?\e,BX\e(B)
- ("~S" ?\e,B)\e(B)
- ("~T" ?\e,B+\e(B)
- ("~U" ?\e,B[\e(B)
- ("~Z" ?\e,B.\e(B)
- ("~a" ?\e,Bc\e(B)
- ("~c" ?\e,Bh\e(B)
- ("~d" ?\e,Bo\e(B)
- ("~e" ?\e,Bl\e(B)
- ("~l" ?\e,B5\e(B)
- ("~n" ?\e,Br\e(B)
- ("~o" ?\e,Bu\e(B)
- ("~r" ?\e,Bx\e(B)
- ("~s" ?\e,B9\e(B)
- ("~t" ?\e,B;\e(B)
- ("~u" ?\e,B{\e(B)
- ("~z" ?\e,B>\e(B)
- ("~v" ?\e,B"\e(B)
- ("~~" ?\e,B"\e(B)
- ("~." ?\e,B8\e(B)
+ ("~A" ?Ä‚)
+ ("~C" ?Č)
+ ("~D" ?ÄŽ)
+ ("~E" ?Äš)
+ ("~L" ?Ľ)
+ ("~N" ?Ň)
+ ("~O" ?Å)
+ ("~R" ?Ř)
+ ("~S" ?Å )
+ ("~T" ?Ť)
+ ("~U" ?Å°)
+ ("~Z" ?Ž)
+ ("~a" ?ă)
+ ("~c" ?Ä)
+ ("~d" ?Ä)
+ ("~e" ?Ä›)
+ ("~l" ?ľ)
+ ("~n" ?ň)
+ ("~o" ?Å‘)
+ ("~r" ?Å™)
+ ("~s" ?Å¡)
+ ("~t" ?Å¥)
+ ("~u" ?ű)
+ ("~z" ?ž)
+ ("~v" ?˘)
+ ("~~" ?˘)
+ ("~." ?¸)
("~ " ?~)
)
effect | prefix | examples
------------+--------+----------
- acute | ' | 'a -> \e,Ca\e(B '' -> ?\e,C4\e(B
- grave | ` | `a -> \e,C`\e(B
- circumflex | ^ | ^a -> \e,Cb\e(B
- diaeresis | \" | \"a -> \e,Cd\e(B \"\" -> \e,C(\e(B
- cedilla | ~ | ~c -> \e,Cg\e(B ~s -> \e,C:\e(B ~~ -> \e,C8\e(B
- dot above | / . | /g -> \e,Cu\e(B .o -> \e,Cu\e(B
- misc | \" ~ / | \"s -> \e,C_\e(B ~g -> \e,C;\e(B ~u -> \e,C}\e(B /h -> \e,C1\e(B /i -> \e,C9\e(B
- symbol | ~ | ~` -> \e,C"\e(B /# -> \e,C#\e(B /$ -> \e,C$\e(B // -> \e,C0\e(B
+ acute | ' | 'a -> á '' -> ?´
+ grave | ` | `a -> Ã
+ circumflex | ^ | ^a -> â
+ diaeresis | \" | \"a -> ä \"\" -> ¨
+ cedilla | ~ | ~c -> ç ~s -> ş ~~ -> ¸
+ dot above | / . | /g -> Ä¡ .o -> Ä¡
+ misc | \" ~ / | \"s -> ß ~g -> ğ ~u -> Š/h -> ħ /i -> ı
+ symbol | ~ | ~` -> ˘ /# -> £ /$ -> ¤ // -> °
" nil t nil nil nil nil nil nil nil nil t)
(quail-define-rules
- ("'A" ?\e,CA\e(B)
- ("'E" ?\e,CI\e(B)
- ("'I" ?\e,CM\e(B)
- ("'O" ?\e,CS\e(B)
- ("'U" ?\e,CZ\e(B)
- ("'a" ?\e,Ca\e(B)
- ("'e" ?\e,Ci\e(B)
- ("'i" ?\e,Cm\e(B)
- ("'o" ?\e,Cs\e(B)
- ("'u" ?\e,Cz\e(B)
- ("''" ?\e,C4\e(B)
+ ("'A" ?Ã)
+ ("'E" ?É)
+ ("'I" ?Ã)
+ ("'O" ?Ó)
+ ("'U" ?Ú)
+ ("'a" ?á)
+ ("'e" ?é)
+ ("'i" ?Ã)
+ ("'o" ?ó)
+ ("'u" ?ú)
+ ("''" ?´)
("' " ?')
- ("`A" ?\e,C@\e(B)
- ("`E" ?\e,CH\e(B)
- ("`I" ?\e,CL\e(B)
- ("`O" ?\e,CR\e(B)
- ("`U" ?\e,CY\e(B)
- ("`a" ?\e,C`\e(B)
- ("`e" ?\e,Ch\e(B)
- ("`i" ?\e,Cl\e(B)
- ("`o" ?\e,Cr\e(B)
- ("`u" ?\e,Cy\e(B)
+ ("`A" ?À)
+ ("`E" ?È)
+ ("`I" ?Ì)
+ ("`O" ?Ã’)
+ ("`U" ?Ù)
+ ("`a" ?Ã )
+ ("`e" ?è)
+ ("`i" ?ì)
+ ("`o" ?ò)
+ ("`u" ?ù)
("``" ?`)
("` " ?`)
- ("^A" ?\e,CB\e(B)
- ("^C" ?\e,CF\e(B)
- ("^E" ?\e,CJ\e(B)
- ("^G" ?\e,CX\e(B)
- ("^H" ?\e,C&\e(B)
- ("^I" ?\e,CN\e(B)
- ("^J" ?\e,C,\e(B)
- ("^O" ?\e,CT\e(B)
- ("^S" ?\e,C^\e(B)
- ("^U" ?\e,C[\e(B)
- ("^a" ?\e,Cb\e(B)
- ("^c" ?\e,Cf\e(B)
- ("^e" ?\e,Cj\e(B)
- ("^g" ?\e,Cx\e(B)
- ("^h" ?\e,C6\e(B)
- ("^i" ?\e,Cn\e(B)
- ("^j" ?\e,C<\e(B)
- ("^o" ?\e,Ct\e(B)
- ("^s" ?\e,C~\e(B)
- ("^u" ?\e,C{\e(B)
+ ("^A" ?Â)
+ ("^C" ?Ĉ)
+ ("^E" ?Ê)
+ ("^G" ?Ĝ)
+ ("^H" ?Ĥ)
+ ("^I" ?ÃŽ)
+ ("^J" ?Ä´)
+ ("^O" ?Ô)
+ ("^S" ?Ŝ)
+ ("^U" ?Û)
+ ("^a" ?â)
+ ("^c" ?ĉ)
+ ("^e" ?ê)
+ ("^g" ?Ä)
+ ("^h" ?Ä¥)
+ ("^i" ?î)
+ ("^j" ?ĵ)
+ ("^o" ?ô)
+ ("^s" ?Å)
+ ("^u" ?û)
("^^" ?^)
("^ " ?^)
- ("\"A" ?\e,CD\e(B)
- ("\"E" ?\e,CK\e(B)
- ("\"I" ?\e,CO\e(B)
- ("\"O" ?\e,CV\e(B)
- ("\"U" ?\e,C\\e(B)
- ("\"a" ?\e,Cd\e(B)
- ("\"e" ?\e,Ck\e(B)
- ("\"i" ?\e,Co\e(B)
- ("\"o" ?\e,Cv\e(B)
- ("\"u" ?\e,C|\e(B)
- ("\"s" ?\e,C_\e(B)
- ("\"\"" ?\e,C(\e(B)
+ ("\"A" ?Ä)
+ ("\"E" ?Ë)
+ ("\"I" ?Ã)
+ ("\"O" ?Ö)
+ ("\"U" ?Ü)
+ ("\"a" ?ä)
+ ("\"e" ?ë)
+ ("\"i" ?ï)
+ ("\"o" ?ö)
+ ("\"u" ?ü)
+ ("\"s" ?ß)
+ ("\"\"" ?¨)
("\" " ?\")
- ("~C" ?\e,CG\e(B)
- ("~N" ?\e,CQ\e(B)
- ("~c" ?\e,Cg\e(B)
- ("~n" ?\e,Cq\e(B)
- ("~S" ?\e,C*\e(B)
- ("~s" ?\e,C:\e(B)
- ("~G" ?\e,C+\e(B)
- ("~g" ?\e,C;\e(B)
- ("~U" ?\e,C]\e(B)
- ("~u" ?\e,C}\e(B)
- ("~`" ?\e,C"\e(B)
- ("~~" ?\e,C8\e(B)
+ ("~C" ?Ç)
+ ("~N" ?Ñ)
+ ("~c" ?ç)
+ ("~n" ?ñ)
+ ("~S" ?Åž)
+ ("~s" ?ÅŸ)
+ ("~G" ?Äž)
+ ("~g" ?ÄŸ)
+ ("~U" ?Ŭ)
+ ("~u" ?Å)
+ ("~`" ?˘)
+ ("~~" ?¸)
("~ " ?~)
- ("/C" ?\e,CE\e(B)
- ("/G" ?\e,CU\e(B)
- ("/H" ?\e,C!\e(B)
- ("/I" ?\e,C)\e(B)
- ("/Z" ?\e,C/\e(B)
- ("/c" ?\e,Ce\e(B)
- ("/g" ?\e,Cu\e(B)
- ("/h" ?\e,C1\e(B)
- ("/i" ?\e,C9\e(B)
- ("/z" ?\e,C?\e(B)
- ("/." ?\e,C\7f\e(B)
- ("/#" ?\e,C#\e(B)
- ("/$" ?\e,C$\e(B)
- ("//" ?\e,C0\e(B)
+ ("/C" ?ÄŠ)
+ ("/G" ?Ä )
+ ("/H" ?Ħ)
+ ("/I" ?Ä°)
+ ("/Z" ?Å»)
+ ("/c" ?Ä‹)
+ ("/g" ?Ä¡)
+ ("/h" ?ħ)
+ ("/i" ?ı)
+ ("/z" ?ż)
+ ("/." ?Ë™)
+ ("/#" ?£)
+ ("/$" ?¤)
+ ("//" ?°)
("/ " ?/)
- (".C" ?\e,CE\e(B)
- (".G" ?\e,CU\e(B)
- (".I" ?\e,C)\e(B)
- (".Z" ?\e,C/\e(B)
- (".c" ?\e,Ce\e(B)
- (".g" ?\e,Cu\e(B)
- (".z" ?\e,C?\e(B)
+ (".C" ?ÄŠ)
+ (".G" ?Ä )
+ (".I" ?Ä°)
+ (".Z" ?Å»)
+ (".c" ?Ä‹)
+ (".g" ?Ä¡)
+ (".z" ?ż)
)
(quail-define-rules
("//" ?/)
- ("/a" ?\e,B1\e(B)
- ("/c" ?\e,Bf\e(B)
- ("/e" ?\e,Bj\e(B)
- ("/l" ?\e,B3\e(B)
- ("/n" ?\e,Bq\e(B)
- ("/o" ?\e,Bs\e(B)
- ("/s" ?\e,B6\e(B)
- ("/x" ?\e,B<\e(B)
- ("/z" ?\e,B?\e(B)
- ("/A" ?\e,B!\e(B)
- ("/C" ?\e,BF\e(B)
- ("/E" ?\e,BJ\e(B)
- ("/L" ?\e,B#\e(B)
- ("/N" ?\e,BQ\e(B)
- ("/O" ?\e,BS\e(B)
- ("/S" ?\e,B&\e(B)
- ("/X" ?\e,B,\e(B)
- ("/Z" ?\e,B/\e(B))
+ ("/a" ?Ä…)
+ ("/c" ?ć)
+ ("/e" ?Ä™)
+ ("/l" ?Å‚)
+ ("/n" ?Å„)
+ ("/o" ?ó)
+ ("/s" ?Å›)
+ ("/x" ?ź)
+ ("/z" ?ż)
+ ("/A" ?Ä„)
+ ("/C" ?Ć)
+ ("/E" ?Ę)
+ ("/L" ?Å)
+ ("/N" ?Ń)
+ ("/O" ?Ó)
+ ("/S" ?Åš)
+ ("/X" ?Ź)
+ ("/Z" ?Å»))
(quail-define-package
"latin-9-prefix" "Latin-9" "0>" t
effect | prefix | examples
------------+--------+----------
- acute | ' | 'a -> \e,ba\e(B
- grave | ` | `a -> \e,b`\e(B
- circumflex | ^ | ^a -> \e,bb\e(B
- diaeresis | \" | \"a -> \e,bd\e(B, \"Y -> \e,b>\e(B
- tilde | ~ | ~a -> \e,bc\e(B
- caron | ~ | ~z -> \e,b8\e(B
- cedilla | ~ | ~c -> \e,bg\e(B
- misc | \" ~ / | \"s -> \e,b_\e(B ~d -> \e,bp\e(B ~t -> \e,b~\e(B /a -> \e,be\e(B /e -> \e,bf\e(B /o -> \e,bx\e(B
- | \" ~ / | /o -> \e,b=\e(B
- symbol | ~ | ~> -> \e,b;\e(B ~< -> \e,b+\e(B ~! -> \e,b!\e(B ~? -> \e,b?\e(B ~~ -> \e,b8\e(B
- | ~ | ~s -> \e,b'\e(B ~e -> \e,b$\e(B ~. -> \e,b7\e(B ~$ -> \e,b#\e(B ~u -> \e,b5\e(B
- | ~ | ~- -> \e,b-\e(B ~= -> \e,b/\e(B
- symbol | _ / | _o -> \e,b:\e(B _a -> \e,b*\e(B // -> \e,b0\e(B /\\ -> \e,bW\e(B _y -> \e,b%\e(B
- | _ / | _: -> \e,bw\e(B /c -> \e,b"\e(B ~p -> \e,b6\e(B
- | _ / | /= -> \e,b,\e(B
- symbol | ^ | ^r -> \e,b.\e(B ^c -> \e,b)\e(B ^1 -> \e,b9\e(B ^2 -> \e,b2\e(B ^3 -> \e,b3\e(B _a -> \e,b*\e(B
+ acute | ' | 'a -> á
+ grave | ` | `a -> Ã
+ circumflex | ^ | ^a -> â
+ diaeresis | \" | \"a -> ä, \"Y -> Ÿ
+ tilde | ~ | ~a -> ã
+ caron | ~ | ~z -> ž
+ cedilla | ~ | ~c -> ç
+ misc | \" ~ / | \"s -> ß ~d -> ð ~t -> þ /a -> å /e -> æ /o -> ø
+ | \" ~ / | /o -> Å“
+ symbol | ~ | ~> -> » ~< -> « ~! -> ¡ ~? -> ¿ ~~ -> ž
+ | ~ | ~s -> § ~e -> € ~. -> · ~$ -> £ ~u -> µ
+ | ~ | ~- ->  ~= -> ¯
+ symbol | _ / | _o -> º _a -> ª // -> ° /\\ -> × _y -> ¥
+ | _ / | _: -> ÷ /c -> ¢ ~p -> ¶
+ | _ / | /= -> ¬
+ symbol | ^ | ^r -> ® ^c -> © ^1 -> ¹ ^2 -> ² ^3 -> ³ _a -> ª
" nil t nil nil nil nil nil nil nil nil t)
(quail-define-rules
- ("'A" ?\e,bA\e(B)
- ("'E" ?\e,bI\e(B)
- ("'I" ?\e,bM\e(B)
- ("'O" ?\e,bS\e(B)
- ("'U" ?\e,bZ\e(B)
- ("'Y" ?\e,b]\e(B)
- ("'a" ?\e,ba\e(B)
- ("'e" ?\e,bi\e(B)
- ("'i" ?\e,bm\e(B)
- ("'o" ?\e,bs\e(B)
- ("'u" ?\e,bz\e(B)
- ("'y" ?\e,b}\e(B)
+ ("'A" ?Ã)
+ ("'E" ?É)
+ ("'I" ?Ã)
+ ("'O" ?Ó)
+ ("'U" ?Ú)
+ ("'Y" ?Ã)
+ ("'a" ?á)
+ ("'e" ?é)
+ ("'i" ?Ã)
+ ("'o" ?ó)
+ ("'u" ?ú)
+ ("'y" ?ý)
("' " ?')
- ("`A" ?\e,b@\e(B)
- ("`E" ?\e,bH\e(B)
- ("`I" ?\e,bL\e(B)
- ("`O" ?\e,bR\e(B)
- ("`U" ?\e,bY\e(B)
- ("`a" ?\e,b`\e(B)
- ("`e" ?\e,bh\e(B)
- ("`i" ?\e,bl\e(B)
- ("`o" ?\e,br\e(B)
- ("`u" ?\e,by\e(B)
+ ("`A" ?À)
+ ("`E" ?È)
+ ("`I" ?Ì)
+ ("`O" ?Ã’)
+ ("`U" ?Ù)
+ ("`a" ?Ã )
+ ("`e" ?è)
+ ("`i" ?ì)
+ ("`o" ?ò)
+ ("`u" ?ù)
("``" ?`)
("` " ?`)
- ("^A" ?\e,bB\e(B)
- ("^E" ?\e,bJ\e(B)
- ("^I" ?\e,bN\e(B)
- ("^O" ?\e,bT\e(B)
- ("^U" ?\e,b[\e(B)
- ("^a" ?\e,bb\e(B)
- ("^e" ?\e,bj\e(B)
- ("^i" ?\e,bn\e(B)
- ("^o" ?\e,bt\e(B)
- ("^u" ?\e,b{\e(B)
+ ("^A" ?Â)
+ ("^E" ?Ê)
+ ("^I" ?ÃŽ)
+ ("^O" ?Ô)
+ ("^U" ?Û)
+ ("^a" ?â)
+ ("^e" ?ê)
+ ("^i" ?î)
+ ("^o" ?ô)
+ ("^u" ?û)
("^^" ?^)
("^ " ?^)
- ("\"A" ?\e,bD\e(B)
- ("\"E" ?\e,bK\e(B)
- ("\"I" ?\e,bO\e(B)
- ("\"O" ?\e,bV\e(B)
- ("\"U" ?\e,b\\e(B)
- ("\"a" ?\e,bd\e(B)
- ("\"e" ?\e,bk\e(B)
- ("\"i" ?\e,bo\e(B)
- ("\"o" ?\e,bv\e(B)
- ("\"s" ?\e,b_\e(B)
- ("\"u" ?\e,b|\e(B)
- ("\"y" ?\e,b\7f\e(B)
+ ("\"A" ?Ä)
+ ("\"E" ?Ë)
+ ("\"I" ?Ã)
+ ("\"O" ?Ö)
+ ("\"U" ?Ü)
+ ("\"a" ?ä)
+ ("\"e" ?ë)
+ ("\"i" ?ï)
+ ("\"o" ?ö)
+ ("\"s" ?ß)
+ ("\"u" ?ü)
+ ("\"y" ?ÿ)
("\" " ?\")
- ("~A" ?\e,bC\e(B)
- ("~C" ?\e,bG\e(B)
- ("~D" ?\e,bP\e(B)
- ("~N" ?\e,bQ\e(B)
- ("~O" ?\e,bU\e(B)
- ("~S" ?\e,b&\e(B)
- ("~T" ?\e,b^\e(B)
- ("~Z" ?\e,b4\e(B)
- ("~a" ?\e,bc\e(B)
- ("~c" ?\e,bg\e(B)
- ("~d" ?\e,bp\e(B)
- ("~n" ?\e,bq\e(B)
- ("~o" ?\e,bu\e(B)
- ("~s" ?\e,b(\e(B)
- ("~t" ?\e,b~\e(B)
- ("~z" ?\e,b8\e(B)
- ("~>" ?\\e,b;\e(B)
- ("~<" ?\\e,b+\e(B)
- ("~!" ?\e,b!\e(B)
- ("~?" ?\e,b?\e(B)
+ ("~A" ?Ã)
+ ("~C" ?Ç)
+ ("~D" ?Ã)
+ ("~N" ?Ñ)
+ ("~O" ?Õ)
+ ("~S" ?Å )
+ ("~T" ?Þ)
+ ("~Z" ?Ž)
+ ("~a" ?ã)
+ ("~c" ?ç)
+ ("~d" ?ð)
+ ("~n" ?ñ)
+ ("~o" ?õ)
+ ("~s" ?Å¡)
+ ("~t" ?þ)
+ ("~z" ?ž)
+ ("~>" ?\»)
+ ("~<" ?\«)
+ ("~!" ?¡)
+ ("~?" ?¿)
("~ " ?~)
- ("/A" ?\e,bE\e(B)
- ("/E" ?\e,bF\e(B)
- ("/O" ?\e,bX\e(B)
- ("/a" ?\e,be\e(B)
- ("/e" ?\e,bf\e(B)
- ("/o" ?\e,bx\e(B)
- ("//" ?\e,b0\e(B)
+ ("/A" ?Ã…)
+ ("/E" ?Æ)
+ ("/O" ?Ø)
+ ("/a" ?Ã¥)
+ ("/e" ?æ)
+ ("/o" ?ø)
+ ("//" ?°)
("/ " ?/)
- ("_o" ?\e,b:\e(B)
- ("_a" ?\e,b*\e(B)
- ("_+" ?\e,b1\e(B)
- ("_y" ?\e,b%\e(B)
- ("_:" ?\e,bw\e(B)
- ("_ " ?\e,b \e(B)
+ ("_o" ?º)
+ ("_a" ?ª)
+ ("_+" ?±)
+ ("_y" ?Â¥)
+ ("_:" ?÷)
+ ("_ " ? )
("__" ?_)
- ("/c" ?\e,b"\e(B)
- ("/\\" ?\e,bW\e(B)
- ("/o" ?\e,b=\e(B) ; clash with \e,bx\e(B, but \e,bf\e(B uses /
- ("/O" ?\e,b<\e(B)
- ("\"Y" ?\e,b>\e(B)
- ("~s" ?\e,b'\e(B)
- ("~p" ?\e,b6\e(B)
+ ("/c" ?¢)
+ ("/\\" ?×)
+ ("/o" ?œ) ; clash with ø, but æ uses /
+ ("/O" ?Å’)
+ ("\"Y" ?Ÿ)
+ ("~s" ?§)
+ ("~p" ?¶)
;; Is this the best option for Euro entry?
- ("~e" ?\e,b$\e(B)
- ("~." ?\e,b7\e(B)
- ("~$" ?\e,b#\e(B)
- ("~u" ?\e,b5\e(B)
- ("^r" ?\e,b.\e(B)
- ("^c" ?\e,b)\e(B)
- ("^1" ?\e,b9\e(B)
- ("^2" ?\e,b2\e(B)
- ("^3" ?\e,b3\e(B)
- ("~-" ?\e,b-\e(B)
- ("~=" ?\e,b/\e(B)
- ("/=" ?\e,b,\e(B))
+ ("~e" ?€)
+ ("~." ?·)
+ ("~$" ?£)
+ ("~u" ?µ)
+ ("^r" ?®)
+ ("^c" ?©)
+ ("^1" ?¹)
+ ("^2" ?²)
+ ("^3" ?³)
+ ("~-" ?Â)
+ ("~=" ?¯)
+ ("/=" ?¬))
;; Latin-8 was done by an Englishman -- Johnny Celt should take a
;; squint at it.
effect | prefix | examples
------------+--------+----------
- acute | ' | 'a -> \e,_a\e(B
- grave | ` | `a -> \e,_`\e(B
- circumflex | ^ | ^w -> \e,_p\e(B
- diaeresis | \" | \"a -> \e,_d\e(B
- dot above | . | .b -> \e,_"\e(B
- tilde | ~ | ~a -> \e,_c\e(B
- cedilla | ~ | ~c -> \e,_g\e(B
- misc | \" ~ / | \"s -> \e,__\e(B /a -> \e,_e\e(B /e -> \e,_f\e(B /o -> \e,_x\e(B
- | ~ | ~s -> \e,_'\e(B ~$ -> \e,_#\e(B ~p -> \e,_6\e(B
- symbol | ^ | ^r -> \e,_.\e(B ^c -> \e,_)\e(B
+ acute | ' | 'a -> á
+ grave | ` | `a -> Ã
+ circumflex | ^ | ^w -> ŵ
+ diaeresis | \" | \"a -> ä
+ dot above | . | .b -> ḃ
+ tilde | ~ | ~a -> ã
+ cedilla | ~ | ~c -> ç
+ misc | \" ~ / | \"s -> ß /a -> å /e -> æ /o -> ø
+ | ~ | ~s -> § ~$ -> £ ~p -> ¶
+ symbol | ^ | ^r -> ® ^c -> ©
" nil t nil nil nil nil nil nil nil nil t)
;; Basically following Latin-1, plus dottiness from Latin-3.
(quail-define-rules
- (".B" ?\e,_!\e(B)
- (".b" ?\e,_"\e(B)
- (".c" ?\e,_%\e(B)
- (".C" ?\e,_$\e(B)
- (".D" ?\e,_&\e(B)
- (".d" ?\e,_+\e(B)
- (".f" ?\e,_1\e(B)
- (".F" ?\e,_0\e(B)
- (".g" ?\e,_3\e(B)
- (".G" ?\e,_2\e(B)
- (".m" ?\e,_5\e(B)
- (".M" ?\e,_4\e(B)
- (".p" ?\e,_9\e(B)
- (".P" ?\e,_7\e(B)
- (".s" ?\e,_?\e(B)
- (".S" ?\e,_;\e(B)
- (".t" ?\e,_w\e(B)
- (".T" ?\e,_W\e(B)
- ("'A" ?\e,_A\e(B)
- ("'E" ?\e,_I\e(B)
- ("'I" ?\e,_M\e(B)
- ("'O" ?\e,_S\e(B)
- ("'U" ?\e,_Z\e(B)
- ("'Y" ?\e,_]\e(B)
- ("'W" ?\e,_*\e(B)
- ("'a" ?\e,_a\e(B)
- ("'e" ?\e,_i\e(B)
- ("'i" ?\e,_m\e(B)
- ("'o" ?\e,_s\e(B)
- ("'u" ?\e,_z\e(B)
- ("'w" ?\e,_:\e(B)
- ("'y" ?\e,_}\e(B)
+ (".B" ?Ḃ)
+ (".b" ?ḃ)
+ (".c" ?Ä‹)
+ (".C" ?ÄŠ)
+ (".D" ?Ḋ)
+ (".d" ?ḋ)
+ (".f" ?ḟ)
+ (".F" ?Ḟ)
+ (".g" ?Ä¡)
+ (".G" ?Ä )
+ (".m" ?á¹)
+ (".M" ?á¹€)
+ (".p" ?á¹—)
+ (".P" ?á¹–)
+ (".s" ?ṡ)
+ (".S" ?á¹ )
+ (".t" ?ṫ)
+ (".T" ?Ṫ)
+ ("'A" ?Ã)
+ ("'E" ?É)
+ ("'I" ?Ã)
+ ("'O" ?Ó)
+ ("'U" ?Ú)
+ ("'Y" ?Ã)
+ ("'W" ?Ẃ)
+ ("'a" ?á)
+ ("'e" ?é)
+ ("'i" ?Ã)
+ ("'o" ?ó)
+ ("'u" ?ú)
+ ("'w" ?ẃ)
+ ("'y" ?ý)
("' " ?')
- ("`A" ?\e,_@\e(B)
- ("`E" ?\e,_H\e(B)
- ("`I" ?\e,_L\e(B)
- ("`O" ?\e,_R\e(B)
- ("`U" ?\e,_Y\e(B)
- ("`W" ?\e,_(\e(B)
- ("`Y" ?\e,_,\e(B)
- ("`a" ?\e,_`\e(B)
- ("`e" ?\e,_h\e(B)
- ("`i" ?\e,_l\e(B)
- ("`o" ?\e,_r\e(B)
- ("`u" ?\e,_y\e(B)
- ("`w" ?\e,_8\e(B)
- ("`y" ?\e,_<\e(B)
+ ("`A" ?À)
+ ("`E" ?È)
+ ("`I" ?Ì)
+ ("`O" ?Ã’)
+ ("`U" ?Ù)
+ ("`W" ?Ẁ)
+ ("`Y" ?Ỳ)
+ ("`a" ?Ã )
+ ("`e" ?è)
+ ("`i" ?ì)
+ ("`o" ?ò)
+ ("`u" ?ù)
+ ("`w" ?áº)
+ ("`y" ?ỳ)
("``" ?`)
("` " ?`)
- ("^A" ?\e,_B\e(B)
- ("^E" ?\e,_J\e(B)
- ("^I" ?\e,_N\e(B)
- ("^O" ?\e,_T\e(B)
- ("^U" ?\e,_[\e(B)
- ("^a" ?\e,_b\e(B)
- ("^e" ?\e,_j\e(B)
- ("^i" ?\e,_n\e(B)
- ("^o" ?\e,_t\e(B)
- ("^u" ?\e,_{\e(B)
- ("^w" ?\e,_p\e(B)
- ("^W" ?\e,_P\e(B)
- ("^y" ?\e,_~\e(B)
- ("^Y" ?\e,_^\e(B)
+ ("^A" ?Â)
+ ("^E" ?Ê)
+ ("^I" ?ÃŽ)
+ ("^O" ?Ô)
+ ("^U" ?Û)
+ ("^a" ?â)
+ ("^e" ?ê)
+ ("^i" ?î)
+ ("^o" ?ô)
+ ("^u" ?û)
+ ("^w" ?ŵ)
+ ("^W" ?Å´)
+ ("^y" ?Å·)
+ ("^Y" ?Ŷ)
("^^" ?^)
("^ " ?^)
- ("\"A" ?\e,_D\e(B)
- ("\"E" ?\e,_K\e(B)
- ("\"I" ?\e,_O\e(B)
- ("\"O" ?\e,_V\e(B)
- ("\"U" ?\e,_\\e(B)
- ("\"a" ?\e,_d\e(B)
- ("\"e" ?\e,_k\e(B)
- ("\"i" ?\e,_o\e(B)
- ("\"o" ?\e,_v\e(B)
- ("\"s" ?\e,__\e(B)
- ("\"u" ?\e,_|\e(B)
- ("\"w" ?\e,_>\e(B)
- ("\"W" ?\e,_=\e(B)
- ("\"y" ?\e,_\7f\e(B)
- ("\"Y" ?\e,_/\e(B)
+ ("\"A" ?Ä)
+ ("\"E" ?Ë)
+ ("\"I" ?Ã)
+ ("\"O" ?Ö)
+ ("\"U" ?Ü)
+ ("\"a" ?ä)
+ ("\"e" ?ë)
+ ("\"i" ?ï)
+ ("\"o" ?ö)
+ ("\"s" ?ß)
+ ("\"u" ?ü)
+ ("\"w" ?ẅ)
+ ("\"W" ?Ẅ)
+ ("\"y" ?ÿ)
+ ("\"Y" ?Ÿ)
("\" " ?\")
- ("~A" ?\e,_C\e(B)
- ("~C" ?\e,_G\e(B)
- ("~N" ?\e,_Q\e(B)
- ("~O" ?\e,_U\e(B)
- ("~a" ?\e,_c\e(B)
- ("~c" ?\e,_g\e(B)
- ("~n" ?\e,_q\e(B)
- ("~o" ?\e,_u\e(B)
+ ("~A" ?Ã)
+ ("~C" ?Ç)
+ ("~N" ?Ñ)
+ ("~O" ?Õ)
+ ("~a" ?ã)
+ ("~c" ?ç)
+ ("~n" ?ñ)
+ ("~o" ?õ)
("~ " ?~)
- ("/A" ?\e,_E\e(B)
- ("/E" ?\e,_F\e(B)
- ("/O" ?\e,_X\e(B)
- ("/a" ?\e,_e\e(B)
- ("/e" ?\e,_f\e(B)
- ("/o" ?\e,_x\e(B)
+ ("/A" ?Ã…)
+ ("/E" ?Æ)
+ ("/O" ?Ø)
+ ("/a" ?Ã¥)
+ ("/e" ?æ)
+ ("/o" ?ø)
("/ " ?/)
- ("~p" ?\e,_6\e(B)
- ("~s" ?\e,_'\e(B)
- ("~$" ?\e,_#\e(B)
- ("^r" ?\e,_.\e(B)
- ("^c" ?\e,_)\e(B))
+ ("~p" ?¶)
+ ("~s" ?§)
+ ("~$" ?£)
+ ("^r" ?®)
+ ("^c" ?©))
(quail-define-package
"latin-prefix" "Latin" "L>" t
effect | prefix | examples
------------+--------+----------
- acute | ' | 'a -> \e,Aa\e(B, '' -> \e,A4\e(B
- grave | ` | `a -> \e,A`\e(B
- circumflex | ^ | ^a -> \e,Ab\e(B
- diaeresis | \" | \"a -> \e,Ad\e(B \"\" -> \e,A(\e(B
- tilde | ~ | ~a -> \e,Ac\e(B
- cedilla | ~ | ~c -> \e,Ag\e(B
- breve | ~ | ~a -> \e$,1 #\e(B
- caron | ~ | ~c -> \e$,1 -\e(B
- dot above | ~ / . | ~o -> \e$,1 A\e(B /o -> \e$,1 A\e(B .o -> \e$,1 A\e(B
- misc | \" ~ / | \"s -> \e,A_\e(B ~d -> \e,Ap\e(B ~t -> \e,A~\e(B /a -> \e,Ae\e(B /e -> \e,Af\e(B /o -> \e,Ax\e(B
- symbol | ~ | ~> -> \e,A;\e(B ~< -> \e,A+\e(B ~! -> \e,A!\e(B ~? -> \e,A?\e(B ~~ -> \e,A8\e(B
- symbol | _ / | _o -> \e,A:\e(B _a -> \e,A*\e(B // -> \e,A0\e(B /\\ -> \e,AW\e(B _y -> \e,A%\e(B
- symbol | ^ | ^r -> \e,A.\e(B ^c -> \e,A)\e(B ^1 -> \e,A9\e(B ^2 -> \e,A2\e(B ^3 -> \e,A3\e(B
+ acute | ' | 'a -> á, '' -> ´
+ grave | ` | `a -> Ã
+ circumflex | ^ | ^a -> â
+ diaeresis | \" | \"a -> ä \"\" -> ¨
+ tilde | ~ | ~a -> ã
+ cedilla | ~ | ~c -> ç
+ breve | ~ | ~a -> ă
+ caron | ~ | ~c -> Ä
+ dot above | ~ / . | ~o -> Ä¡ /o -> Ä¡ .o -> Ä¡
+ misc | \" ~ / | \"s -> ß ~d -> ð ~t -> þ /a -> å /e -> æ /o -> ø
+ symbol | ~ | ~> -> » ~< -> « ~! -> ¡ ~? -> ¿ ~~ -> ¸
+ symbol | _ / | _o -> º _a -> ª // -> ° /\\ -> × _y -> ¥
+ symbol | ^ | ^r -> ® ^c -> © ^1 -> ¹ ^2 -> ² ^3 -> ³
" nil t nil nil nil nil nil nil nil nil t)
(quail-define-rules
("' " ?')
- ("''" ?\e,A4\e(B)
- ("'A" ?\e,AA\e(B)
- ("'E" ?\e,AI\e(B)
- ("'I" ?\e,AM\e(B)
- ("'O" ?\e,AS\e(B)
- ("'U" ?\e,AZ\e(B)
- ("'W" ?\e$,1nb\e(B)
- ("'Y" ?\e,A]\e(B)
- ("'a" ?\e,Aa\e(B)
- ("'e" ?\e,Ai\e(B)
- ("'i" ?\e,Am\e(B)
- ("'o" ?\e,As\e(B)
- ("'u" ?\e,Az\e(B)
- ("'w" ?\e$,1nc\e(B)
- ("'y" ?\e,A}\e(B)
- (".B" ?\e$,1mB\e(B)
- (".C" ?\e$,1 *\e(B)
- (".D" ?\e$,1mJ\e(B)
- (".F" ?\e$,1m^\e(B)
- (".G" ?\e$,1 @\e(B)
- (".I" ?\e$,1 P\e(B)
- (".M" ?\e$,1n \e(B)
- (".P" ?\e$,1n6\e(B)
- (".S" ?\e$,1n@\e(B)
- (".T" ?\e$,1nJ\e(B)
- (".Z" ?\e$,1!;\e(B)
- (".b" ?\e$,1mC\e(B)
- (".c" ?\e$,1 +\e(B)
- (".d" ?\e$,1mK\e(B)
- (".f" ?\e$,1m_\e(B)
- (".g" ?\e$,1 A\e(B)
- (".m" ?\e$,1n!\e(B)
- (".p" ?\e$,1n7\e(B)
- (".s" ?\e$,1nA\e(B)
- (".t" ?\e$,1nK\e(B)
- (".z" ?\e$,1!<\e(B)
+ ("''" ?´)
+ ("'A" ?Ã)
+ ("'E" ?É)
+ ("'I" ?Ã)
+ ("'O" ?Ó)
+ ("'U" ?Ú)
+ ("'W" ?Ẃ)
+ ("'Y" ?Ã)
+ ("'a" ?á)
+ ("'e" ?é)
+ ("'i" ?Ã)
+ ("'o" ?ó)
+ ("'u" ?ú)
+ ("'w" ?ẃ)
+ ("'y" ?ý)
+ (".B" ?Ḃ)
+ (".C" ?ÄŠ)
+ (".D" ?Ḋ)
+ (".F" ?Ḟ)
+ (".G" ?Ä )
+ (".I" ?Ä°)
+ (".M" ?á¹€)
+ (".P" ?á¹–)
+ (".S" ?á¹ )
+ (".T" ?Ṫ)
+ (".Z" ?Å»)
+ (".b" ?ḃ)
+ (".c" ?Ä‹)
+ (".d" ?ḋ)
+ (".f" ?ḟ)
+ (".g" ?Ä¡)
+ (".m" ?á¹)
+ (".p" ?á¹—)
+ (".s" ?ṡ)
+ (".t" ?ṫ)
+ (".z" ?ż)
("/ " ?/)
- ("/#" ?\e,A#\e(B)
- ("/$" ?\e,A$\e(B)
- ("/." ?\e$,1$y\e(B)
- ("//" ?\e,A0\e(B)
- ("/2" ?\e,A=\e(B)
- ("/3" ?\e,A>\e(B)
- ("/4" ?\e,A<\e(B)
- ("/=" ?\e,A,\e(B)
- ("/A" ?\e,AE\e(B)
- ("/C" ?\e$,1 *\e(B)
- ("/E" ?\e,AF\e(B)
- ("/G" ?\e$,1 @\e(B)
- ("/H" ?\e$,1 F\e(B)
- ("/I" ?\e$,1 P\e(B)
- ("/O" ?\e,AX\e(B)
- ("/O" ?\e$,1 r\e(B)
- ("/Z" ?\e$,1!;\e(B)
- ("/\\" ?\e,AW\e(B)
- ("/a" ?\e,Ae\e(B)
- ("/c" ?\e,A"\e(B)
- ("/c" ?\e$,1 +\e(B)
- ("/e" ?\e,Af\e(B)
- ("/g" ?\e$,1 A\e(B)
- ("/h" ?\e$,1 G\e(B)
- ("/i" ?\e$,1 Q\e(B)
- ("/o" ?\e,Ax\e(B)
- ("/o" ?\e$,1 s\e(B)
- ("/z" ?\e$,1!<\e(B)
+ ("/#" ?£)
+ ("/$" ?¤)
+ ("/." ?Ë™)
+ ("//" ?°)
+ ("/2" ?½)
+ ("/3" ?¾)
+ ("/4" ?¼)
+ ("/=" ?¬)
+ ("/A" ?Ã…)
+ ("/C" ?ÄŠ)
+ ("/E" ?Æ)
+ ("/G" ?Ä )
+ ("/H" ?Ħ)
+ ("/I" ?Ä°)
+ ("/O" ?Ø)
+ ("/O" ?Å’)
+ ("/Z" ?Å»)
+ ("/\\" ?×)
+ ("/a" ?Ã¥)
+ ("/c" ?¢)
+ ("/c" ?Ä‹)
+ ("/e" ?æ)
+ ("/g" ?Ä¡)
+ ("/h" ?ħ)
+ ("/i" ?ı)
+ ("/o" ?ø)
+ ("/o" ?Å“)
+ ("/z" ?ż)
("\" " ?\")
- ("\"A" ?\e,AD\e(B)
- ("\"E" ?\e,AK\e(B)
- ("\"I" ?\e,AO\e(B)
- ("\"O" ?\e,AV\e(B)
- ("\"U" ?\e,A\\e(B)
- ("\"W" ?\e$,1nd\e(B)
- ("\"Y" ?\e$,1!8\e(B)
- ("\"\"" ?\e,A(\e(B)
- ("\"a" ?\e,Ad\e(B)
- ("\"e" ?\e,Ak\e(B)
- ("\"i" ?\e,Ao\e(B)
- ("\"o" ?\e,Av\e(B)
- ("\"s" ?\e,A_\e(B)
- ("\"u" ?\e,A|\e(B)
- ("\"w" ?\e$,1ne\e(B)
- ("\"y" ?\e,A\7f\e(B)
+ ("\"A" ?Ä)
+ ("\"E" ?Ë)
+ ("\"I" ?Ã)
+ ("\"O" ?Ö)
+ ("\"U" ?Ü)
+ ("\"W" ?Ẅ)
+ ("\"Y" ?Ÿ)
+ ("\"\"" ?¨)
+ ("\"a" ?ä)
+ ("\"e" ?ë)
+ ("\"i" ?ï)
+ ("\"o" ?ö)
+ ("\"s" ?ß)
+ ("\"u" ?ü)
+ ("\"w" ?ẅ)
+ ("\"y" ?ÿ)
("^ " ?^)
- ("^1" ?\e,A9\e(B)
- ("^2" ?\e,A2\e(B)
- ("^3" ?\e,A3\e(B)
- ("^A" ?\e,AB\e(B)
- ("^C" ?\e$,1 (\e(B)
- ("^E" ?\e,AJ\e(B)
- ("^G" ?\e$,1 <\e(B)
- ("^H" ?\e$,1 D\e(B)
- ("^I" ?\e,AN\e(B)
- ("^J" ?\e$,1 T\e(B)
- ("^O" ?\e,AT\e(B)
- ("^S" ?\e$,1 |\e(B)
- ("^U" ?\e,A[\e(B)
- ("^W" ?\e$,1!4\e(B)
- ("^Y" ?\e$,1!6\e(B)
+ ("^1" ?¹)
+ ("^2" ?²)
+ ("^3" ?³)
+ ("^A" ?Â)
+ ("^C" ?Ĉ)
+ ("^E" ?Ê)
+ ("^G" ?Ĝ)
+ ("^H" ?Ĥ)
+ ("^I" ?ÃŽ)
+ ("^J" ?Ä´)
+ ("^O" ?Ô)
+ ("^S" ?Ŝ)
+ ("^U" ?Û)
+ ("^W" ?Å´)
+ ("^Y" ?Ŷ)
("^^" ?^)
- ("^a" ?\e,Ab\e(B)
- ("^c" ?\e,A)\e(B)
- ("^c" ?\e$,1 )\e(B)
- ("^e" ?\e,Aj\e(B)
- ("^g" ?\e$,1 =\e(B)
- ("^h" ?\e$,1 E\e(B)
- ("^i" ?\e,An\e(B)
- ("^j" ?\e$,1 U\e(B)
- ("^o" ?\e,At\e(B)
- ("^r" ?\e,A.\e(B)
- ("^s" ?\e$,1 }\e(B)
- ("^u" ?\e,A{\e(B)
- ("^w" ?\e$,1!5\e(B)
- ("^y" ?\e$,1!7\e(B)
- ("_+" ?\e,A1\e(B)
- ("_:" ?\e,Aw\e(B)
- ("_a" ?\e,A*\e(B)
- ("_o" ?\e,A:\e(B)
- ("_y" ?\e,A%\e(B)
- ("_ " ?\e,A \e(B)
+ ("^a" ?â)
+ ("^c" ?©)
+ ("^c" ?ĉ)
+ ("^e" ?ê)
+ ("^g" ?Ä)
+ ("^h" ?Ä¥)
+ ("^i" ?î)
+ ("^j" ?ĵ)
+ ("^o" ?ô)
+ ("^r" ?®)
+ ("^s" ?Å)
+ ("^u" ?û)
+ ("^w" ?ŵ)
+ ("^y" ?Å·)
+ ("_+" ?±)
+ ("_:" ?÷)
+ ("_a" ?ª)
+ ("_o" ?º)
+ ("_y" ?Â¥)
+ ("_ " ? )
("` " ?`)
- ("`A" ?\e,A@\e(B)
- ("`E" ?\e,AH\e(B)
- ("`I" ?\e,AL\e(B)
- ("`O" ?\e,AR\e(B)
- ("`U" ?\e,AY\e(B)
- ("`W" ?\e$,1n`\e(B)
- ("`Y" ?\e$,1or\e(B)
+ ("`A" ?À)
+ ("`E" ?È)
+ ("`I" ?Ì)
+ ("`O" ?Ã’)
+ ("`U" ?Ù)
+ ("`W" ?Ẁ)
+ ("`Y" ?Ỳ)
("``" ?`)
- ("`a" ?\e,A`\e(B)
- ("`e" ?\e,Ah\e(B)
- ("`i" ?\e,Al\e(B)
- ("`o" ?\e,Ar\e(B)
- ("`u" ?\e,Ay\e(B)
- ("`w" ?\e$,1na\e(B)
- ("`y" ?\e$,1os\e(B)
+ ("`a" ?Ã )
+ ("`e" ?è)
+ ("`i" ?ì)
+ ("`o" ?ò)
+ ("`u" ?ù)
+ ("`w" ?áº)
+ ("`y" ?ỳ)
("~ " ?~)
- ("~!" ?\e,A!\e(B)
- ("~$" ?\e,A#\e(B)
- ("~-" ?\e,A-\e(B)
- ("~." ?\e,A7\e(B)
- ("~<" ?\\e,A+\e(B)
- ("~=" ?\e,A/\e(B)
- ("~>" ?\\e,A;\e(B)
- ("~?" ?\e,A?\e(B)
- ("~A" ?\e,AC\e(B)
- ("~C" ?\e,AG\e(B)
- ("~D" ?\e,AP\e(B)
- ("~G" ?\e$,1 >\e(B)
- ("~N" ?\e,AQ\e(B)
- ("~O" ?\e,AU\e(B)
- ("~O" ?\e$,1 @\e(B)
- ("~S" ?\e$,1 ~\e(B)
- ("~S" ?\e$,1! \e(B)
- ("~T" ?\e,A^\e(B)
- ("~U" ?\e$,1!,\e(B)
- ("~Z" ?\e$,1!=\e(B)
- ("~`" ?\e$,1$x\e(B)
- ("~a" ?\e,Ac\e(B)
- ("~c" ?\e,Ag\e(B)
- ("~d" ?\e,Ap\e(B)
- ("~e" ?\e$,1tL\e(B)
- ("~g" ?\e$,1 ?\e(B)
- ("~n" ?\e,Aq\e(B)
- ("~o" ?\e,Au\e(B)
- ("~o" ?\e$,1 A\e(B)
- ("~p" ?\e,A6\e(B)
- ("~s" ?\e,A'\e(B)
- ("~s" ?\e$,1 \7f\e(B)
- ("~s" ?\e$,1!!\e(B)
- ("~t" ?\e,A~\e(B)
- ("~u" ?\e,A5\e(B)
- ("~u" ?\e$,1!-\e(B)
- ("~x" ?\e,A$\e(B)
- ("~z" ?\e$,1!>\e(B)
- ("~|" ?\e,A&\e(B)
- ("~~" ?\e,A8\e(B)
+ ("~!" ?¡)
+ ("~$" ?£)
+ ("~-" ?Â)
+ ("~." ?·)
+ ("~<" ?\«)
+ ("~=" ?¯)
+ ("~>" ?\»)
+ ("~?" ?¿)
+ ("~A" ?Ã)
+ ("~C" ?Ç)
+ ("~D" ?Ã)
+ ("~G" ?Äž)
+ ("~N" ?Ñ)
+ ("~O" ?Õ)
+ ("~O" ?Ä )
+ ("~S" ?Åž)
+ ("~S" ?Å )
+ ("~T" ?Þ)
+ ("~U" ?Ŭ)
+ ("~Z" ?Ž)
+ ("~`" ?˘)
+ ("~a" ?ã)
+ ("~c" ?ç)
+ ("~d" ?ð)
+ ("~e" ?€)
+ ("~g" ?ÄŸ)
+ ("~n" ?ñ)
+ ("~o" ?õ)
+ ("~o" ?Ä¡)
+ ("~p" ?¶)
+ ("~s" ?§)
+ ("~s" ?ÅŸ)
+ ("~s" ?Å¡)
+ ("~t" ?þ)
+ ("~u" ?µ)
+ ("~u" ?Å)
+ ("~x" ?¤)
+ ("~z" ?ž)
+ ("~|" ?¦)
+ ("~~" ?¸)
)
;;; arch-tag: 83017837-6b84-4366-b183-e0577e3ed838
-;;; pypunct-b5.el --- Quail packages for Chinese (pinyin + extra symbols)
+;;; pypunct-b5.el --- Quail packages for Chinese (pinyin + extra symbols) -*-coding: iso-2022-7bit;-*-
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
- ;; 2006, 2007
+ ;; 2006, 2007, 2008
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
-;;; symbol-ksc.el --- Quail-package for Korean Symbol (KSC5601)
+;;; symbol-ksc.el --- Quail-package for Korean Symbol (KSC5601) -*-coding: iso-2022-7bit;-*-
- ;; Copyright (C) 1997, 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ ;; Copyright (C) 1997, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
;; Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
- ;; 2006, 2007
+ ;; 2006, 2007, 2008
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
-;;; thai.el --- Quail package for inputting Thai characters
+;;; thai.el --- Quail package for inputting Thai characters -*-coding: iso-2022-7bit;-*-
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- ;; 2005, 2006, 2007
+ ;; 2005, 2006, 2007, 2008
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
;;; Code:
(require 'quail)
-(require 'thai-util)
(defmacro thai-generate-quail-map (translation-table)
(let (map)
Don't know where to assign characters '\e,Tz\e(B' and '\e,T{\e(B'."
nil t t t t nil nil nil nil nil t)
-(quail-install-map
- (thai-generate-quail-map
- [
- 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 ; control codes
- 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 ; control codes
+(thai-generate-quail-map
+ [
+ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 ; control codes
+ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 ; control codes
;; This data is quite old.
-;; 0 "#" "." "\e,Tr\e(B" "\e,Ts\e(B" "\e,Tt\e(B" "\e,TQi\e(B" "\e,T'\e(B" ; SPC .. '
-;; "\e,Tv\e(B" "\e,Tw\e(B" "\e,Tu\e(B" "\e,Ty\e(B" "\e,TA\e(B" "\e,T"\e(B" "\e,Tc\e(B" "\e,T=\e(B" ; ( .. /
-;; "\e,T(\e(B" "\e,TE\e(B" "/" "_" "\e,T@\e(B" "\e,T6\e(B" "\e,TX\e(B" "\e,TV\e(B" ; 0 .. 7
-;; "\e,T$\e(B" "\e,T5\e(B" "\e,T+\e(B" "\e,TG\e(B" "\e,T2\e(B" "\e,T*\e(B" "\e,TL\e(B" "\e,TF\e(B" ; 8 .. ?
-;; "\e,Tq\e(B" "\e,TD\e(B" "\e,TZ\e(B" "\e,T)\e(B" "\e,T/\e(B" "\e,T.\e(B" "\e,Tb\e(B" "\e,T,\e(B" ; @ .. G
-;; "\e,Tg\e(B" "\e,T3\e(B" "\e,Tk\e(B" "\e,TI\e(B" "\e,TH\e(B" "\e,Tn\e(B" "\e,Tl\e(B" "\e,TO\e(B" ; H .. O
-;; "\e,T-\e(B" "\e,Tp\e(B" "\e,T1\e(B" "\e,T&\e(B" "\e,T8\e(B" "\e,Tj\e(B" "\e,TN\e(B" "\"" ; P .. W
-;; ")" "\e,Tm\e(B" "(" "\e,T:\e(B" "\e,T_\e(B" "\e,TE\e(B" "\e,TY\e(B" "\e,Tx\e(B" ; X .. _
-;; "\e,T#\e(B" "\e,T?\e(B" "\e,TT\e(B" "\e,Ta\e(B" "\e,T!\e(B" "\e,TS\e(B" "\e,T4\e(B" "\e,T`\e(B" ; ` .. g
-;; "\e,Ti\e(B" "\e,TC\e(B" "\e,Th\e(B" "\e,TR\e(B" "\e,TJ\e(B" "\e,T7\e(B" "\e,TW\e(B" "\e,T9\e(B" ; h .. o
-;; "\e,TB\e(B" "\e,Tf\e(B" "\e,T>\e(B" "\e,TK\e(B" "\e,TP\e(B" "\e,TU\e(B" "\e,TM\e(B" "\e,Td\e(B" ; p .. w
-;; "\e,T;\e(B" "\e,TQ\e(B" "\e,T<\e(B" "\e,T0\e(B" "\e,To\e(B" "," "\e,T%\e(B" 0 ; x .. DEL
+;; 0 "#" "." "\e,Tr\e(B" "\e,Ts\e(B" "\e,Tt\e(B" "\e,TQi\e(B" "\e,T'\e(B" ; SPC .. '
+;; "\e,Tv\e(B" "\e,Tw\e(B" "\e,Tu\e(B" "\e,Ty\e(B" "\e,TA\e(B" "\e,T"\e(B" "\e,Tc\e(B" "\e,T=\e(B" ; ( .. /
+;; "\e,T(\e(B" "\e,TE\e(B" "/" "_" "\e,T@\e(B" "\e,T6\e(B" "\e,TX\e(B" "\e,TV\e(B" ; 0 .. 7
+;; "\e,T$\e(B" "\e,T5\e(B" "\e,T+\e(B" "\e,TG\e(B" "\e,T2\e(B" "\e,T*\e(B" "\e,TL\e(B" "\e,TF\e(B" ; 8 .. ?
+;; "\e,Tq\e(B" "\e,TD\e(B" "\e,TZ\e(B" "\e,T)\e(B" "\e,T/\e(B" "\e,T.\e(B" "\e,Tb\e(B" "\e,T,\e(B" ; @ .. G
+;; "\e,Tg\e(B" "\e,T3\e(B" "\e,Tk\e(B" "\e,TI\e(B" "\e,TH\e(B" "\e,Tn\e(B" "\e,Tl\e(B" "\e,TO\e(B" ; H .. O
+;; "\e,T-\e(B" "\e,Tp\e(B" "\e,T1\e(B" "\e,T&\e(B" "\e,T8\e(B" "\e,Tj\e(B" "\e,TN\e(B" "\"" ; P .. W
+;; ")" "\e,Tm\e(B" "(" "\e,T:\e(B" "\e,T_\e(B" "\e,TE\e(B" "\e,TY\e(B" "\e,Tx\e(B" ; X .. _
+;; "\e,T#\e(B" "\e,T?\e(B" "\e,TT\e(B" "\e,Ta\e(B" "\e,T!\e(B" "\e,TS\e(B" "\e,T4\e(B" "\e,T`\e(B" ; ` .. g
+;; "\e,Ti\e(B" "\e,TC\e(B" "\e,Th\e(B" "\e,TR\e(B" "\e,TJ\e(B" "\e,T7\e(B" "\e,TW\e(B" "\e,T9\e(B" ; h .. o
+;; "\e,TB\e(B" "\e,Tf\e(B" "\e,T>\e(B" "\e,TK\e(B" "\e,TP\e(B" "\e,TU\e(B" "\e,TM\e(B" "\e,Td\e(B" ; p .. w
+;; "\e,T;\e(B" "\e,TQ\e(B" "\e,T<\e(B" "\e,T0\e(B" "\e,To\e(B" "," "\e,T%\e(B" 0 ; x .. DEL
;; This is the correct data nowadays.
- 0 "+" "." "\e,Tr\e(B" "\e,Ts\e(B" "\e,Tt\e(B" "\e,T_\e(B" "\e,T'\e(B" ; SPC .. '
- "\e,Tv\e(B" "\e,Tw\e(B" "\e,Tu\e(B" "\e,Ty\e(B" "\e,TA\e(B" "\e,T"\e(B" "\e,Tc\e(B" "\e,T=\e(B" ; ( .. /
- "\e,T(\e(B" "\e,Te\e(B" "/" "-" "\e,T@\e(B" "\e,T6\e(B" "\e,TX\e(B" "\e,TV\e(B" ; 0 .. 7
- "\e,T$\e(B" "\e,T5\e(B" "\e,T+\e(B" "\e,TG\e(B" "\e,T2\e(B" "\e,T*\e(B" "\e,TL\e(B" "\e,TF\e(B" ; 8 .. ?
- "\e,Tq\e(B" "\e,TD\e(B" "\e,TZ\e(B" "\e,T)\e(B" "\e,T/\e(B" "\e,T.\e(B" "\e,Tb\e(B" "\e,T,\e(B" ; @ .. G
- "\e,Tg\e(B" "\e,T3\e(B" "\e,Tk\e(B" "\e,TI\e(B" "\e,TH\e(B" "?" "\e,Tl\e(B" "\e,TO\e(B" ; H .. O
- "\e,T-\e(B" "\e,Tp\e(B" "\e,T1\e(B" "\e,T&\e(B" "\e,T8\e(B" "\e,Tj\e(B" "\e,TN\e(B" "\"" ; P .. W
- "\)" "\e,Tm\e(B" "\(" "\e,T:\e(B" "\e,T#\e(B" "\e,TE\e(B" "\e,TY\e(B" "\e,Tx\e(B" ; X .. _
- "_" "\e,T?\e(B" "\e,TT\e(B" "\e,Ta\e(B" "\e,T!\e(B" "\e,TS\e(B" "\e,T4\e(B" "\e,T`\e(B" ; ` .. g
- "\e,Ti\e(B" "\e,TC\e(B" "\e,Th\e(B" "\e,TR\e(B" "\e,TJ\e(B" "\e,T7\e(B" "\e,TW\e(B" "\e,T9\e(B" ; h .. o
- "\e,TB\e(B" "\e,Tf\e(B" "\e,T>\e(B" "\e,TK\e(B" "\e,TP\e(B" "\e,TU\e(B" "\e,TM\e(B" "\e,Td\e(B" ; p .. w
- "\e,T;\e(B" "\e,TQ\e(B" "\e,T<\e(B" "\e,T0\e(B" "\e,T%\e(B" "," "%" 0 ; x .. DEL
- ]))
-
-
-\f
+ 0 "+" "." "\e,Tr\e(B" "\e,Ts\e(B" "\e,Tt\e(B" "\e,T_\e(B" "\e,T'\e(B" ; SPC .. '
+ "\e,Tv\e(B" "\e,Tw\e(B" "\e,Tu\e(B" "\e,Ty\e(B" "\e,TA\e(B" "\e,T"\e(B" "\e,Tc\e(B" "\e,T=\e(B" ; ( .. /
+ "\e,T(\e(B" "\e,Te\e(B" "/" "-" "\e,T@\e(B" "\e,T6\e(B" "\e,TX\e(B" "\e,TV\e(B" ; 0 .. 7
+ "\e,T$\e(B" "\e,T5\e(B" "\e,T+\e(B" "\e,TG\e(B" "\e,T2\e(B" "\e,T*\e(B" "\e,TL\e(B" "\e,TF\e(B" ; 8 .. ?
+ "\e,Tq\e(B" "\e,TD\e(B" "\e,TZ\e(B" "\e,T)\e(B" "\e,T/\e(B" "\e,T.\e(B" "\e,Tb\e(B" "\e,T,\e(B" ; @ .. G
+ "\e,Tg\e(B" "\e,T3\e(B" "\e,Tk\e(B" "\e,TI\e(B" "\e,TH\e(B" "?" "\e,Tl\e(B" "\e,TO\e(B" ; H .. O
+ "\e,T-\e(B" "\e,Tp\e(B" "\e,T1\e(B" "\e,T&\e(B" "\e,T8\e(B" "\e,Tj\e(B" "\e,TN\e(B" "\"" ; P .. W
+ "\)" "\e,Tm\e(B" "\(" "\e,T:\e(B" "\e,T#\e(B" "\e,TE\e(B" "\e,TY\e(B" "\e,Tx\e(B" ; X .. _
+ "_" "\e,T?\e(B" "\e,TT\e(B" "\e,Ta\e(B" "\e,T!\e(B" "\e,TS\e(B" "\e,T4\e(B" "\e,T`\e(B" ; ` .. g
+ "\e,Ti\e(B" "\e,TC\e(B" "\e,Th\e(B" "\e,TR\e(B" "\e,TJ\e(B" "\e,T7\e(B" "\e,TW\e(B" "\e,T9\e(B" ; h .. o
+ "\e,TB\e(B" "\e,Tf\e(B" "\e,T>\e(B" "\e,TK\e(B" "\e,TP\e(B" "\e,TU\e(B" "\e,TM\e(B" "\e,Td\e(B" ; p .. w
+ "\e,T;\e(B" "\e,TQ\e(B" "\e,T<\e(B" "\e,T0\e(B" "\e,T%\e(B" "," "%" 0 ; x .. DEL
+ ])
+
+
;; Thai Pattachote keyboard support.
(quail-define-package
"Thai Pattachote input method with TIS620 keyboard layout"
nil t t t t nil nil nil nil nil t)
-(quail-install-map
- (thai-generate-quail-map
- [ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 ; control codes
- 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 ; control codes
- 0 "+" "\e,T1\e(B" "/" "," "?" "_" "\e,T"\e(B" ; SPC .. '
- "(" ")" "." "%" "\e,TP\e(B" "\e,Tq\e(B" "\e,T(\e(B" "\e,T>\e(B" ; ( .. /
- "\e,Tp\e(B" "=" "\e,Tr\e(B" "\e,Ts\e(B" "\e,Tt\e(B" "\e,Tu\e(B" "\e,TY\e(B" "\e,Tw\e(B" ; 0 .. 7
- "\e,Tx\e(B" "\e,Ty\e(B" "\e,T&\e(B" "\e,Td\e(B" "\e,T?\e(B" "\e,Tv\e(B" "\e,T2\e(B" "\e,TL\e(B" ; 8 .. ?
- "\"" "\e,Tk\e(B" "\e,TQ\e(B" "\e,T0\e(B" "\e,TS\e(B" "\e,Tf\e(B" "\e,T3\e(B" "\e,Tl\e(B" ; @ .. G
- "\e,TW\e(B" "\e,T+\e(B" "\e,T<\e(B" "\e,T*\e(B" "\e,Tb\e(B" "\e,TN\e(B" "\e,TH\e(B" "\e,T6\e(B" ; H .. O
- "\e,T2\e(B" "\e,Tj\e(B" "\e,T-\e(B" "\e,T8\e(B" "\e,TI\e(B" "\e,T=\e(B" "\e,T@\e(B" "\e,TD\e(B" ; P .. W
- "\e,T.\e(B" "\e,TV\e(B" "\e,T.\e(B" "\e,Tc\e(B" "\e,TZ\e(B" "\e,T2\e(B" "\e,TX\e(B" "-" ; X .. _
- "\e,T#\e(B" "\e,Ti\e(B" "\e,TT\e(B" "\e,TE\e(B" "\e,T'\e(B" "\e,TB\e(B" "\e,T!\e(B" "\e,TQ\e(B" ; ` .. g
- "\e,TU\e(B" "\e,TA\e(B" "\e,TR\e(B" "\e,T9\e(B" "\e,T`\e(B" "\e,TJ\e(B" "\e,T$\e(B" "\e,TG\e(B" ; h .. o
- "\e,Ta\e(B" "\e,Tg\e(B" "\e,TM\e(B" "\e,T7\e(B" "\e,TC\e(B" "\e,T4\e(B" "\e,TK\e(B" "\e,T5\e(B" ; p .. w
- "\e,T;\e(B" "\e,Th\e(B" "\e,T:\e(B" "\e,TO\e(B" "\e,Tm\e(B" "\e,TF\e(B" "\e,T%\e(B" 0 ; x .. DEL
- ]))
+(thai-generate-quail-map
+ [
+ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 ; control codes
+ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 ; control codes
+ 0 "+" "\e,T1\e(B" "/" "," "?" "_" "\e,T"\e(B" ; SPC .. '
+ "(" ")" "." "%" "\e,TP\e(B" "\e,Tq\e(B" "\e,T(\e(B" "\e,T>\e(B" ; ( .. /
+ "\e,Tp\e(B" "=" "\e,Tr\e(B" "\e,Ts\e(B" "\e,Tt\e(B" "\e,Tu\e(B" "\e,TY\e(B" "\e,Tw\e(B" ; 0 .. 7
+ "\e,Tx\e(B" "\e,Ty\e(B" "\e,T&\e(B" "\e,Td\e(B" "\e,T?\e(B" "\e,Tv\e(B" "\e,T2\e(B" "\e,TL\e(B" ; 8 .. ?
+ "\"" "\e,Tk\e(B" "\e,TQ\e(B" "\e,T0\e(B" "\e,TS\e(B" "\e,Tf\e(B" "\e,T3\e(B" "\e,Tl\e(B" ; @ .. G
+ "\e,TW\e(B" "\e,T+\e(B" "\e,T<\e(B" "\e,T*\e(B" "\e,Tb\e(B" "\e,TN\e(B" "\e,TH\e(B" "\e,T6\e(B" ; H .. O
+ "\e,T2\e(B" "\e,Tj\e(B" "\e,T-\e(B" "\e,T8\e(B" "\e,TI\e(B" "\e,T=\e(B" "\e,T@\e(B" "\e,TD\e(B" ; P .. W
+ "\e,T.\e(B" "\e,TV\e(B" "\e,T.\e(B" "\e,Tc\e(B" "\e,TZ\e(B" "\e,T2\e(B" "\e,TX\e(B" "-" ; X .. _
+ "\e,T#\e(B" "\e,Ti\e(B" "\e,TT\e(B" "\e,TE\e(B" "\e,T'\e(B" "\e,TB\e(B" "\e,T!\e(B" "\e,TQ\e(B" ; ` .. g
+ "\e,TU\e(B" "\e,TA\e(B" "\e,TR\e(B" "\e,T9\e(B" "\e,T`\e(B" "\e,TJ\e(B" "\e,T$\e(B" "\e,TG\e(B" ; h .. o
+ "\e,Ta\e(B" "\e,Tg\e(B" "\e,TM\e(B" "\e,T7\e(B" "\e,TC\e(B" "\e,T4\e(B" "\e,TK\e(B" "\e,T5\e(B" ; p .. w
+ "\e,T;\e(B" "\e,Th\e(B" "\e,T:\e(B" "\e,TO\e(B" "\e,Tm\e(B" "\e,TF\e(B" "\e,T%\e(B" 0 ; x .. DEL
+ ])
;;; arch-tag: fed6c468-0616-44b0-88bf-47347bf64825
;;; thai.el ends here
-;;; tibetan.el --- Quail package for inputting Tibetan characters
+;;; tibetan.el --- Quail package for inputting Tibetan characters -*-coding: iso-2022-7bit;-*-
- ;; Copyright (C) 1997, 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ ;; Copyright (C) 1997, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
;; Free Software Foundation, Inc.
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
- ;; 2006, 2007
+ ;; 2006, 2007, 2008
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
;;; uni-input.el --- Hex Unicode input method
- ;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ ;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
;; Free Software Foundation, Inc.
- ;; Copyright (C) 2004, 2005, 2006, 2007
+ ;; Copyright (C) 2004, 2005, 2006, 2007, 2008
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
;; This is not really a Quail method, but uses some Quail functions.
;; There is probably A Better Way.
-;; Compare `ucs-insert', which explicitly inserts a unicoded character
-;; rather than supplying an input method.
+;; You can get a similar effect by using C-q with
+;; `read-quoted-char-radix' set to 16.
+
+;; Note that this only allows you to enter BMP values unless someone
+;; extends it to use variable numbers of digits.
;;; Code:
(require 'quail)
-;; Maybe stolen from Mule-UCS -- I don't remember.
-(define-ccl-program utf-8-ccl-encode
- `(4 (if (r0 < ?\x80)
- ((write r0))
- (if (r0 < #x800)
- ((write ((r0 >> 6) | ?\xC0))
- (write ((r0 & ?\x3F) | ?\x80)))
- (if (r0 < #x10000)
- ((write ((r0 >> 12) | ?\xE0))
- (write (((r0 >> 6) & ?\x3F) | ?\x80))
- (write ((r0 & ?\x3F) | ?\x80)))
- (if (r0 < #x200000)
- ((write ((r0 >> 18) | ?\xF0))
- (write (((r0 >> 12) & ?\x3F) | ?\x80))
- (write (((r0 >> 6) & ?\x3F) | ?\x80))
- (write ((r0 & ?\x3F) | ?\x80)))
- (if (r0 < #x4000000)
- ((write ((r0 >> 24) | ?\xF8))
- (write (((r0 >> 18) & ?\x3F) | ?\x80))
- (write (((r0 >> 12) & ?\x3F) | ?\x80))
- (write (((r0 >> 6) & ?\x3F) | ?\x80))
- (write ((r0 & ?\x3F) | ?\x80)))
- ((write ((r0 >> 30) | ?\xFC))
- (write (((r0 >> 24) & ?\x3F) | ?\x80))
- (write (((r0 >> 18) & ?\x3F) | ?\x80))
- (write (((r0 >> 12) & ?\x3F) | ?\x80))
- (write (((r0 >> 6) & ?\x3F) | ?\x80))
- (write ((r0 & ?\x3F) | ?\x80))))))))))
-
(defun ucs-input-insert-char (char)
(insert char)
(move-overlay quail-overlay (overlay-start quail-overlay) (point)))
(= 1 (length seq))
(setq key (aref seq 0))
(memq key '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9 ?a
- ?b ?c ?d ?e ?f ?A ?B ?C ?D ?E ?F)))
+ ?b ?c ?d ?e ?f ?A ?B ?C ?D ?E ?F)))
(progn
(push key events)
(ucs-input-insert-char key))
(throw 'non-digit (append (reverse events)
(listify-key-sequence seq))))))
(quail-delete-region)
- (let* ((n (string-to-number (apply 'string
- (cdr (nreverse events)))
- 16))
- (c (decode-char 'ucs n)))
- (if c
- (list c)
- ;; The intention of the following code is to insert
- ;; a correct UTF-8 sequence by raw bytes, but
- ;; currently it doesn't work.
- ;; (let ((status (make-vector 9 nil)))
- ;; (aset status 0 n)
- ;; (string-to-list (ccl-execute-on-string
- ;; 'utf-8-ccl-encode status "")))
- (error "Character U+%04X is not yet supported" n)))))
+ (let ((n (string-to-number (apply 'string
+ (cdr (nreverse events)))
+ 16)))
+ (if (characterp n)
+ (list n)))))
(quail-delete-overlays)
(set-buffer-modified-p modified-p)
(run-hooks 'input-method-after-insert-chunk-hook)))))
;;; welsh.el --- Quail package for inputting Welsh characters -*-coding: iso-2022-7bit;-*-
- ;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ ;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
;; Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;;; Commentary:
;; Welsh input following the Yudit map by david@sheetmusic.org.uk.
-;; This is set up to produce utf-8. A Latin-8 version of most of it
-;; is commented-out at the end.
;;; Code:
(quail-define-package
"welsh" "Welsh" "\e$,1!4\e(B" t
- "Welsh postfix input method, using Unicode"
+ "Welsh postfix input method"
nil t nil nil nil nil nil nil nil nil t)
(quail-define-rules
# -*- Makefile -*- for GNU Emacs on the Microsoft W32 API.
# Copyright (C) 2000, 2001, 2002, 2003, 2004,
- # 2005, 2006, 2007 Free Software Foundation, Inc.
+ # 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
#
# This file is part of GNU Emacs.
#
# make-docfile blindly replaces .o with .c anyway. Keep .o in this list
# as it is required by code in doc.c.
#
-obj= dosfns.o msdos.o \
- xterm.o xfns.o xmenu.o xselect.o xrdb.o fringe.o image.o \
- mac.o macterm.o macfns.o macmenu.o fontset.o \
+obj = dosfns.o msdos.o \
+ xterm.o xfns.o xmenu.o xselect.o xrdb.o xsmfns.o fringe.o image.o \
+ mac.o macterm.o macfns.o macmenu.o macselect.o fontset.o \
w32.o w32bdf.o w32console.o w32fns.o w32heap.o w32inevt.o \
w32menu.o w32proc.o w32reg.o w32select.o w32term.o w32xfns.o \
+ font.o w32font.o \
dispnew.o frame.o scroll.o xdisp.o window.o \
- charset.o coding.o category.o ccl.o \
- cm.o term.o xfaces.o \
+ charset.o coding.o category.o ccl.o character.o chartab.o \
+ cm.o term.o terminal.o xfaces.o \
emacs.o keyboard.o macros.o keymap.o sysdep.o \
buffer.o filelock.o insdel.o marker.o \
minibuf.o fileio.o dired.o filemode.o \
#
lispsource = ../lisp/
-MOUSE_SUPPORT = $(lispsource)select.elc $(lispsource)scroll-bar.elc $(lispsource)mouse.elc $(lispsource)tooltip.elc
-WINNT_SUPPORT = $(lispsource)ls-lisp.elc $(lispsource)disp-table.elc $(lispsource)w32-fns.elc $(lispsource)dos-w32.elc $(lispsource)w32-vars.elc
+MOUSE_SUPPORT = \
+ $(lispsource)select.elc \
+ $(lispsource)scroll-bar.elc \
+ $(lispsource)mouse.elc \
+ $(lispsource)tooltip.elc
+WINNT_SUPPORT = \
+ $(lispsource)ls-lisp.elc \
+ $(lispsource)disp-table.elc \
+ $(lispsource)w32-fns.elc \
+ $(lispsource)dos-w32.elc \
+ $(lispsource)w32-vars.elc \
+ $(lispsource)term/w32-win.elc
# lisp files that are loaded up on other platforms
-MSDOS_SUPPORT = $(lispsource)dos-fns.elc $(lispsource)dos-vars.elc $(lispsource)international/ccl.elc $(lispsource)international/codepage.elc
-VMS_SUPPORT = $(lispsource)vmsproc.el $(lispsource)vms-patch.el
+MSDOS_SUPPORT = \
+ $(lispsource)dos-fns.elc \
+ $(lispsource)dos-vars.elc \
+ $(lispsource)international/ccl.elc \
+ $(lispsource)international/codepage.elc
+VMS_SUPPORT = \
+ $(lispsource)vmsproc.el \
+ $(lispsource)vms-patch.el
+TOOLTIP_SUPPORT = $(lispsource)tooltip.elc
+WINDOW_SUPPORT = \
+ $(lispsource)fringe.elc \
+ $(lispsource)image.elc \
+ $(lispsource)international/fontset.elc \
+ $(lispsource)dnd.elc \
+ $(lispsource)tool-bar.elc \
+ $(lispsource)mwheel.elc
lisp1= \
$(lispsource)abbrev.elc \
$(lispsource)buff-menu.elc \
$(lispsource)button.elc \
$(lispsource)emacs-lisp/byte-run.elc \
+ ${lispsource}composite.elc \
$(lispsource)cus-face.elc \
$(lispsource)cus-start.elc \
$(lispsource)custom.elc \
$(lispsource)emacs-lisp/backquote.elc \
$(lispsource)emacs-lisp/lisp-mode.elc \
$(lispsource)emacs-lisp/lisp.elc \
- $(lispsource)facemenu.elc \
- $(MOUSE_SUPPORT) \
+ $(lispsource)env.elc \
$(lispsource)faces.elc \
$(lispsource)files.elc \
- $(lispsource)emacs-lisp/float-sup.elc \
$(lispsource)format.elc \
+ $(lispsource)facemenu.elc \
+ $(MOUSE_SUPPORT) \
+ $(lispsource)emacs-lisp/float-sup.elc \
$(lispsource)frame.elc \
$(lispsource)help.elc \
$(lispsource)indent.elc \
$(lispsource)loaddefs.el \
$(lispsource)bindings.elc \
$(lispsource)emacs-lisp/map-ynp.elc \
- $(lispsource)env.elc \
+ $(lispsource)menu-bar.elc \
$(lispsource)international/mule.elc \
$(lispsource)international/mule-conf.el \
$(lispsource)international/mule-cmds.elc \
$(lispsource)international/characters.elc \
- $(lispsource)international/ucs-tables.elc \
- $(lispsource)international/utf-8.elc \
- $(lispsource)international/utf-16.elc \
- $(lispsource)international/latin-1.el \
- $(lispsource)international/latin-2.el \
- $(lispsource)international/latin-3.el \
- $(lispsource)international/latin-4.el \
- $(lispsource)international/latin-5.el \
- $(lispsource)international/latin-8.el \
- $(lispsource)international/latin-9.el \
- $(lispsource)fringe.elc \
- $(lispsource)image.elc \
- $(lispsource)international/fontset.elc \
- $(lispsource)dnd.elc \
- $(lispsource)mwheel.elc \
- $(lispsource)tool-bar.elc \
+ $(lispsource)international/charprop.el \
$(lispsource)case-table.elc
lisp2 = \
- $(lispsource)language/chinese.elc \
- $(lispsource)language/cyrillic.elc \
- $(lispsource)language/indian.elc \
+ $(lispsource)language/chinese.el \
+ $(lispsource)language/cyrillic.el \
+ $(lispsource)language/indian.el \
$(lispsource)language/devanagari.el \
$(lispsource)language/kannada.el \
$(lispsource)language/malayalam.el \
$(lispsource)language/japanese.el \
$(lispsource)language/korean.el \
$(lispsource)language/lao.el \
+ $(lispsource)language/tai-viet.el \
$(lispsource)language/thai.el \
$(lispsource)language/tibetan.elc \
- $(lispsource)language/vietnamese.elc \
+ $(lispsource)language/vietnamese.el \
$(lispsource)language/misc-lang.el \
$(lispsource)language/utf-8-lang.el \
$(lispsource)language/georgian.el \
- $(lispsource)menu-bar.elc \
$(lispsource)paths.el \
$(lispsource)register.elc \
$(lispsource)replace.elc \
$(lispsource)textmodes/paragraphs.elc \
$(lispsource)textmodes/text-mode.elc \
$(lispsource)emacs-lisp/timer.elc \
- $(lispsource)vc-hooks.elc \
$(lispsource)jka-cmpr-hook.elc \
+ $(lispsource)vc-hooks.elc \
$(lispsource)ediff-hook.elc \
+ $(TOOLTIP_SUPPORT) \
$(VMS_SUPPORT) \
$(MSDOS_SUPPORT) \
$(WINNT_SUPPORT) \
+ $(WINDOW_SUPPORT) \
$(lispsource)widget.elc \
$(lispsource)window.elc \
$(lispsource)version.el
- 2008-01-02 Miles Bader <Miles Bader <miles@gnu.org>>
+ 2008-01-08 Nick Roberts <nickrob@snap.net.nz>
+
+ * progmodes/gdb-ui.el (gdb-var-list-children-1): Put varnum in
+ quotes in case of spaces, e.g. STL containers (not pretty).
+
+ 2008-01-08 Nick Roberts <nickrob@snap.net.nz>
+
+ * progmodes/gdb-ui.el (gud-gdb-command-name): Explain
+ "--annotate=3" option is necessary for the Graphical Interface.
+
+ 2008-01-08 Nick Roberts <nickrob@snap.net.nz>
+
+ * progmodes/hideif.el (hide-ifdef-mode-menu): Put hide-ifdef commands
+ on menu bar.
+
+ 2008-01-08 Michael Albinus <michael.albinus@gmx.de>
+
+ * ffap.el (ffap-read-file-or-url): Let-bind
+ `file-name-handler-alist' due to `rfn-eshadow-update-overlay'.
+
+ 2008-01-08 Sven Joachim <svenjoac@gmx.de>
+
+ * vc-bzr.el: Fix typo in header.
+
+ 2008-01-08 Eli Zaretskii <eliz@gnu.org>
+
+ * Makefile.in (custom-deps, finder-data): Depend on autoloads
+ instead of loaddefs.el.
+
+ 2008-01-08 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * vc-cvs.el (vc-cvs-annotate-time): Don't move backward when text
+ gets inserted out-of-order.
+
+ 2008-01-08 Riccardo Murri <riccardo.murri@gmail.com>
+
+ * vc-bzr.el: Copyright and version headers update.
+ Remove some outdated comments through the whole file.
+ (vc-bzr-program-args): Remove because unused.
+ (vc-bzr-log-switches): New customization option.
+ (vc-bzr-command): Use LC_MESSAGES=C instead of LC_ALL=C. No longer
+ use `vc-bzr-program-args'.
+ (vc-bzr-register): Fix for working with both 22.1 and CVS version of
+ `vc-find-root' (patch by Andreas Hoenen).
+ (vc-bzr-status): Update regex to match latest Bzr output.
+ Remove redundant test.
+ (vc-bzr-init-version): New function.
+ (vc-bzr-unregister): Must not delete file.
+ (vc-bzr-find-version): New function.
+ (vc-bzr-checkout): Argument `rev' is explicit revision only if it's
+ a non-empty string, otherwise take head revision.
+ (vc-bzr-print-log): Pass `vc-bzr-log-switches' to "bzr log".
+ (vc-bzr-diff): Simpler build of the revision spec string.
+ (vc-annotate-convert-time, vc-bzr-annotate-difference):
+ Remove: compatibility hacks for Emacs21, not needed in Emacs 22.
+ (vc-bzr-dir-state): Add code comments. Removed redundant statement.
+ (vc-bzr-dired-state-info): Only provide custom strings for
+ overloaded VC state 'edited; otherwise fallback to
+ `vc-default-dired-state-info'.
+
+ 2008-01-08 Richard Stallman <rms@gnu.org>
+
+ * delsel.el (delete-selection-mode): Doc fix.
+
+ 2008-01-08 Nick Roberts <nickrob@snap.net.nz>
+
+ * progmodes/gud.el (gud-def): Do nothing if gud-running is t.
+ (gud-speedbar-menu-items): Add item for gdb-var-set-format below.
+
+ * progmodes/gdb-ui.el (gdb-var-set-format): Set the output format
+ of watch expressions (only works fully with GDB 6.7 or later).
+
+ 2008-01-08 Dan Nicolaescu <dann@ics.uci.edu>
+
+ * time-stamp.el (time-stamp-time-zone):
+ * whitespace.el (whitespace-check-buffer-leading)
+ (whitespace-check-buffer-trailing)
+ (whitespace-check-buffer-indent)
+ (whitespace-check-buffer-spacetab)
+ (whitespace-check-buffer-ateol):
+ * progmodes/sh-script.el (sh-indentation):
+ * textmodes/ispell.el (ispell-local-pdict):
+ Add safe-local-variable properties.
+
+ 2008-01-08 Michael Albinus <michael.albinus@gmx.de>
+
+ * vc-git.el (vc-git--call): Apply `process-file' instead of
+ `call-process'.
+
+ * net/tramp.el (tramp-remote-process-environment): Add "LC_CTYPE=C".
+ Reported by Pete Forman <pete.forman@westerngeco.com>.
+ (tramp-perl-encode, tramp-perl-decode): Update copyrights.
+ (tramp-handle-process-file): Handle the case where DESTINATION is
+ a consp with t as car.
+ (tramp-wait-for-output): We shall remove exactly what has been
+ find by the search.
+
+ 2008-01-08 Kevin Ryde <user42@zip.com.au>
+
+ * progmodes/compile.el (compilation-error-regexp-alist-alist):
+ For perl, allow "during global destruction" at end. Add entry for
+ two-arg form of the Test module ok() func.
+
+ 2008-01-08 Glenn Morris <rgm@gnu.org>
+
+ * diff-mode.el (diff-end-of-hunk): Don't match empty lines in
+ unified format.
+
+ * mouse.el (mouse-major-mode-menu): Suppress duplicate menus.
+
+ 2008-01-08 Ralf Angeli <angeli@caeruleus.net>
+
+ * textmodes/reftex-toc.el (reftex-make-separate-toc-frame):
+ Simplify selection of frame focusing function.
+
+ 2008-01-08 Michael Olson <mwolson@gnu.org>
+
+ * textmodes/remember.el (remember-region): Fix typo in docstring.
+
+ 2008-01-08 Lennart Borgman <lennart.borgman.073@student.lu.se>
+
+ * textmodes/remember.el (remember): If there is a visible region
+ [that is, the mark is active and transient mark mode is enabled]
+ then use this region for the initial contents of the *Remember*
+ buffer. Use `region-beginning' and `region-end' instead of
+ `point' and `mark'.
+
+ 2008-01-07 Dan Nicolaescu <dann@ics.uci.edu>
+
+ * vc-hg.el (vc-hg-dir-state, vc-hg-dir-status): Pass the dir
+ argument to vc-hg-command.
+ (vc-hg-log-view-mode): Handle the user field better.
+
+ 2008-01-06 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * vc.el (vc-ensure-vc-buffer): Check liveness of vc-parent-buffer.
+
+ 2008-01-06 Dan Nicolaescu <dann@ics.uci.edu>
+
+ * vc.el (vc-status-fileinfo): New defstruct.
+ (vc-status): New defvar
+ (vc-status-insert-headers, vc-status-printer, vc-status)
+ (vc-status-mode-map, vc-status-mode, vc-status-mark-file)
+ (vc-status-unmark-file, vc-status-marked-files): New functions.
+
+ * vc-hg.el (vc-hg-dir-status): New function.
+
+ 2008-01-06 Martin Rudalics <rudalics@gmx.at>
+
+ * cus-edit.el (custom-tool-bar-map): Move initialization of this
+ keymap from here ...
+ (custom-mode): ... to here. Reported by Reiner Steib.
+
+ 2008-01-06 Dan Nicolaescu <dann@ics.uci.edu>
+
+ * obsolete/x-apollo.el: Remove file for unsupported system.
+
+ * term/x-win.el (vendor-specific-keysyms): Remove reference to
+ Apollo.
+
+ * progmodes/gud.el (gud-dgux-p): Remove.
+ (dbx): Remove reference to dgux.
+
+ * progmodes/ps-mode.el (ps-mode-print-function):
+ * ps-print.el (ps-lp-system):
+ * paths.el (rmail-spool-directory):
+ * ls-lisp.el (ls-lisp-emulation):
+ * lpr.el (lpr-lp-system):
+ * dired.el (dired-chown-program): Remove references to dgux.
+
+ 2008-01-05 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * vc.el (vc-process-sentinel): Fix apparent typo.
+ (vc-do-command): Forcefully kill any left over process.
+ Use start-file-process.
+ (vc-annotate-get-time-set-line-props): Check we don't move backward.
+
+ 2008-01-04 Michael Albinus <michael.albinus@gmx.de>
+
+ * net/dbus.el (dbus-list-hash-table)
+ (dbus-name-owner-changed-handler): Replace "signal" by "member".
+ (dbus-check-event): Add serial number to event.
+ (dbus-handle-event): Apply return message if needed.
+ (dbus-event-serial-number): New defun.
+ (dbus-event-service-name, dbus-event-path-name)
+ (dbus-event-interface-name, dbus-event-member-name):
+ Adapt implementation to serial number.
+
+ 2008-01-04 Juanma Barranquero <lekktu@gmail.com>
+
+ * bs.el (bs--get-mode-name): Fix typo in previous change.
+
+ 2008-01-04 Dan Nicolaescu <dann@ics.uci.edu>
+
+ * mouse.el (mouse-popup-menubar): Fix typo.
+
+ * emacs-lisp/bytecomp.el (byte-compile-from-buffer): Move one more
+ form inside with-current-buffer.
+
+ * progmodes/antlr-mode.el (provide): Move to the end of file.
+ (require): Don't require font-lock and compile.
+ (outline-level, imenu-use-markers, imenu-create-index-function):
+ Move declarations to top level.
+ (cond-emacs-xemacs-macfn): Declare for compiler.
+
+ * vc-bzr.el (vc-bzr-root):
+ * vc-arch.el (vc-arch-root): Only set a property if the file is
+ managed by this backend.
+
+ * vc-hg.el (vc-hg-state): Support the new status code for
+ up-to-date.
+
+ 2008-01-04 Tassilo Horn <tassilo@member.fsf.org>
+
+ * doc-view.el (doc-view-scroll-up-or-next-page)
+ (doc-view-scroll-down-or-previous-page): Don't scroll to the
+ top/bottom again when on the first/last page.
+
+ * doc-view.el (doc-view-scroll-up-or-next-page)
+ (doc-view-scroll-down-or-previous-page): Use image-scroll-up and
+ image-scroll-down instead of the non-image equivalents. Don't
+ rely on a signalled condition but switch pages when scrolling
+ doesn't change the vertical position anymore.
+ (doc-view-mode-map): Remap scroll-{up,down} to
+ image-scroll-{up,down}.
+
+ 2008-01-04 Rob Riepel <riepel@networking.Stanford.EDU>
+
+ * emulation/tpu-edt.el (tpu-load-xkeys): Recommend to run the
+ tpu-mapper command rather than load the tpu-mapper package.
+
+ * emulation/tpu-mapper.el (tpu-mapper): New command.
+ Contains all the code previously at top-level.
+
+ 2008-01-04 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * bs.el (bs--sort-by-mode, bs--get-mode-name):
+ * imenu.el (imenu-add-to-menubar):
+ * makesum.el (make-command-summary):
+ * mouse.el (mouse-major-mode-menu, mouse-popup-menubar, mouse-buffer-menu):
+ * msb.el (msb--mode-menu-cond):
+ * calc/calc-embed.el (calc-do-embedded):
+ * emacs-lisp/helper.el (Helper-describe-mode):
+ * mail/emacsbug.el (report-emacs-bug):
+ * progmodes/hideshow.el (hs-grok-mode-type):
+ * textmodes/sgml-mode.el (sgml-mode-facemenu-add-face-function):
+ * textmodes/table.el (*table--cell-describe-mode):
+ Pass mode-name through format-mode-line.
+
+ 2008-01-04 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * progmodes/ada-xref.el (ada-prj-find-prj-file):
+ * progmodes/ada-mode.el (comment-region):
+ * calendar/todo-mode.el (todo-insert-item):
+ * bookmark.el (bookmark-buffer-name): Test major-mode rather than mode-name.
+
+ 2008-01-04 Richard Stallman <rms@gnu.org>
+
+ * emacs-lisp/bytecomp.el (byte-compile-from-buffer):
+ Call byte-compile-warn-about-unresolved-functions outside
+ the with-current-buffer.
+ (byte-compile-insert-header): Use with-current-buffer.
+
+ 2008-01-04 Glenn Morris <rgm@gnu.org>
+
+ * startup.el (fancy-about-screen): Remove reference to deleted
+ `fancy-splash-help-echo' variable.
+
+ * version.el (emacs-copyright): Update to 2008.
+
+ * net/tramp-smb.el (tramp-smb-handle-insert-directory): Use mapc
+ rather than mapcar.
+
+ * progmodes/cc-vars.el (defcustom-c-stylevar): Revert previous
+ change (merge mistake).
+
+ * doc-view.el (doc-view-search-internal): Don't use `incf'.
+
+ * doc-view.el (bookmark-make-cell-function, bookmark-get-filename)
+ (bookmark-get-bookmark-record):
+ * image-mode.el (bookmark-make-cell-function)
+ (bookmark-get-filename, bookmark-get-bookmark-record)
+ (bookmark-get-position):
+ * log-view.el (vc-modify-change-comment):
+ * progmodes/grep.el (find-name-arg): Declare for compiler.
+
+ 2008-01-04 Juanma Barranquero <lekktu@gmail.com>
+
+ * savehist.el (savehist-coding-system): Default to a variant coding
+ system with explicit unix end-of-line conversion, which is safer.
+
+ 2008-01-03 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * ibuf-ext.el (mode-name sorter, ibuffer-mark-by-mode-regexp):
+ * ibuffer.el (mode column): Use format-mode-line.
+
+ * server.el (server-create-window-system-frame): Remove workaround for
+ a bug that has been fixed.
+
+ 2008-01-03 Magnus Henoch <magnus@zemdatav>
+
+ * net/dbus.el (dbus-name-owner-changed-handler):
+ Use dbus-unregister-object instead of dbus-unregister-signal.
+
+ 2008-01-03 Drew Adams <drew.adams@oracle.com>
+
+ * frame.el (frame-geom-value-cons, frame-geom-spec-cons): New fns.
+
+ 2008-01-03 Richard Stallman <rms@gnu.org>
+
+ * replace.el (occur-context-lines): New subroutine,
+ broken out of occur-engine.
+ (occur-engine): Call it.
+
+ 2008-01-03 Alexandre Julliard <julliard@winehq.org>
+
+ * vc-git.el (vc-git--ls-files-state): New function.
+ (vc-git-dir-state): Use it instead of processing the status
+ results here.
+
+ 2008-01-02 Eric S. Raymond <esr@snark.thyrsus.com>
+
+ * progmodes/grep.el (grep-find-ignored-directories):
+ Initialize from the value of vc-directory-exclusion-list.
+
+ * vc-hooks (vc-directory-exclusion-list): Include "_darcs",
+ even though we don't have a back end for darcs yet.
+
+ 2008-01-02 Karl Fogel <kfogel@red-bean.com>
+
+ Change a return type, for greater extensibility. See
+ http://lists.gnu.org/archive/html/emacs-devel/2007-12/msg01077.html
+ and its thread for discussion leading to this change.
+
+ * emacs-cvs/lisp/bookmark.el:
+ (bookmark-jump-noselect): Return an alist instead of a dotted pair.
+ (bookmark-jump, bookmark-jump-other-window, bookmark-insert)
+ (bookmark-bmenu-2-window, bookmark-bmenu-other-window)
+ (bookmark-bmenu-switch-other-window): Adjust accordingly.
+ (bookmark-make-cell-function): Adjust documentation accordingly.
+
+ * emacs-cvs/lisp/image-mode.el
+ (image-bookmark-jump): Adjust return type accordingly; document.
+
+ * emacs-cvs/lisp/doc-view.el
+ (doc-view-bookmark-jump): Adjust return type accordingly; document.
+
+ 2008-01-02 Miles Bader <miles@gnu.org>
* net/rcirc.el (rcirc-log-filename-function): New variable.
(rcirc-log): Use `rcirc-log-filename-function' to generate the
2008-01-01 Dan Nicolaescu <dann@ics.uci.edu>
- * vc-git.el (vc-git-dir-state): Set the vc-backend property. Do
- not disable undo, with-temp-buffer does it by default.
+ * vc-git.el (vc-git-dir-state): Set the vc-backend property.
+ Do not disable undo, with-temp-buffer does it by default.
2008-01-01 Eric S. Raymond <esr@snark.thyrsus.com>
2007-12-31 Tom Tromey <tromey@redhat.com>
- * emacs-lisp/elp.el (elp-results): Use header-line-format for
- header. Move point to the start of the buffer.
+ * emacs-lisp/elp.el (elp-results): Use header-line-format for header.
+ Move point to the start of the buffer.
2007-12-31 Dan Nicolaescu <dann@ics.uci.edu>
2007-12-31 Martin Rudalics <rudalics@gmx.at>
- * man.el (Man-default-man-entry): Make this a defun. Improve
- guessing mechanism and handling of section numbers.
+ * man.el (Man-default-man-entry): Make this a defun.
+ Improve guessing mechanism and handling of section numbers.
2007-12-31 Richard Stallman <rms@gnu.org>
(custom-theme-set-faces): Clear `face-override-spec' property.
Call `face-spec-set' with FOR-DEFFACE.
- * custom.el (custom-theme-recalc-face):
- Simply call `face-spec-recalc'.
+ * custom.el (custom-theme-recalc-face): Simply call `face-spec-recalc'.
* faces.el (face-spec-set): Third arg is now FOR-DEFFACE.
Use of frame as third arg is deprecated.
(vc-compatible-state): New function. Checks whether two states
can be in the same changeset; used with 'edited it can test whether
the next action for a state should be commit.
- (vc-default-dired-format0info): Display 'added state.
+ (vc-default-dired-state-info): Display 'removed state.
(vc-dired-hook): Turn off undo, this is a speed tweak.
* vc-bzr.el (vc-bzr-dir-state): Recognize 'added.
2007-12-29 Jay Belanger <jay.p.belanger@gmail.com>
- * calc/calc-aent.el (math-read-token): Fix misplaced
- parentheses.
+ * calc/calc-aent.el (math-read-token): Fix misplaced parentheses.
* calc/calc-lang.el (calc-yacas-language, calc-maxima-language)
(calc-giac-language, math-yacas-parse-Sum, math-yacas-compose-sum)
* emacs-lisp/find-func.el (find-function-after-hook): Add :type.
- * info.el (Info-clone-buffer): Renamed from Info-clone-buffer-hook.
+ * info.el (Info-clone-buffer): Rename from Info-clone-buffer-hook.
Use changed.
* startup.el (fancy-splash-help-echo): Var deleted.
2007-12-27 Eric S. Raymond <esr@snark.thyrsus.com>
- * vc.el, vc-sccs.el, vc-rcs.el, vc-cs.el, vc-mcvs.el: Put
- new machinery in place to support editing of change comments
+ * vc.el, vc-sccs.el, vc-rcs.el, vc-cs.el, vc-mcvs.el:
+ Put new machinery in place to support editing of change comments
with 'e' in a log-view buffer. Not documented yet as this
only works for SCCS, RCS, and maybe CVS if you have admin
privileges. When we have backend support for Subversion and
(bookmark-jump, bookmark-jump-other-window, bookmark-insert)
(bookmark-bmenu-2-window, bookmark-bmenu-other-window):
Use bookmark-jump-internal.
- (bookmark-make-cell-for-text-file): Renamed from bookmark-make-cell.
+ (bookmark-make-cell-for-text-file): Rename from bookmark-make-cell.
* doc-view.el (doc-view-bookmark-make-cell)
(doc-view-bookmark-jump): New functions.
(yank-pop-change-selection): New option.
(current-kill): Obey it.
- * simple.el (use-region-p): Renamed from `region-active-p'.
+ * simple.el (use-region-p): Rename from `region-active-p'.
(region-active-p): New function.
2007-12-25 David Golden <david.delaharpe.golden@gmail.com> (tiny change)
font-lock when compiling. Always require compile. Relegate remaining
compatibility cruft to XEmacs. Don't require font-lock.
(verilog-version): Remove superfluous concat.
- (dinotrace-unannotate-all, zmacs-activate-region)
- (customize-apropos): No need to define.
+ (dinotrace-unannotate-all, zmacs-activate-region, customize-apropos):
+ No need to define.
(verilog-regexp-opt): On Emacs, just make it an alias for regexp-opt.
(verilog-font-lock-keywords, verilog-font-lock-keywords-1)
(verilog-font-lock-keywords-2, verilog-font-lock-keywords-3)
(reporter-submit-bug-report): Autoload it.
(verilog-mark-defun): Call zmacs-activate-region only if bound.
(verilog-font-customize): Call customize-apropos only if bound.
- (verilog-getopt-flags, verilog-auto-reeval-locals): Use
- make-local-variable rather than make-variable-buffer-local.
+ (verilog-getopt-flags, verilog-auto-reeval-locals):
+ Use make-local-variable rather than make-variable-buffer-local.
(verilog-company, verilog-project, verilog-modi-cache-list):
Move make-variable-buffer-local calls to top-level.
(font-lock-defaults-alist): Don't define it.
(verilog-need-fld): Remove.
(verilog-font-lock-init): Don't set font-lock-defaults-alist.
- (verilog-mode): Only call make-local-hook on XEmacs. Set
- font-lock-defaults rather than using verilog-font-lock-init.
+ (verilog-mode): Only call make-local-hook on XEmacs.
+ Set font-lock-defaults rather than using verilog-font-lock-init.
2007-12-17 Andreas Schwab <schwab@suse.de>
(verilog-re-search-backward, verilog-re-search-forward-quick)
(verilog-re-search-backward-quick, verilog-get-beg-of-line)
(verilog-get-end-of-line, verilog-within-string): Move definitions
- before first use. No code changes.
+ before first use. No code changes.
2007-12-08 Dan Nicolaescu <dann@ics.uci.edu>
(verilog-declaration-prefix-re, verilog-declaration-re)
(verilog-end-of-statement, verilog-indent-declaration)
(verilog-get-lineup-indent): Remove trailing whitespace.
- (verilog-mode): Fix autoload cookie. Set
- beginning-of-defun-function and end-of-defun-function. Use when
+ (verilog-mode): Fix autoload cookie.
+ Set beginning-of-defun-function and end-of-defun-function. Use when
instead of if.
(verilog-emacs-features, verilog-auto-ascii-enum)
(verilog-insert-indices): Escape braces in doc strings.
- 2007-12-08 Michael McNamara <mac@verilog.com>
- Wilson Snyder <wsnyder@wsnyder.org>
+ 2007-12-08 Michael McNamara <mac@verilog.com>
+ Wilson Snyder <wsnyder@wsnyder.org>
* progmodes/verilog-mode.el: New file.
2007-12-08 Eli Zaretskii <eliz@fencepost.gnu.org>
- * international/latexenc.el (latexenc-find-file-coding-system): If
- both coding-system-for-write and buffer-file-coding-system of
+ * international/latexenc.el (latexenc-find-file-coding-system):
+ If both coding-system-for-write and buffer-file-coding-system of
latex-main-file are nil, use `undecided'.
2007-12-06 Jason Rumney <jasonr@gnu.org>
2007-12-04 Michael Albinus <michael.albinus@gmx.de>
* net/dbus.el (dbus-hash-table=): New defun.
- (dbus-hash-table-test) New hash table test function, used in
+ (dbus-hash-table-test): New hash table test function, used in
`dbus-registered-functions-table'.
(dbus-check-event, dbus-handle-event, dbus-event-bus-name)
(dbus-event-service-name, dbus-event-path-name)
* international/characters.el: Undo unwanted and unexplained change.
-2007-10-10 Vinicius Jose Latorre <viniciusjl@ig.com.br>
-
- * ps-print.el: Fix the usage of :foreground and :background face
- attributes. Reported by Nikolaj Schumacher <n_schumacher@web.de>.
- (ps-print-version): New version 6.7.6.
- (ps-face-attributes, ps-face-attribute-list, ps-face-background):
- Fix code.
- (ps-face-foreground-color-p, ps-face-background-color-p)
- (ps-face-color-p): New inline funs.
-
2007-10-10 Carsten Dominik <dominik@science.uva.nl>
* textmodes/org.el (org-additional-option-like-keywords): New constant.
2007-10-08 Jason Rumney <jasonr@gnu.org>
- * frame.el (focus-follows-mouse): Doc-fix. Change default on w32.
+ * frame.el (focus-follows-mouse): Doc-fix. Change default on w32.
2007-10-08 Richard Stallman <rms@gnu.org>
* server.el (server-start, server-unload-hook):
suspend-tty-functions has been renamed to suspend-tty-hook.
- * xt-mouse.el: Likewise. resume-tty-functions has been renamed to
+ * xt-mouse.el: Likewise. resume-tty-functions has been renamed to
resume-tty-hook.
2007-09-03 Emanuele Giaquinta <e.giaquinta@glauco.it> (tiny change)
* calc/calc.el (calc-language-alist): Add texinfo-mode.
-2007-08-16 Vinicius Jose Latorre <viniciusjl@ig.com.br>
-
- * ps-print.el (ps-header-font-size, ps-header-title-font-size)
- (ps-footer-font-size, ps-line-number-font-size, ps-line-spacing)
- (ps-paragraph-spacing): Docstring fix.
-
-2007-08-16 Glenn Morris <rgm@gnu.org>
-
- * ps-print.el (ps-font-size): Doc fix.
-
2007-08-16 Richard Stallman <rms@gnu.org>
* emacs-lisp/copyright.el (copyright-names-regexp): Add custom group.
(tex-font-script-display, tex-font-lock-suscript): Change from a cons
cell to a list of 2 elements to simplify the unfontify code.
-2007-08-08 Vinicius Jose Latorre <viniciusjl@ig.com.br>
-
- * ps-print.el (ps-default-fg, ps-default-bg): Docstring fix.
- (ps-begin-job): Use ps-default-fg and ps-default-bg only when
- ps-print-color-p is neither nil nor black-white. Reported by Christian
- Schlauer <cs-muelleimer-rubbish.bin@arcor.de>.
-
2007-08-08 Andreas Schwab <schwab@suse.de>
* mail/mailabbrev.el (sendmail-pre-abbrev-expand-hook): Check for
format-mode-line because it may be a list,
e.g., (sgml-xml-mode "XML" "SGML"), and not a string.
-2007-08-06 Vinicius Jose Latorre <viniciusig@ig.com.br>
-
- * printing.el (pr-update-menus): Docstring fix.
-
2007-08-06 Jason Rumney <jasonr@gnu.org>
* menu-bar.el (menu-bar-vc-filter): Use vc-call-backend.
* calc/calc-nlfit.el (math-nlfit-curve): Remove unnecessary variables.
(math-nlfit-givens): Let bind free variables.
-2007-08-05 Vinicius Jose Latorre <viniciusig@ig.com.br>
-
- * printing.el: Require lpr and ps-print when loading printing package.
- Reported by Glenn Morris <rgm@gnu.org>.
-
2007-08-05 Michael Albinus <michael.albinus@gmx.de>
* files.el (set-auto-mode): Handle also remote files wrt
may match up to 4 lines.
(diff-beginning-of-file-and-junk): Rewrite.
-2007-08-03 Vinicius Jose Latorre <viniciusjl@ig.com.br>
-
- * printing.el: Evaluate require only during compilation.
- (pr-version): New version 6.9.1.
- (deactivate-mark): Replace (defvar VAR nil) by (defvar VAR).
- (pr-global-menubar): Fix code.
-
2007-08-03 Dan Nicolaescu <dann@ics.uci.edu>
* term.el (term-erase-in-display): Fix case when point is not at
* vc-git.el (vc-git-revision-table)
(vc-git-revision-completion-table): New functions.
-2007-07-26 Vinicius Jose Latorre <viniciusjl@ig.com.br>
-
- * progmodes/ebnf-abn.el (ebnf-abn-skip-comment):
- * progmodes/ebnf-bnf.el (ebnf-bnf-skip-comment):
- * progmodes/ebnf-dtd.el (ebnf-dtd-skip-comment):
- * progmodes/ebnf-ebx.el (ebnf-ebx-skip-comment):
- * progmodes/ebnf-iso.el (ebnf-iso-skip-comment):
- * progmodes/ebnf-yac.el (ebnf-yac-skip-comment): New version.
- New command actions for EPS header and EPS footer.
-
- * progmodes/ebnf2ps.el: New command actions for EPS header and EPS
- footer. Fix some problems with one-or-more, zero-or-more and
- alternative constructions generation. Some log messages
- implementation. Doc fix.
- (ebnf-version): New version 4.4.
- (ebnf-eps-header-font, ebnf-eps-header, ebnf-eps-footer-font)
- (ebnf-eps-footer, ebnf-log): New options.
- (ebnf-find-style, ebnf-eps-header-footer, ebnf-eps-header)
- (ebnf-eps-footer, ebnf-eps-string, ebnf-eps-header-footer-comment)
- (ebnf-eps-header-footer-p, ebnf-eps-header-comment)
- (ebnf-eps-footer-comment, ebnf-eps-header-footer-file)
- (ebnf-eps-header-footer-set, ebnf-log-header, ebnf-log): New funs.
- (ebnf-style-custom-list, ebnf-style-database): Put new values.
- (ebnf-print-directory, ebnf-print-file, ebnf-print-buffer)
- (ebnf-print-region, ebnf-spool-directory, ebnf-spool-file)
- (ebnf-spool-buffer, ebnf-spool-region, ebnf-eps-directory)
- (ebnf-eps-file, ebnf-eps-buffer, ebnf-eps-region)
- (ebnf-syntax-directory, ebnf-syntax-file, ebnf-syntax-buffer)
- (ebnf-syntax-region, ebnf-parse-and-sort, ebnf-begin-job)
- (ebnf-dimensions, ebnf-production-dimension, ebnf-terminal-dimension)
- (ebnf-non-terminal-dimension, ebnf-special-dimension)
- (ebnf-terminal-dimension1, ebnf-repeat-dimension)
- (ebnf-except-dimension, ebnf-alternative-dimension)
- (ebnf-optional-dimension, ebnf-one-or-more-dimension)
- (ebnf-zero-or-more-dimension, ebnf-sequence-dimension): Insert log
- message fun.
- (ebnf-setup, ebnf-generate-one-or-more, ebnf-generate-zero-or-more)
- (ebnf-begin-job, ebnf-begin-file, ebnf-eps-finish-and-write)
- (ebnf-insert-ebnf-prologue, ebnf-production-dimension)
- (ebnf-terminal-dimension1, ebnf-alternative-dimension)
- (ebnf-one-or-more-dimension, ebnf-zero-or-more-dimension)
- (ebnf-eps-add-context, ebnf-eps-add-production): Fix code.
- (ebnf-eps-filename, ebnf-trim-right): Replace `?\s' by `?\ ' to keep
- compatibility with Emacs 20 & 21.
- (ebnf-eps-header-comment, ebnf-eps-footer-comment)
- (ebnf-eps-file-alist, ebnf-basic-width-extra)
- (ebnf-basic-empty-height): New vars.
- (ebnf-prologue): Fix PostScript code.
- (ebnf-make-empty, ebnf-make-terminal1, ebnf-make-or-more1)
- (ebnf-make-production, ebnf-make-alternative, ebnf-make-optional)
- (ebnf-make-except, ebnf-make-repeat, ebnf-make-sequence)
- (ebnf-make-dup-sequence, ebnf-token-alternative): Add comments.
-
2007-07-25 Glenn Morris <rgm@gnu.org>
* Relicense all FSF files to GPLv3 or later.
* vc-git.el (vc-git-log-view-mode): Port to the multi-file vc interface.
(vc-git-create-snapshot, vc-git-retrieve-snapshot): New functions.
-2007-07-25 Vinicius Jose Latorre <viniciusjl@ig.com.br>
-
- * ps-print.el (ps-multibyte-buffer): Docstring fix.
-
- * ps-mule.el: Doc fix.
- (ps-multibyte-buffer, ps-mule-font-info-database-default)
- (ps-mule-external-libraries, ps-mule-begin-job): Docstring fix.
-
2007-07-25 Glenn Morris <rgm@gnu.org>
* calendar/cal-tex.el (cal-tex-which-days, cal-tex-holidays)
* vc-hg.el (vc-hg-diff): Use vc-hg-command.
-2007-07-20 Vinicius Jose Latorre <viniciusjl@ig.com.br>
-
- * ps-print.el: Problem with foreground and background color when
- printing a buffer with and without faces. Reported by Christian
- Schlauer <cs-muelleimer-rubbish.bin@arcor.de>.
- (ps-print-version): New version 6.7.5.
- (ps-default-fg): Change default value to nil, so black color is used
- when a face does not specify a foreground color.
- (ps-default-bg): Change default value to nil, so white color is used
- for background color.
- (ps-begin-job): Fix code.
-
2007-07-20 Eli Zaretskii <eliz@gnu.org>
* makefile.w32-in (install-lisp-SH): Don't create subdirectories
* vc.el (revision-granularity, create-repo): Document new vc
backend properties.
- (vc-rollback): Renamed from vc-cancel-version. Update
- references. Pass a list instead of a file.
- (vc-revert): Renamed from vc-revert-buffer. Update references.
+ (vc-rollback): Renamed from vc-cancel-version. Update references.
+ Pass a list instead of a file.
+ (vc-revert): Renamed from vc-revert-buffer. Update references.
(vc-delistify, vc-expand-dirs): New functions.
(vc-do-command): Rename FILE to FILE-OR-LIST and deal with a list
of files instead of a single file.
(vc-workfile-version): Update docstring.
(vc-menu-map): Use vc-rollback instead of vc-cancel-version and
vc-revert instead of vc-revert-buffer.
- (vc-prefix-map): Likewise. Bind vc-update.
+ (vc-prefix-map): Likewise. Bind vc-update.
* vc-svn.el (vc-svn-revision-granularity, vc-svn-create-repo)
(vc-svn-wash-log): New functions.
(vc-rcs-wash-log): New functions.
(vc-rcs-register, vc-rcs-checkin, vc-rcs-diff, vc-rcs-print-log):
Deal with a list of files, not a single file.
- (vc-rcs-rollback): Likewise. Rename from vc-rcs-cancel-version.
+ (vc-rcs-rollback): Likewise. Rename from vc-rcs-cancel-version.
* vc-sccs.el (vc-sccs-revision-granularity, vc-sccs-wash-log): New
functions.
a single file.
(vc-cvs-print-log, vc-cvs-command): Rename FILE to FILES to denote
that it is a file list, not a single file.
- (vc-cvs-diff): Likewise. Simplify.
+ (vc-cvs-diff): Likewise. Simplify.
* vc-arch.el (vc-arch-register, vc-arch-checkin, vc-arch-diff):
Deal with a list of files, not a single file.
* vc-bzr.el (vc-bzr-register, vc-bzr-command, vc-bzr-checkin)
(vc-bzr-print-log): Update FILE parameter name to denote that it
is a file list, not a single file.
- (vc-bzr-diff): Likewise. Use the car of files.
+ (vc-bzr-diff): Likewise. Use the car of files.
2007-07-18 Juanma Barranquero <lekktu@gmail.com>
for start and end positions.
(ispell-word): Assume END is a marker.
-2007-05-17 Vinicius Jose Latorre <viniciusjl@ig.com.br>
-
- * printing.el: Group together all XEmacs/Emacs definitions.
- (pr-version): New version 6.9.
- (pr-global-menubar, pr-menu-char-height, pr-menu-char-width): New funs.
- (pr-menu-char-height, pr-menu-char-width): Fix initialization code.
- (pr-menu-bind): Fix code.
- (pr-e-frame-char-height, pr-e-frame-char-width)
- (pr-e-mouse-pixel-position, pr-x-add-submenu, pr-x-event-function)
- (pr-x-event-object, pr-x-find-menu-item, pr-x-font-height)
- (pr-x-font-width, pr-x-get-popup-menu-response, pr-x-make-event)
- (pr-x-misc-user-event-p, pr-x-relabel-menu-item, pr-x-event-x-pixel)
- (pr-x-event-y-pixel): Aliases eliminated.
- (pr-xemacs-global-menubar): Macro moved.
- (current-menubar, current-mouse-event, zmacs-region-stays)
- (deactivate-mark, pr-menu-position, pr-menu-state, pr-ps-name-old)
- (pr-txt-name-old, pr-ps-utility-old, pr-even-or-odd-old, pr-temp-menu):
- Vars moved.
- (pr-region-active-p, pr-menu-position, pr-menu-lookup, pr-menu-lock)
- (pr-update-mode-line, pr-do-update-menus, pr-menu-alist)
- (pr-relabel-menu-item, pr-menu-set-ps-title, pr-menu-set-txt-title)
- (pr-menu-set-utility-title, pr-even-or-odd-pages)
- (pr-f-set-keymap-parents, pr-f-set-keymap-name, pr-f-read-string)
- (pr-keep-region-active, pr-menu-get-item, pr-menu-set-item-name): Funs
- moved.
-
2007-05-17 Christian Plate <cplate@web.de> (tiny change)
* textmodes/sgml-mode.el (sgml-tag):
* files.el (mode-require-final-newline, require-final-newline)
(enable-local-variables, enable-local-eval): Doc fixes.
-2007-05-13 Vinicius Jose Latorre <viniciusjl@ig.com.br>
-
- * ps-print.el: Use default color when foreground or background color
- are unspecified. Reported by Leo <sdl.web@gmail.com>.
- (ps-print-version): New version 6.7.4.
- (ps-rgb-color): New argument. Use default color when color is
- unspecified.
- (ps-begin-job): Fix code.
-
2007-05-12 Chong Yidong <cyd@stupidchicken.com>
* longlines.el (longlines-mode): Make longlines-auto-wrap
;; add-log-time-zone-rule: t
;; End:
- Copyright (C) 2007 Free Software Foundation, Inc.
+ Copyright (C) 2007, 2008 Free Software Foundation, Inc.
This file is part of GNU Emacs.
# Maintenance productions for the Lisp directory
# Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005,
- # 2006, 2007 Free Software Foundation, Inc.
+ # 2006, 2007, 2008 Free Software Foundation, Inc.
# This file is part of GNU Emacs.
finder-inf.el \
subdirs.el \
eshell/esh-groups.el \
- mh-e/mh-loaddefs.el
+ mh-e/mh-loaddefs.el \
+ international/charprop.el \
+ international/uni-*.el
# Files to compile before others during a bootstrap. This is done to
# speed up the bootstrap process. The CC files are compiled first
# The actual Emacs command run in the targets below.
-emacs = EMACSLOADPATH=$(lisp) $(EMACS) $(EMACSOPT)
+emacs = EMACSLOADPATH=$(lisp) LC_ALL=C $(EMACS) $(EMACSOPT)
# Common command to find subdirectories
$(lisp)/cus-load.el:
touch $@
- custom-deps: $(lisp)/subdirs.el $(lisp)/loaddefs.el $(lisp)/cus-load.el doit
+ # Note that custom-deps and finder-data depend on autoloads rather
+ # than on loaddefs.el, so that autoloads does not run in parallel with
+ # them under "make -j", because that could delete loaddefs.el from
+ # under their feet.
+ custom-deps: $(lisp)/subdirs.el autoloads $(lisp)/cus-load.el doit
wd=$(lisp); $(setwins_almost); \
echo Directories: $$wins; \
- $(emacs) -l cus-dep --eval '(setq generated-custom-dependencies-file "$(lisp)/cus-load.el")' -f custom-make-dependencies $$wins
+ LC_ALL=C $(emacs) -l cus-dep --eval '(setq generated-custom-dependencies-file "$(lisp)/cus-load.el")' -f custom-make-dependencies $$wins
- finder-data: $(lisp)/subdirs.el $(lisp)/loaddefs.el doit
+ finder-data: $(lisp)/subdirs.el autoloads doit
wd=$(lisp); $(setwins_almost); \
echo Directories: $$wins; \
- $(emacs) -l finder --eval '(setq generated-finder-keywords-file "$(lisp)/finder-inf.el")' -f finder-compile-keywords-make-dist $$wins
+ LC_ALL=C $(emacs) -l finder --eval '(setq generated-finder-keywords-file "$(lisp)/finder-inf.el")' -f finder-compile-keywords-make-dist $$wins
$(lisp)/loaddefs.el:
echo ";;; loaddefs.el --- automatically extracted autoloads" >> $@
autoloads: $(lisp)/subdirs.el $(lisp)/loaddefs.el doit
wd=$(lisp); $(setwins_almost); \
echo Directories: $$wins; \
- $(emacs) -l autoload --eval '(setq generated-autoload-file "$(lisp)/loaddefs.el")' -f batch-update-autoloads $$wins
+ LC_ALL=C $(emacs) -l autoload --eval '(setq generated-autoload-file "$(lisp)/loaddefs.el")' -f batch-update-autoloads $$wins
$(lisp)/subdirs.el:
$(MAKE) $(MFLAGS) update-subdirs
# new ones.
recompile: doit mh-autoloads $(lisp)/progmodes/cc-mode.elc
- $(emacs) --eval "(batch-byte-recompile-directory 0)" $(lisp)
+ LC_ALL=C $(emacs) --eval "(batch-byte-recompile-directory 0)" $(lisp)
# CC Mode uses a compile time macro system which causes a compile time
# dependency in cc-mode.elc on the macros in cc-langs.el and the
$(lisp)/mh-e/mh-loaddefs.el: $(lisp)/subdirs.el $(MH_E_SRC)
echo ";;; mh-loaddefs.el --- automatically extracted autoloads" > $@
echo "" >> $@
- echo ";; Copyright (C) 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc." >> $@
+ echo ";; Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc." >> $@
echo ";; Author: Bill Wohler <wohler@newt.com>" >> $@
echo ";; Keywords: mail" >> $@
echo ";;; Commentary:" >> $@
;;; arc-mode.el --- simple editing of archives
;; Copyright (C) 1995, 1997, 1998, 2001, 2002, 2003, 2004,
- ;; 2005, 2006, 2007 Free Software Foundation, Inc.
+ ;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Morten Welinder <terra@gnu.org>
;; Keywords: archives msdog editing major-mode
(make-variable-buffer-local 'archive-subfile-mode)
(put 'archive-subfile-mode 'permanent-local t)
+(defvar archive-file-name-coding-system nil)
+(make-variable-buffer-local 'archive-file-name-coding-system)
+(put 'archive-file-name-coding-system 'permanent-local t)
+
(defvar archive-files nil
"Vector of file descriptors.
Each descriptor is a vector of the form
;; -------------------------------------------------------------------------
;;; Section: Support functions.
+(eval-when-compile
+ (defsubst byte-after (pos)
+ "Like char-after but an eight-bit char is converted to unibyte."
+ (multibyte-char-to-unibyte (char-after pos)))
+ (defsubst insert-unibyte (&rest args)
+ "Like insert but don't make unibyte string and eight-bit char multibyte."
+ (dolist (elt args)
+ (if (integerp elt)
+ (insert (if (< elt 128) elt (decode-char 'eight-bit elt)))
+ (insert (string-to-multibyte elt)))))
+ )
+
(defsubst archive-name (suffix)
(intern (concat "archive-" (symbol-name archive-subtype) "-" suffix)))
(if (stringp str)
(setq len (length str))
(setq str (buffer-substring str (+ str len))))
+ (setq str (string-as-unibyte str))
(let ((result 0)
(i 0))
(while (< i len)
(make-local-variable 'archive-file-list-start)
(make-local-variable 'archive-file-list-end)
(make-local-variable 'archive-file-name-indent)
+ (setq archive-file-name-coding-system
+ (or file-name-coding-system
+ default-file-name-coding-system
+ locale-coding-system))
+ (if default-enable-multibyte-characters
+ (set-buffer-multibyte 'to))
(archive-summarize nil)
(setq buffer-read-only t))))
Optional argument SHUT-UP, if non-nil, means don't print messages
when parsing the archive."
(widen)
- (set-buffer-multibyte nil)
(let ((inhibit-read-only t))
(setq archive-proper-file-start (copy-marker (point-min) t))
(set (make-local-variable 'change-major-mode-hook) 'archive-desummarize)
(string-match file-name-invalid-regexp ename)))
(arcfilename (expand-file-name (concat arcname ":" iname)))
(buffer (get-buffer bufname))
- (just-created nil))
+ (just-created nil)
+ (file-name-coding archive-file-name-coding-system))
(if (and buffer
(string= (buffer-file-name buffer) arcfilename))
nil
(setq archive-superior-buffer archive-buffer)
(add-hook 'write-file-functions 'archive-write-file-member nil t)
(setq archive-subfile-mode descr)
+ (setq archive-file-name-coding-system file-name-coding)
(if (and
(null
(let (;; We may have to encode file name arguement for
;; external programs.
(coding-system-for-write
(and enable-multibyte-characters
- file-name-coding-system))
+ archive-file-name-coding-system))
;; We read an archive member by no-conversion at
;; first, then decode appropriately by calling
;; archive-set-buffer-as-visiting-file later.
(if (aref descr 3)
;; Set the file modes, but make sure we can read it.
(set-file-modes tmpfile (logior ?\400 (aref descr 3))))
- (if enable-multibyte-characters
- (setq ename
- (encode-coding-string ename file-name-coding-system)))
- (let ((exitcode (apply 'call-process
- (car command)
- nil
- nil
- nil
- (append (cdr command) (list archive ename)))))
+ (setq ename
+ (encode-coding-string ename archive-file-name-coding-system))
+ (let* ((coding-system-for-write 'no-conversion)
+ (exitcode (apply 'call-process
+ (car command)
+ nil
+ nil
+ nil
+ (append (cdr command)
+ (list archive ename)))))
(if (equal exitcode 0)
nil
(error "Updating was unsuccessful (%S)" exitcode))))
(if (fboundp func)
(progn
(funcall func
- (if enable-multibyte-characters
- (encode-coding-string newname file-name-coding-system)
- newname)
+ (encode-coding-string newname
+ archive-file-name-coding-system)
descr)
(archive-resummarize))
(error "Renaming is not supported for this archive type"))))
(setq archive-files nil)
(let ((revert-buffer-function nil)
(coding-system-for-read 'no-conversion))
- (set-buffer-multibyte nil)
(revert-buffer t t))
(archive-mode)
(goto-char archive-file-list-start)
files
visual)
(while (and (< (+ p 29) (point-max))
- (= (char-after p) ?\C-z)
- (> (char-after (1+ p)) 0))
+ (= (byte-after p) ?\C-z)
+ (> (byte-after (1+ p)) 0))
(let* ((namefld (buffer-substring (+ p 2) (+ p 2 13)))
(fnlen (or (string-match "\0" namefld) 13))
- (efnname (substring namefld 0 fnlen))
+ (efnname (decode-coding-string (substring namefld 0 fnlen)
+ archive-file-name-coding-system))
;; Convert to float to avoid overflow for very large files.
(csize (archive-l-e (+ p 15) 4 'float))
(moddate (archive-l-e (+ p 19) 2))
(save-restriction
(save-excursion
(widen)
- (set-buffer-multibyte nil)
(goto-char (+ archive-proper-file-start (aref descr 4) 2))
(delete-char 13)
- (insert name)))))
+ (insert-unibyte name)))))
;; -------------------------------------------------------------------------
;;; Section: Lzh Archives
visual)
(while (progn (goto-char p) ;beginning of a base header.
(looking-at "\\(.\\|\n\\)\\(.\\|\n\\)-l[hz][0-9ds]-"))
- (let* ((hsize (char-after p)) ;size of the base header (level 0 and 1)
+ (let* ((hsize (byte-after p)) ;size of the base header (level 0 and 1)
;; Convert to float to avoid overflow for very large files.
(csize (archive-l-e (+ p 7) 4 'float)) ;size of a compressed file to follow (level 0 and 2),
;size of extended headers + the compressed file to follow (level 1).
(ucsize (archive-l-e (+ p 11) 4 'float)) ;size of an uncompressed file.
(time1 (archive-l-e (+ p 15) 2)) ;date/time (MSDOS format in level 0, 1 headers
(time2 (archive-l-e (+ p 17) 2)) ;and UNIX format in level 2 header.)
- (hdrlvl (char-after (+ p 20))) ;header level
+ (hdrlvl (byte-after (+ p 20))) ;header level
thsize ;total header size (base + extensions)
fnlen efnname osid fiddle ifnname width p2
neh ;beginning of next extension header (level 1 and 2)
gname uname modtime moddate)
(if (= hdrlvl 3) (error "can't handle lzh level 3 header type"))
(when (or (= hdrlvl 0) (= hdrlvl 1))
- (setq fnlen (char-after (+ p 21))) ;filename length
+ (setq fnlen (byte-after (+ p 21))) ;filename length
(setq efnname (let ((str (buffer-substring (+ p 22) (+ p 22 fnlen)))) ;filename from offset 22
- (if file-name-coding-system
- (decode-coding-string str file-name-coding-system)
- (string-as-multibyte str))))
+ (decode-coding-string
+ str archive-file-name-coding-system)))
(setq p2 (+ p 22 fnlen))) ;
(if (= hdrlvl 1)
(setq neh (+ p2 3)) ;specific to level 1 header
(setq neh (+ p 24)))) ;specific to level 2 header
(if neh ;if level 1 or 2 we expect extension headers to follow
(let* ((ehsize (archive-l-e neh 2)) ;size of the extension header
- (etype (char-after (+ neh 2)))) ;extension type
+ (etype (byte-after (+ neh 2)))) ;extension type
(while (not (= ehsize 0))
(cond
((= etype 1) ;file name
(let ((i (+ neh 3)))
(while (< i (+ neh ehsize))
- (setq efnname (concat efnname (char-to-string (char-after i))))
+ (setq efnname (concat efnname (char-to-string (byte-after i))))
(setq i (1+ i)))))
((= etype 2) ;directory name
(let ((i (+ neh 3)))
(while (< i (+ neh ehsize))
(setq dir (concat dir
- (if (= (char-after i)
+ (if (= (byte-after i)
255)
"/"
(char-to-string
)
(setq neh (+ neh ehsize))
(setq ehsize (archive-l-e neh 2))
- (setq etype (char-after (+ neh 2))))
+ (setq etype (byte-after (+ neh 2))))
;;get total header size for level 1 and 2 headers
(setq thsize (- neh p))))
(if (= hdrlvl 0) ;total header size
(setq p (+ p thsize 2 (round csize)))))
))
(goto-char (point-min))
- (set-buffer-multibyte default-enable-multibyte-characters)
(let ((dash (concat (if archive-alternate-display
"- -------- ----- ----- "
"- ---------- -------- ----------- -------- ")
(let ((sum 0))
(while (> count 0)
(setq count (1- count)
- sum (+ sum (char-after p))
+ sum (+ sum (byte-after p))
p (1+ p)))
(logand sum 255)))
(save-restriction
(save-excursion
(widen)
- (set-buffer-multibyte nil)
(let* ((p (+ archive-proper-file-start (aref descr 4)))
- (oldhsize (char-after p))
- (oldfnlen (char-after (+ p 21)))
+ (oldhsize (byte-after p))
+ (oldfnlen (byte-after (+ p 21)))
(newfnlen (length newname))
(newhsize (+ oldhsize newfnlen (- oldfnlen)))
(inhibit-read-only t))
(error "The file name is too long"))
(goto-char (+ p 21))
(delete-char (1+ oldfnlen))
- (insert newfnlen newname)
+ (insert-unibyte newfnlen newname)
(goto-char p)
(delete-char 2)
- (insert newhsize (archive-lzh-resum p newhsize))))))
+ (insert-unibyte newhsize (archive-lzh-resum p newhsize))))))
(defun archive-lzh-ogm (newval files errtxt ofs)
(save-excursion
(save-restriction
(widen)
- (set-buffer-multibyte nil)
(dolist (fil files)
(let* ((p (+ archive-proper-file-start (aref fil 4)))
- (hsize (char-after p))
- (fnlen (char-after (+ p 21)))
+ (hsize (byte-after p))
+ (fnlen (byte-after (+ p 21)))
(p2 (+ p 22 fnlen))
- (creator (if (>= (- hsize fnlen) 24) (char-after (+ p2 2)) 0))
+ (creator (if (>= (- hsize fnlen) 24) (byte-after (+ p2 2)) 0))
(inhibit-read-only t))
(if (= creator ?U)
(progn
(setq newval (funcall newval (archive-l-e (+ p2 ofs) 2))))
(goto-char (+ p2 ofs))
(delete-char 2)
- (insert (logand newval 255) (lsh newval -8))
+ (insert-unibyte (logand newval 255) (lsh newval -8))
(goto-char (1+ p))
(delete-char 1)
- (insert (archive-lzh-resum (1+ p) hsize)))
+ (insert-unibyte (archive-lzh-resum (1+ p) hsize)))
(message "Member %s does not have %s field"
(aref fil 1) errtxt)))))))
files
visual)
(while (string= "PK\001\002" (buffer-substring p (+ p 4)))
- (let* ((creator (char-after (+ p 5)))
+ (let* ((creator (byte-after (+ p 5)))
;; (method (archive-l-e (+ p 10) 2))
(modtime (archive-l-e (+ p 12) 2))
(moddate (archive-l-e (+ p 14) 2))
(fclen (archive-l-e (+ p 32) 2))
(lheader (archive-l-e (+ p 42) 4))
(efnname (let ((str (buffer-substring (+ p 46) (+ p 46 fnlen))))
- (if file-name-coding-system
- (decode-coding-string str file-name-coding-system)
- (string-as-multibyte str))))
+ (decode-coding-string
+ str archive-file-name-coding-system)))
(isdir (and (= ucsize 0)
(string= (file-name-nondirectory efnname) "")))
(mode (cond ((memq creator '(2 3)) ; Unix + VMS
(logior ?\444
(if isdir (logior 16384 ?\111) 0)
(if (zerop
- (logand 1 (char-after (+ p 38))))
+ (logand 1 (byte-after (+ p 38))))
?\222 0)))
(t nil)))
(modestr (if mode (archive-int-to-mode mode) "??????????"))
(save-restriction
(save-excursion
(widen)
- (set-buffer-multibyte nil)
(dolist (fil files)
(let* ((p (+ archive-proper-file-start (car (aref fil 4))))
- (creator (char-after (+ p 5)))
+ (creator (byte-after (+ p 5)))
(oldmode (aref fil 3))
(newval (archive-calc-mode oldmode newmode t))
(inhibit-read-only t))
(cond ((memq creator '(2 3)) ; Unix + VMS
(goto-char (+ p 40))
(delete-char 2)
- (insert (logand newval 255) (lsh newval -8)))
+ (insert-unibyte (logand newval 255) (lsh newval -8)))
((memq creator '(0 5 6 7 10 11 15)) ; Dos etc.
(goto-char (+ p 38))
- (insert (logior (logand (char-after (point)) 254)
- (logand (logxor 1 (lsh newval -7)) 1)))
+ (insert-unibyte (logior (logand (byte-after (point)) 254)
+ (logand (logxor 1 (lsh newval -7)) 1)))
(delete-char 1))
(t (message "Don't know how to change mode for this member"))))
))))
;; Convert to float to avoid overflow for very large files.
(ucsize (archive-l-e (+ p 20) 4 'float))
(namefld (buffer-substring (+ p 38) (+ p 38 13)))
- (dirtype (char-after (+ p 4)))
- (lfnlen (if (= dirtype 2) (char-after (+ p 56)) 0))
- (ldirlen (if (= dirtype 2) (char-after (+ p 57)) 0))
+ (dirtype (byte-after (+ p 4)))
+ (lfnlen (if (= dirtype 2) (byte-after (+ p 56)) 0))
+ (ldirlen (if (= dirtype 2) (byte-after (+ p 57)) 0))
(fnlen (or (string-match "\0" namefld) 13))
(efnname (let ((str
(concat
(buffer-substring (+ p 58)
(+ p 58 lfnlen -1))
(substring namefld 0 fnlen)))))
- (if file-name-coding-system
- (decode-coding-string str file-name-coding-system)
- (string-as-multibyte str))))
+ (decode-coding-string
+ str archive-file-name-coding-system)))
(fiddle (and (= lfnlen 0) (string= efnname (upcase efnname))))
(ifnname (if fiddle (downcase efnname) efnname))
(width (string-width ifnname))
;;; bindings.el --- define standard key bindings and some variables
;; Copyright (C) 1985, 1986, 1987, 1992, 1993, 1994, 1995, 1996, 1999,
- ;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ ;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: internal
;; that we will not need to keep permanently.
(garbage-collect)
\f
-;; Make all multibyte characters self-insert.
-(let ((l (generic-character-list))
- (table (nth 1 global-map)))
- (while l
- (aset table (car l) 'self-insert-command)
- (setq l (cdr l))))
(setq help-event-list '(help f1))
;;; case-table.el --- code to extend the character set and support case tables
;; Copyright (C) 1988, 1994, 2001, 2002, 2003, 2004,
- ;; 2005, 2006, 2007 Free Software Foundation, Inc.
+ ;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Howard Gayle
;; Maintainer: FSF
;;; Code:
-(defvar set-case-syntax-offset 0)
-
-(defvar set-case-syntax-set-multibyte nil)
-
(defun describe-buffer-case-table ()
"Describe the case table of the current buffer."
(interactive)
(let ((description (make-char-table 'case-table)))
(map-char-table
(function (lambda (key value)
- (aset
- description key
- (cond ((not (natnump value))
- "case-invariant")
- ((/= key (downcase key))
- (concat "uppercase, matches "
- (char-to-string (downcase key))))
- ((/= key (upcase key))
- (concat "lowercase, matches "
- (char-to-string (upcase key))))
- (t "case-invariant")))))
+ (if (consp key)
+ (set-char-table-range description key "case-invariant")
+ (aset
+ description key
+ (cond ((not (natnump value))
+ "case-invariant")
+ ((/= key (downcase key))
+ (concat "uppercase, matches "
+ (char-to-string (downcase key))))
+ ((/= key (upcase key))
+ (concat "lowercase, matches "
+ (char-to-string (upcase key))))
+ (t "case-invariant"))))))
(current-case-table))
(save-excursion
(with-output-to-temp-buffer "*Help*"
(set-char-table-extra-slot copy 2 nil)
copy))
-(defsubst set-case-syntax-1 (char)
- "Offset CHAR by `set-case-syntax-offset' if CHAR is a non-ASCII 8-bit char."
- (if (and (>= char 128) (< char 256))
- (+ char set-case-syntax-offset)
- char))
-
(defun set-case-syntax-delims (l r table)
"Make characters L and R a matching pair of non-case-converting delimiters.
This sets the entries for L and R in TABLE, which is a string
that will be used as the downcase part of a case table.
It also modifies `standard-syntax-table' to
indicate left and right delimiters."
- (setq l (set-case-syntax-1 l))
- (setq r (set-case-syntax-1 r))
(aset table l l)
(aset table r r)
(let ((up (get-upcase-table table)))
that will be used as the downcase part of a case table.
It also modifies `standard-syntax-table' to give them the syntax of
word constituents."
- (setq uc (set-case-syntax-1 uc))
- (setq lc (set-case-syntax-1 lc))
(aset table uc lc)
(aset table lc lc)
(let ((up (get-upcase-table table)))
"Make character UC an upcase of character LC.
It also modifies `standard-syntax-table' to give them the syntax of
word constituents."
- (setq uc (set-case-syntax-1 uc))
- (setq lc (set-case-syntax-1 lc))
(aset table lc lc)
(let ((up (get-upcase-table table)))
(aset up uc uc)
"Make character LC a downcase of character UC.
It also modifies `standard-syntax-table' to give them the syntax of
word constituents."
- (setq uc (set-case-syntax-1 uc))
- (setq lc (set-case-syntax-1 lc))
(aset table uc lc)
(aset table lc lc)
(let ((up (get-upcase-table table)))
that will be used as the downcase part of a case table.
It also modifies `standard-syntax-table'.
SYNTAX should be \" \", \"w\", \".\" or \"_\"."
- (setq c (set-case-syntax-1 c))
(aset table c c)
(let ((up (get-upcase-table table)))
(aset up c c))
;;; composite.el --- support character composition
- ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
+ ;; 2008
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
;;; Code:
-;;;###autoload
(defconst reference-point-alist
'((tl . 0) (tc . 1) (tr . 2)
(Bl . 3) (Bc . 4) (Br . 5)
(mid-left . 3) (mid-center . 10) (mid-right . 5))
"Alist of symbols vs integer codes of glyph reference points.
A glyph reference point symbol is to be used to specify a composition
-rule in COMPONENTS argument to such functions as `compose-region' and
-`make-composition'.
+rule in COMPONENTS argument to such functions as `compose-region'.
Meanings of glyph reference point codes are as follows:
| | new |
| |glyph|
+----+-----+ <--- new descent
-")
+
+A composition rule may have the form \(GLOBAL-REF-POINT
+NEW-REF-POINT XOFF YOFF), where XOFF and YOFF specifies how much
+to shift NEW-REF-POINT from GLOBAL-REF-POINT. In this case, XOFF
+and YOFF are integers in the range -100..100 representing the
+shifting percentage against the font size.")
;;;###autoload
(if (and (integerp rule) (< rule 144))
;; Already encoded.
rule
- (or (consp rule)
- (error "Invalid composition rule: %S" rule))
- (let ((gref (car rule))
- (nref (cdr rule)))
- (or (integerp gref)
- (setq gref (cdr (assq gref reference-point-alist))))
- (or (integerp nref)
- (setq nref (cdr (assq nref reference-point-alist))))
- (or (and (>= gref 0) (< gref 12) (>= nref 0) (< nref 12))
- (error "Invalid composition rule: %S" rule))
- (+ (* gref 12) nref))))
+ (if (consp rule)
+ (let ((gref (car rule))
+ (nref (cdr rule))
+ xoff yoff)
+ (if (consp nref) ; (GREF NREF XOFF YOFF)
+ (progn
+ (setq xoff (nth 1 nref)
+ yoff (nth 2 nref)
+ nref (car nref))
+ (or (and (>= xoff -100) (<= xoff 100)
+ (>= yoff -100) (<= yoff 100))
+ (error "Invalid compostion rule: %s" rule))
+ (setq xoff (+ xoff 128) yoff (+ yoff 128)))
+ ;; (GREF . NREF)
+ (setq xoff 0 yoff 0))
+ (or (integerp gref)
+ (setq gref (cdr (assq gref reference-point-alist))))
+ (or (integerp nref)
+ (setq nref (cdr (assq nref reference-point-alist))))
+ (or (and (>= gref 0) (< gref 12) (>= nref 0) (< nref 12))
+ (error "Invalid composition rule: %S" rule))
+ (logior (lsh xoff 16) (lsh yoff 8) (+ (* gref 12) nref)))
+ (error "Invalid composition rule: %S" rule))))
;; Decode encoded composition rule RULE-CODE. The value is a cons of
;; global and new reference point symbols.
;; defined in composite.h.
(defun decode-composition-rule (rule-code)
- (or (and (natnump rule-code) (< rule-code 144))
+ (or (and (natnump rule-code) (< rule-code #x1000000))
(error "Invalid encoded composition rule: %S" rule-code))
- (let ((gref (car (rassq (/ rule-code 12) reference-point-alist)))
- (nref (car (rassq (% rule-code 12) reference-point-alist))))
+ (let ((xoff (lsh rule-code -16))
+ (yoff (logand (lsh rule-code -8) #xFF))
+ gref nref)
+ (setq rule-code (logand rule-code #xFF)
+ gref (car (rassq (/ rule-code 12) reference-point-alist))
+ nref (car (rassq (% rule-code 12) reference-point-alist)))
(or (and gref (symbolp gref) nref (symbolp nref))
(error "Invalid composition rule code: %S" rule-code))
- (cons gref nref)))
+ (if (and (= xoff 0) (= yoff 0))
+ (cons gref nref)
+ (setq xoff (- xoff 128) yoff (- yoff 128))
+ (list gref xoff yoff nref))))
;; Encode composition rules in composition components COMPONENTS. The
;; value is a copy of COMPONENTS, where composition rules (cons of
(setq i (+ i 2))))
components)
-;;;###autoload
(defun compose-region (start end &optional components modification-func)
"Compose characters in the current region.
First two arguments START and END are positions (integers or markers)
specifying the region.
-Optional 3rd argument COMPONENTS, if non-nil, is a character or a
-sequence (vector, list, or string) of integers. In this case,
-characters are composed not relatively but according to COMPONENTS.
+Optional 3rd argument COMPONENTS, if non-nil, is a character, a string
+or a vector or list of integers and rules.
If it is a character, it is an alternate character to display instead
of the text in the region.
(compose-region-internal start end components modification-func)
(restore-buffer-modified-p modified-p)))
-;;;###autoload
(defun decompose-region (start end)
"Decompose text in the current region.
(remove-text-properties start end '(composition nil))
(restore-buffer-modified-p modified-p)))
-;;;###autoload
(defun compose-string (string &optional start end components modification-func)
"Compose characters in string STRING.
-The return value is STRING where `composition' property is put on all
+The return value is STRING with the `composition' property put on all
the characters in it.
Optional 2nd and 3rd arguments START and END specify the range of
(compose-string-internal string start end components modification-func)
string)
-;;;###autoload
(defun decompose-string (string)
"Return STRING where `composition' property is removed."
(remove-text-properties 0 (length string) '(composition nil) string)
string)
-;;;###autoload
(defun compose-chars (&rest args)
"Return a string from arguments in which all characters are composed.
For relative composition, arguments are characters.
(setq str (concat args)))
(compose-string-internal str 0 (length str) components)))
-;;;###autoload
(defun find-composition (pos &optional limit string detail-p)
"Return information about a composition at or nearest to buffer position POS.
result))
\f
-;;;###autoload
(defun compose-chars-after (pos &optional limit object)
"Compose characters in current buffer after position POS.
Optional 2nd arg LIMIT, if non-nil, limits the matching of text.
Optional 3rd arg OBJECT, if non-nil, is a string that contains the
-text to compose. In that case, POS and LIMIT index to the string.
+text to compose. In that case, POS and LIMIT index into the string.
This function is the default value of `compose-chars-after-function'."
(let ((tail (aref composition-function-table (char-after pos)))
(setq func nil tail (cdr tail)))))))
result))
-;;;###autoload
(defun compose-last-chars (args)
"Compose last characters.
The argument is a parameterized event of the form
(compose-region (- (point) chars) (point) (nth 2 args))
(compose-chars-after (- (point) chars) (point))))))
-;;;###autoload(global-set-key [compose-last-chars] 'compose-last-chars)
+(global-set-key [compose-last-chars] 'compose-last-chars)
+
+\f
+;;; Automatic character composition.
+
+(defvar composition-function-table
+ (make-char-table nil)
+ "Char table of functions for automatic character composition.
+For each character that has to be composed automatically with
+preceding and/or following characters, this char table contains
+a function to call to compose that character.
+
+An element, if non-nil, is FUNC or an alist of PATTERNs vs FUNCs,
+where PATTERNs are regular expressions and FUNCs are functions.
+If the element is FUNC, FUNC itself determines the region to
+compose.
+
+Each function is called with 5 arguments, FROM, TO, FONT-OBJECT,
+and STRING.
+
+If STRING is nil, FROM and TO are positions specifying the region
+maching with PATTERN in the current buffer, and the function has
+to compose character in that region (possibly with characters
+preceding FROM). The return value of the function is the end
+position where characters are composed.
+
+Otherwise, STRING is a string, and FROM and TO are indices into
+the string. In this case, the function has to compose a
+character in the string.
+
+FONT-OBJECT may be nil if not available (e.g. for the case of
+terminal).
+
+See also the command `toggle-auto-composition'.")
+
+;; Copied from font-lock.el.
+(eval-when-compile
+ ;; Borrowed from lazy-lock.el.
+ ;; We use this to preserve or protect things when modifying text properties.
+ (defmacro save-buffer-state (varlist &rest body)
+ "Bind variables according to VARLIST and eval BODY restoring buffer state."
+ `(let* ,(append varlist
+ '((modified (buffer-modified-p)) (buffer-undo-list t)
+ (inhibit-read-only t) (inhibit-point-motion-hooks t)
+ (inhibit-modification-hooks t)
+ deactivate-mark buffer-file-name buffer-file-truename))
+ ,@body
+ (unless modified
+ (restore-buffer-modified-p nil))))
+ ;; Fixme: This makes bootstrapping fail with this error.
+ ;; Symbol's function definition is void: eval-defun
+ ;;(def-edebug-spec save-buffer-state let)
+ )
+
+(put 'save-buffer-state 'lisp-indent-function 1)
+
+(defun terminal-composition-function (from to font-object string)
+ "General composition function used on terminal.
+Non-spacing characters are composed with the preceding spacing
+character. All non-spacing characters has this function in
+`terminal-composition-function-table'."
+ (let ((pos (1+ from)))
+ (if string
+ (progn
+ (while (and (< pos to)
+ (= (aref char-width-table (aref string pos)) 0))
+ (setq pos (1+ pos)))
+ (if (> from 0)
+ (compose-string string (1- from) pos)
+ (compose-string string from pos
+ (concat " " (buffer-substring from pos)))))
+ (while (and (< pos to)
+ (= (aref char-width-table (char-after pos)) 0))
+ (setq pos (1+ pos)))
+ (if (> from (point-min))
+ (compose-region (1- from) pos (buffer-substring from pos))
+ (compose-region from pos
+ (concat " " (buffer-substring from pos)))))
+ pos))
+
+(defvar terminal-composition-function-table
+ (let ((table (make-char-table nil)))
+ (map-char-table
+ #'(lambda (key val)
+ (if (= val 0) (set-char-table-range table key
+ 'terminal-composition-function)))
+ char-width-table)
+ table)
+ "Char table of functions for automatic character composition on terminal.
+This is like `composition-function-table' but used when Emacs is running
+on a terminal.")
+
+(defun auto-compose-chars (from to window string)
+ "Compose characters in the region between FROM and TO.
+WINDOW is a window displaying the current buffer.
+If STRING is non-nil, it is a string, and FROM and TO are indices
+into the string. In that case, compose characters in the string.
+
+This function is the default value of `auto-composition-function' (which see)."
+ (save-buffer-state nil
+ (save-excursion
+ (save-restriction
+ (save-match-data
+ (let ((table (if (display-graphic-p)
+ composition-function-table
+ terminal-composition-function-table))
+ (start from))
+ (setq to (or (text-property-any (1+ from) to 'auto-composed t
+ string)
+ to))
+ (if string
+ (while (< from to)
+ (let* ((ch (aref string from))
+ (elt (aref table ch))
+ font-obj newpos)
+ (when elt
+ (if window
+ (setq font-obj (font-at from window string)))
+ (if (functionp elt)
+ (setq newpos (funcall elt from to font-obj string))
+ (while (and elt
+ (or (not (eq (string-match (caar elt) string
+ from)
+ from))
+ (not (setq newpos
+ (funcall (cdar elt) from
+ (match-end 0)
+ font-obj string)))))
+ (setq elt (cdr elt)))))
+ (if (and newpos (> newpos from))
+ (setq from newpos)
+ (setq from (1+ from)))))
+ (narrow-to-region from to)
+ (while (< from to)
+ (let* ((ch (char-after from))
+ (elt (aref table ch))
+ func pattern font-obj newpos)
+ (when elt
+ (if window
+ (setq font-obj (font-at from window)))
+ (if (functionp elt)
+ (setq newpos (funcall elt from to font-obj nil))
+ (goto-char from)
+ (while (and elt
+ (or (not (looking-at (caar elt)))
+ (not (setq newpos
+ (funcall (cdar elt) from
+ (match-end 0)
+ font-obj nil)))))
+ (setq elt (cdr elt)))))
+ (if (and newpos (> newpos from))
+ (setq from newpos)
+ (setq from (1+ from))))))
+ (put-text-property start to 'auto-composed t string)))))))
+
+(make-variable-buffer-local 'auto-composition-function)
+
+;;;###autoload
+(define-minor-mode auto-composition-mode
+ "Toggle Auto Compostion mode.
+With arg, turn Auto Compostion mode off if and only if arg is a non-positive
+number; if arg is nil, toggle Auto Compostion mode; anything else turns Auto
+Compostion on.
+
+When Auto Composition is enabled, text characters are automatically composed
+by functions registered in `composition-function-table' (which see).
+
+You can use Global Auto Composition mode to automagically turn on
+Auto Composition mode in all buffers (this is the default)."
+ nil nil nil
+ (if noninteractive
+ (setq auto-composition-mode nil))
+ (cond (auto-composition-mode
+ (add-hook 'after-change-functions 'auto-composition-after-change nil t)
+ (setq auto-composition-function 'auto-compose-chars))
+ (t
+ (remove-hook 'after-change-functions 'auto-composition-after-change t)
+ (setq auto-composition-function nil)))
+ (save-buffer-state nil
+ (save-restriction
+ (widen)
+ (remove-text-properties (point-min) (point-max) '(auto-composed nil))
+ (decompose-region (point-min) (point-max)))))
+
+(defun auto-composition-after-change (start end old-len)
+ (save-buffer-state nil
+ (if (< start (point-min))
+ (setq start (point-min)))
+ (if (> end (point-max))
+ (setq end (point-max)))
+ (when (and auto-composition-mode (not memory-full))
+ (let (func1 func2)
+ (when (and (> start (point-min))
+ (setq func2 (aref composition-function-table
+ (char-after (1- start))))
+ (or (= start (point-max))
+ (not (setq func1 (aref composition-function-table
+ (char-after start))))
+ (eq func1 func2)))
+ (setq start (1- start)
+ func1 func2)
+ (while (eq func1 func2)
+ (if (> start (point-min))
+ (setq start (1- start)
+ func2 (aref composition-function-table
+ (char-after start)))
+ (setq func2 nil))))
+ (when (and (< end (point-max))
+ (setq func2 (aref composition-function-table
+ (char-after end)))
+ (or (= end (point-min))
+ (not (setq func1 (aref composition-function-table
+ (char-after (1- end)))))
+ (eq func1 func2)))
+ (setq end (1+ end)
+ func1 func2)
+ (while (eq func1 func2)
+ (if (< end (point-max))
+ (setq func2 (aref composition-function-table
+ (char-after end))
+ end (1+ end))
+ (setq func2 nil))))
+ (if (< start end)
+ (remove-text-properties start end '(auto-composed nil)))))))
+
+(defun turn-on-auto-composition-if-enabled ()
+ (if enable-multibyte-characters
+ (auto-composition-mode 1)))
+
+;;;###autoload
+(define-global-minor-mode global-auto-composition-mode
+ auto-composition-mode turn-on-auto-composition-if-enabled
+ :extra-args (dummy)
+ :initialize 'custom-initialize-safe-default
+ :init-value (not noninteractive)
+ :group 'auto-composition
+ :version "23.1")
+
+(defun toggle-auto-composition (&optional arg)
+ "Change whether automatic character composition is enabled in this buffer.
+With arg, enable it iff arg is positive."
+ (interactive "P")
+ (let ((enable (if (null arg) (not auto-composition-function)
+ (> (prefix-numeric-value arg) 0))))
+ (if enable
+ (kill-local-variable 'auto-composition-function)
+ (make-local-variable 'auto-composition-function)
+ (setq auto-composition-function nil)
+ (save-buffer-state nil
+ (save-restriction
+ (widen)
+ (decompose-region (point-min) (point-max)))))
+
+ (save-buffer-state nil
+ (save-restriction
+ (widen)
+ (remove-text-properties (point-min) (point-max)
+ '(auto-composed nil))))))
+
+(defun auto-compose-region (from to)
+ "Force automatic character composition on the region FROM and TO."
+ (save-excursion
+ (if (get-text-property from 'auto-composed)
+ (setq from (next-single-property-change from 'auto-composed nil to)))
+ (goto-char from)
+ (let ((modified-p (buffer-modified-p))
+ (inhibit-read-only '(composition auto-composed))
+ (stop (next-single-property-change (point) 'auto-composed nil to)))
+ (while (< (point) to)
+ (if (= (point) stop)
+ (progn
+ (goto-char (next-single-property-change (point)
+ 'auto-composed nil to))
+ (setq stop (next-single-property-change (point)
+ 'auto-composed nil to)))
+ (let ((func (aref composition-function-table (following-char)))
+ (pos (point)))
+ (if (functionp func)
+ (goto-char (funcall func (point) nil)))
+ (if (<= (point) pos)
+ (forward-char 1)))))
+ (put-text-property from to 'auto-composed t)
+ (set-buffer-modified-p modified-p))))
\f
;; The following codes are only for backward compatibility with Emacs
;; 20.4 and earlier.
-;;;###autoload
(defun decompose-composite-char (char &optional type with-composition-rule)
"Convert CHAR to string.
((eq type 'list) (list char))
(t (vector char))))
-;;;###autoload
(make-obsolete 'decompose-composite-char 'char-to-string "21.1")
\f
;;; cus-start.el --- define customization properties of builtins
;;
;; Copyright (C) 1997, 1999, 2000, 2001, 2002, 2003, 2004,
- ;; 2005, 2006, 2007 Free Software Foundation, Inc.
+ ;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: internal
(exec-path execute
(repeat (choice (const :tag "default directory" nil)
(directory :format "%v"))))
+ ;; charset.c
+ (charset-map-path installation
+ (repeat (directory :format "%v")))
;; coding.c
(inhibit-eol-conversion mule boolean)
(eol-mnemonic-undecided mule string)
;;; descr-text.el --- describe text mode
;; Copyright (C) 1994, 1995, 1996, 2001, 2002, 2003, 2004,
- ;; 2005, 2006, 2007 Free Software Foundation, Inc.
+ ;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Boris Goldowsky <boris@gnu.org>
;; Maintainer: FSF
(insert "There are text properties here:\n")
(describe-property-list properties)))))
\f
+(defcustom describe-char-unidata-list nil
+ "List of Unicode-based character property names shown by `describe-char'."
+ :group 'mule
+ :version "23.1"
+ :type '(set
+ (const :tag "Unicode Name" name)
+ (const :tag "Unicode general category " general-category)
+ (const :tag "Unicode canonical combining class"
+ canonical-combining-class)
+ (const :tag "Unicode bidi class" bidi-class)
+ (const :tag "Unicode decomposition mapping" decomposition)
+ (const :tag "Unicode decimal digit value" decimal-digit-value)
+ (const :tag "Unicode digit value" digit-value)
+ (const :tag "Unicode numeric value" numeric-value)
+ (const :tag "Unicode mirrored" mirrored)
+ (const :tag "Unicode old name" old-name)
+ (const :tag "Unicode ISO 10646 comment" iso-10646-comment)
+ (const :tag "Unicode simple uppercase mapping" uppercase)
+ (const :tag "Unicode simple lowercase mapping" lowercase)
+ (const :tag "Unicode simple titlecase mapping" titlecase)))
+
(defcustom describe-char-unicodedata-file nil
"Location of Unicode data file.
This is the UnicodeData.txt file from the Unicode Consortium, used for
(defun describe-char-unicode-data (char)
"Return a list of Unicode data for unicode CHAR.
Each element is a list of a property description and the property value.
-The list is null if CHAR isn't found in `describe-char-unicodedata-file'."
+The list is null if CHAR isn't found in `describe-char-unicodedata-file'.
+This function is semi-obsolete. Use `get-char-code-property'."
(when describe-char-unicodedata-file
(unless (file-exists-p describe-char-unicodedata-file)
(error "`unicodedata-file' %s not found" describe-char-unicodedata-file))
(concat (match-string 1 name) ">")
name)))
(list "Category"
- (cdr (assoc
- (nth 1 fields)
- '(("Lu" . "uppercase letter")
- ("Ll" . "lowercase letter")
- ("Lt" . "titlecase letter")
- ("Mn" . "non-spacing mark")
- ("Mc" . "spacing-combining mark")
- ("Me" . "enclosing mark")
- ("Nd" . "decimal digit")
- ("Nl" . "letter number")
- ("No" . "other number")
- ("Zs" . "space separator")
- ("Zl" . "line separator")
- ("Zp" . "paragraph separator")
- ("Cc" . "other control")
- ("Cf" . "other format")
- ("Cs" . "surrogate")
- ("Co" . "private use")
- ("Cn" . "not assigned")
- ("Lm" . "modifier letter")
- ("Lo" . "other letter")
- ("Pc" . "connector punctuation")
- ("Pd" . "dash punctuation")
- ("Ps" . "open punctuation")
- ("Pe" . "close punctuation")
- ("Pi" . "initial-quotation punctuation")
- ("Pf" . "final-quotation punctuation")
- ("Po" . "other punctuation")
- ("Sm" . "math symbol")
- ("Sc" . "currency symbol")
- ("Sk" . "modifier symbol")
- ("So" . "other symbol")))))
+ (let ((val (nth 1 fields)))
+ (or (char-code-property-description
+ 'general-category (intern val))
+ val)))
(list "Combining class"
- (cdr (assoc
- (string-to-number (nth 2 fields))
- '((0 . "Spacing")
- (1 . "Overlays and interior")
- (7 . "Nuktas")
- (8 . "Hiragana/Katakana voicing marks")
- (9 . "Viramas")
- (10 . "Start of fixed position classes")
- (199 . "End of fixed position classes")
- (200 . "Below left attached")
- (202 . "Below attached")
- (204 . "Below right attached")
- (208 . "Left attached (reordrant around \
-single base character)")
- (210 . "Right attached")
- (212 . "Above left attached")
- (214 . "Above attached")
- (216 . "Above right attached")
- (218 . "Below left")
- (220 . "Below")
- (222 . "Below right")
- (224 . "Left (reordrant around single base \
-character)")
- (226 . "Right")
- (228 . "Above left")
- (230 . "Above")
- (232 . "Above right")
- (233 . "Double below")
- (234 . "Double above")
- (240 . "Below (iota subscript)")))))
+ (let ((val (nth 1 fields)))
+ (or (char-code-property-description
+ 'canonical-combining-class (intern val))
+ val)))
(list "Bidi category"
- (cdr (assoc
- (nth 3 fields)
- '(("L" . "Left-to-Right")
- ("LRE" . "Left-to-Right Embedding")
- ("LRO" . "Left-to-Right Override")
- ("R" . "Right-to-Left")
- ("AL" . "Right-to-Left Arabic")
- ("RLE" . "Right-to-Left Embedding")
- ("RLO" . "Right-to-Left Override")
- ("PDF" . "Pop Directional Format")
- ("EN" . "European Number")
- ("ES" . "European Number Separator")
- ("ET" . "European Number Terminator")
- ("AN" . "Arabic Number")
- ("CS" . "Common Number Separator")
- ("NSM" . "Non-Spacing Mark")
- ("BN" . "Boundary Neutral")
- ("B" . "Paragraph Separator")
- ("S" . "Segment Separator")
- ("WS" . "Whitespace")
- ("ON" . "Other Neutrals")))))
+ (let ((val (nth 1 fields)))
+ (or (char-code-property-description
+ 'bidi-class (intern val))
+ val)))
(list
"Decomposition"
(if (nth 4 fields)
(setq info (match-string 1 info))
(setq info nil))
(if info (setq parts (cdr parts)))
- ;; Maybe printing ? for unrepresentable unicodes
- ;; here and below should be changed?
(setq parts (mapconcat
(lambda (arg)
- (string (or (decode-char
- 'ucs
- (string-to-number arg 16))
- ??)))
+ (string (string-to-number arg 16)))
parts " "))
(concat info parts))))
(list "Decimal digit value"
(list "Old name" (nth 9 fields))
(list "ISO 10646 comment" (nth 10 fields))
(list "Uppercase" (and (nth 11 fields)
- (string (or (decode-char
- 'ucs
- (string-to-number
- (nth 11 fields) 16))
- ??))))
+ (string (string-to-number
+ (nth 11 fields) 16))))
(list "Lowercase" (and (nth 12 fields)
- (string (or (decode-char
- 'ucs
- (string-to-number
- (nth 12 fields) 16))
- ??))))
+ (string (string-to-number
+ (nth 12 fields) 16))))
(list "Titlecase" (and (nth 13 fields)
- (string (or (decode-char
- 'ucs
- (string-to-number
- (nth 13 fields) 16))
- ??)))))))))))
+ (string (string-to-number
+ (nth 13 fields) 16)))))))))))
;; Return information about how CHAR is displayed at the buffer
;; position POS. If the selected frame is on a graphic display,
(describe-text-properties pos tmp-buf)
(with-current-buffer tmp-buf (buffer-string)))
(kill-buffer tmp-buf))))
- item-list max-width unicode)
+ item-list max-width code)
- (if (or (< char 256)
- (memq 'mule-utf-8 (find-coding-systems-region pos (1+ pos)))
- (get-char-property pos 'untranslated-utf-8))
- (setq unicode (or (get-char-property pos 'untranslated-utf-8)
- (encode-char char 'ucs))))
+ (setq code (encode-char char charset))
(setq item-list
`(("character"
- ,(format "%s (%d, #o%o, #x%x%s)"
+ ,(format "%s (%d, #o%o, #x%x)"
(apply 'propertize char-description
(text-properties-at pos))
- char char char
- (if unicode
- (format ", U+%04X" unicode)
- "")))
- ("charset"
+ char char char))
+ ("preferred charset"
,`(insert-text-button
,(symbol-name charset)
'type 'help-character-set 'help-args '(,charset))
,(format "(%s)" (charset-description charset)))
("code point"
- ,(let ((split (split-char char)))
- `(insert-text-button
- ,(if (= (charset-dimension charset) 1)
- (format "#x%02X" (nth 1 split))
- (format "#x%02X #x%02X" (nth 1 split)
- (nth 2 split)))
- 'action (lambda (&rest ignore)
- (list-charset-chars ',charset)
- (with-selected-window
- (get-buffer-window "*Character List*" 0)
- (goto-char (point-min))
- (forward-line 2) ;Skip the header.
- (let ((case-fold-search nil))
- (search-forward ,(char-to-string char)
- nil t))))
- 'help-echo
- "mouse-2, RET: show this character in its character set")))
+ ,(let ((str (if (integerp code)
+ (format (if (< code 256) "0x%02X" "0x%04X") code)
+ (format "0x%04X%04X" (car code) (cdr code)))))
+ (if (<= (charset-dimension charset) 2)
+ `(insert-text-button
+ ,str
+ 'action (lambda (&rest ignore)
+ (list-charset-chars ',charset)
+ (with-selected-window
+ (get-buffer-window "*Character List*" 0)
+ (goto-char (point-min))
+ (forward-line 2) ;Skip the header.
+ (let ((case-fold-search nil))
+ (if (search-forward ,(char-to-string char)
+ nil t)
+ (goto-char (match-beginning 0))))))
+ 'help-echo
+ "mouse-2, RET: show this character in its character set")
+ str)))
("syntax"
,(let ((syntax (syntax-after pos)))
(with-temp-buffer
(mapcar #'(lambda (x) (format "%c:%s"
x (category-docstring x)))
(category-set-mnemonics category-set)))))
- ,@(let ((props (aref char-code-property-table char))
- ps)
- (when props
- (while props
- (push (format "%s:" (pop props)) ps)
- (push (format "%s;" (pop props)) ps))
- (list (cons "Properties" (nreverse ps)))))
("to input"
,@(let ((key-list (and (eq input-method-function
'quail-input-method)
(save-excursion (goto-char pos)
(looking-at "[ \t]+$")))
'trailing-whitespace)
- ((and nobreak-char-display unicode (eq unicode '#xa0))
+ ((and nobreak-char-display char (eq char '#xa0))
'nobreak-space)
- ((and nobreak-char-display unicode (eq unicode '#xad))
+ ((and nobreak-char-display char (eq char '#xad))
'escape-glyph)
((and (< char 32) (not (memq char '(9 10))))
'escape-glyph)))))
`(insert-text-button
,(symbol-name face)
'type 'help-face 'help-args '(,face))))))
- ,@(let ((unicodedata (and unicode
- (describe-char-unicode-data unicode))))
+ ,@(let ((unicodedata (describe-char-unicode-data char)))
(if unicodedata
(cons (list "Unicode data" " ") unicodedata)))))
- (setq max-width (apply #'max (mapcar #'(lambda (x)
+ (setq max-width (apply #'max (mapcar #'(lambda (x)
(if (cadr x) (length (car x)) 0))
item-list)))
(help-setup-xref nil (interactive-p))
(if (cadr composition)
(insert " with the following character(s) \""
(cadr composition) "\"")))
- (insert " by the rule:\n\t("
- (mapconcat (lambda (x)
- (format (if (consp x) "%S" "?%c") x))
- (nth 2 composition)
- " ")
- ")")
- (insert "\nThe component character(s) are displayed by ")
- (if (display-graphic-p (selected-frame))
+ (if (and (vectorp (nth 2 composition))
+ (vectorp (aref (nth 2 composition) 0)))
(progn
- (insert "these fonts (glyph codes):")
- (dolist (elt component-chars)
- (insert "\n " (car elt) ?:
- (propertize " " 'display '(space :align-to 5))
- (if (cdr elt)
- (format "%s (#x%02X)" (cadr elt) (cddr elt))
- "-- no font --"))))
- (insert "these terminal codes:")
- (dolist (elt component-chars)
- (insert "\n " (car elt) ":"
- (propertize " " 'display '(space :align-to 5))
- (or (cdr elt) "-- not encodable --"))))
- (insert "\nSee the variable `reference-point-alist' for "
- "the meaning of the rule.\n"))
+ (insert " using this font:\n "
+ (aref (query-font (aref (aref (nth 2 composition) 0) 0))
+ 0)
+ "\nby these glyphs:\n")
+ (mapc (lambda (x) (insert (format " %S\n" x)))
+ (nth 2 composition)))
+ (insert " by the rule:\n\t("
+ (mapconcat (lambda (x)
+ (if (consp x) (format "%S" x)
+ (if (= x ?\t)
+ (single-key-description x)
+ (string ?? x))))
+ (nth 2 composition)
+ " ")
+ ")")
+ (insert "\nThe component character(s) are displayed by ")
+ (if (display-graphic-p (selected-frame))
+ (progn
+ (insert "these fonts (glyph codes):")
+ (dolist (elt component-chars)
+ (if (/= (car elt) ?\t)
+ (insert "\n " (car elt) ?:
+ (propertize " " 'display '(space :align-to 5))
+ (if (cdr elt)
+ (format "%s (#x%02X)" (cadr elt) (cddr elt))
+ "-- no font --")))))
+ (insert "these terminal codes:")
+ (dolist (elt component-chars)
+ (insert "\n " (car elt) ":"
+ (propertize " " 'display '(space :align-to 4))
+ (or (cdr elt) "-- not encodable --"))))
+ (insert "\nSee the variable `reference-point-alist' for "
+ "the meaning of the rule.\n")))
+
+ (if (not describe-char-unidata-list)
+ (insert "\nCharacter code properties are not shown: ")
+ (insert "\nCharacter code properties: "))
+ (insert-text-button
+ "customize what to show"
+ 'action (lambda (&rest ignore)
+ (customize-variable
+ 'describe-char-unidata-list)))
+ (insert "\n")
+ (dolist (elt describe-char-unidata-list)
+ (let ((val (get-char-code-property char elt))
+ description)
+ (when val
+ (setq description (char-code-property-description elt val))
+ (if description
+ (insert (format " %s: %s (%s)\n" elt val description))
+ (insert (format " %s: %s\n" elt val))))))
(if text-props-desc (insert text-props-desc))
(setq help-xref-stack-item (list 'help-insert-string (buffer-string)))
;;; desktop.el --- save partial status of Emacs when killed
;; Copyright (C) 1993, 1994, 1995, 1997, 2000, 2001, 2002, 2003,
- ;; 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ ;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Morten Welinder <terra@diku.dk>
;; Keywords: convenience
((eq desktop-file-name-format 'local) (file-relative-name filename dirname))
(t (expand-file-name filename))))
+
;; ----------------------------------------------------------------------------
;;;###autoload
(defun desktop-save (dirname &optional release)
;;; disp-table.el --- functions for dealing with char tables
;; Copyright (C) 1987, 1994, 1995, 1999, 2001, 2002, 2003, 2004,
- ;; 2005, 2006, 2007 Free Software Foundation, Inc.
+ ;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Erik Naggum <erik@naggum.no>
;; Based on a previous version by Howard Gayle
(or standard-display-table
(setq standard-display-table (make-display-table)))
(while (<= l h)
- (if (and (>= l ?\s) (char-valid-p l))
+ (if (and (>= l ?\s) (characterp l))
(aset standard-display-table l nil))
(setq l (1+ l))))
(defun make-glyph-code (char &optional face)
"Return a glyph code representing char CHAR with face FACE."
;; Due to limitations on Emacs integer values, faces with
- ;; face id greater that 4091 are silently ignored.
- (if (and face (<= (face-id face) #xfff))
- (logior char (lsh (face-id face) 19))
+ ;; face id greater that 512 are silently ignored.
+ (if (and face (<= (face-id face) #x1ff))
+ (logior char (lsh (face-id face) 22))
char))
;;;###autoload
(defun glyph-char (glyph)
"Return the character of glyph code GLYPH."
- (logand glyph #x7ffff))
+ (logand glyph #x3fffff))
;;;###autoload
(defun glyph-face (glyph)
"Return the face of glyph code GLYPH, or nil if glyph has default face."
- (let ((face-id (lsh glyph -19)))
+ (let ((face-id (lsh glyph -22)))
(and (> face-id 0)
(car (delq nil (mapcar (lambda (face)
(and (eq (get face 'face) face-id)
;;; dnd.el --- drag and drop support.
- ;; Copyright (C) 2005, 2006, 2007 Free Software Foundation, Inc.
+ ;; Copyright (C) 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Jan Dj\e,Ad\e(Brv <jan.h.d@swipnet.se>
;; Maintainer: FSF
(setq f (replace-regexp-in-string
"%[A-Fa-f0-9][A-Fa-f0-9]"
(lambda (arg)
- (format "%c" (string-to-number (substring arg 1) 16)))
+ (let ((str (make-string 1 0)))
+ (aset str 0 (string-to-number (substring arg 1) 16))
+ str))
f t t))
(let* ((decoded-f (decode-coding-string
f
;;; edmacro.el --- keyboard macro editor
;; Copyright (C) 1993, 1994, 2001, 2002, 2003, 2004,
- ;; 2005, 2006, 2007 Free Software Foundation, Inc.
+ ;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Dave Gillespie <daveg@synaptics.com>
;; Maintainer: Dave Gillespie <daveg@synaptics.com>
(setq res (edmacro-subseq res 2 -2)))
(if (and (not need-vector)
(loop for ch across res
- always (and (char-valid-p ch)
+ always (and (characterp ch)
(let ((ch2 (logand ch (lognot ?\M-\^@))))
(and (>= ch2 0) (<= ch2 127))))))
(concat (loop for ch across res
;; autoload.el --- maintain autoloads in loaddefs.el
;; Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 2001, 2002, 2003,
- ;; 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ ;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Roland McGrath <roland@gnu.org>
;; Keywords: maint
(defun batch-update-autoloads ()
"Update loaddefs.el autoloads in batch mode.
Calls `update-directory-autoloads' on the command line arguments."
- (apply 'update-directory-autoloads command-line-args-left)
- (setq command-line-args-left nil))
+ (let ((args command-line-args-left))
+ (setq command-line-args-left nil)
+ (apply 'update-directory-autoloads args)))
(provide 'autoload)
;;; byte-opt.el --- the optimization passes of the emacs-lisp byte compiler
;; Copyright (C) 1991, 1994, 2000, 2001, 2002, 2003, 2004,
- ;; 2005, 2006, 2007 Free Software Foundation, Inc.
+ ;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Jamie Zawinski <jwz@lucid.com>
;; Hallvard Furuseth <hbf@ulrik.uio.no>
char-equal char-to-string char-width
compare-strings concat coordinates-in-window-p
copy-alist copy-sequence copy-marker cos count-lines
+ decdoe-char
decode-time default-boundp default-value documentation downcase
- elt exp expt encode-time error-message-string
+ elt encode-char exp expt encode-time error-message-string
fboundp fceiling featurep ffloor
file-directory-p file-exists-p file-locked-p file-name-absolute-p
file-newer-than-file-p file-readable-p file-symlink-p file-writable-p
int-to-string intern-soft
keymap-parent
length local-variable-if-set-p local-variable-p log log10 logand
- logb logior lognot logxor lsh
+ logb logior lognot logxor lsh langinfo
make-list make-string make-symbol
marker-buffer max member memq min mod multibyte-char-to-unibyte
next-window nth nthcdr number-to-string
string-to-int string-to-number substring sxhash symbol-function
symbol-name symbol-plist symbol-value string-make-unibyte
string-make-multibyte string-as-multibyte string-as-unibyte
+ string-to-multibyte
tan truncate
unibyte-char-to-multibyte upcase user-full-name
user-login-name user-original-login-name user-variable-p
'(arrayp atom
bobp bolp bool-vector-p
buffer-end buffer-list buffer-size buffer-string bufferp
- car-safe case-table-p cdr-safe char-or-string-p commandp cons consp
+ car-safe case-table-p cdr-safe char-or-string-p characterp
+ charsetp commandp cons consp
current-buffer current-global-map current-indentation
current-local-map current-minor-mode-maps current-time
current-time-string current-time-zone
invocation-directory invocation-name
keymapp
line-beginning-position line-end-position list listp
- make-marker mark mark-marker markerp memory-limit minibuffer-window
+ make-marker mark mark-marker markerp max-char
+ memory-limit minibuffer-window
mouse-movement-p
natnump nlistp not null number-or-marker-p numberp
one-window-p overlayp
- point point-marker point-min point-max preceding-char processp
+ point point-marker point-min point-max preceding-char primary-charset
+ processp
recent-keys recursion-depth
safe-length selected-frame selected-window sequencep
standard-case-table standard-syntax-table stringp subrp symbolp
;;; bytecomp.el --- compilation of Lisp code into byte code
;; Copyright (C) 1985, 1986, 1987, 1992, 1994, 1998, 2000, 2001, 2002,
- ;; 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ ;; 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Jamie Zawinski <jwz@lucid.com>
;; Hallvard Furuseth <hbf@ulrik.uio.no>
(setcar (cdr bytes) (logand pc 255))
(setcar bytes (lsh pc -8))))
(setq patchlist (cdr patchlist))))
- (concat (nreverse bytes))))
+ (string-make-unibyte (concat (nreverse bytes)))))
\f
;;; compile-time evaluation
(delete-region (point) (progn (re-search-forward "^(")
(beginning-of-line)
(point)))
- (insert ";;; This file contains multibyte non-ASCII characters\n"
- ";;; and therefore cannot be loaded into Emacs 19.\n")
- ;; Replace "19" or "19.29" with "20", twice.
+ (insert ";;; This file contains utf-8 non-ASCII characters\n"
+ ";;; and therefore cannot be loaded into Emacs 21 or earlier.\n")
+ ;; Replace "19" or "19.29" with "22", twice.
(re-search-forward "19\\(\\.[0-9]+\\)")
- (replace-match "20")
+ (replace-match "23")
(re-search-forward "19\\(\\.[0-9]+\\)")
- (replace-match "20")
+ (replace-match "23")
;; Now compensate for the change in size,
;; to make sure all positions in the file remain valid.
(setq delta (- (point-max) old-header-end))
(delete-char delta)))))
(defun byte-compile-insert-header (filename inbuffer outbuffer)
- (set-buffer inbuffer)
- (let ((dynamic-docstrings byte-compile-dynamic-docstrings)
- (dynamic byte-compile-dynamic))
- (set-buffer outbuffer)
- (goto-char (point-min))
- ;; The magic number of .elc files is ";ELC", or 0x3B454C43. After
- ;; that is the file-format version number (18, 19, 20, or 23) as a
- ;; byte, followed by some nulls. The primary motivation for doing
- ;; this is to get some binary characters up in the first line of
- ;; the file so that `diff' will simply say "Binary files differ"
- ;; instead of actually doing a diff of two .elc files. An extra
- ;; benefit is that you can add this to /etc/magic:
-
- ;; 0 string ;ELC GNU Emacs Lisp compiled file,
- ;; >4 byte x version %d
-
- (insert
- ";ELC"
- (if (byte-compile-version-cond byte-compile-compatibility) 18 23)
- "\000\000\000\n"
- )
- (insert ";;; Compiled by "
- (or (and (boundp 'user-mail-address) user-mail-address)
- (concat (user-login-name) "@" (system-name)))
- " on "
- (current-time-string) "\n;;; from file " filename "\n")
- (insert ";;; in Emacs version " emacs-version "\n")
- (insert ";;; "
- (cond
- ((eq byte-optimize 'source) "with source-level optimization only")
- ((eq byte-optimize 'byte) "with byte-level optimization only")
- (byte-optimize "with all optimizations")
- (t "without optimization"))
- (if (byte-compile-version-cond byte-compile-compatibility)
- "; compiled with Emacs 18 compatibility.\n"
- ".\n"))
- (if dynamic
- (insert ";;; Function definitions are lazy-loaded.\n"))
- (if (not (byte-compile-version-cond byte-compile-compatibility))
- (let (intro-string minimum-version)
- ;; Figure out which Emacs version to require,
- ;; and what comment to use to explain why.
- ;; Note that this fails to take account of whether
- ;; the buffer contains multibyte characters. We may have to
- ;; compensate at the end in byte-compile-fix-header.
- (if dynamic-docstrings
+ (with-current-buffer inbuffer
+ (let ((dynamic-docstrings byte-compile-dynamic-docstrings)
+ (dynamic byte-compile-dynamic))
+ (set-buffer outbuffer)
+ (goto-char (point-min))
+ ;; The magic number of .elc files is ";ELC", or 0x3B454C43. After
- ;; that is the file-format version number (18, 19 or 20) as a
++ ;; that is the file-format version number (18, 19, 20, or 23) as a
+ ;; byte, followed by some nulls. The primary motivation for doing
+ ;; this is to get some binary characters up in the first line of
+ ;; the file so that `diff' will simply say "Binary files differ"
+ ;; instead of actually doing a diff of two .elc files. An extra
+ ;; benefit is that you can add this to /etc/magic:
+
+ ;; 0 string ;ELC GNU Emacs Lisp compiled file,
+ ;; >4 byte x version %d
+
+ (insert
+ ";ELC"
- (if (byte-compile-version-cond byte-compile-compatibility) 18 20)
++ (if (byte-compile-version-cond byte-compile-compatibility) 18 23)
+ "\000\000\000\n"
+ )
+ (insert ";;; Compiled by "
+ (or (and (boundp 'user-mail-address) user-mail-address)
+ (concat (user-login-name) "@" (system-name)))
+ " on "
+ (current-time-string) "\n;;; from file " filename "\n")
+ (insert ";;; in Emacs version " emacs-version "\n")
+ (insert ";;; "
+ (cond
+ ((eq byte-optimize 'source) "with source-level optimization only")
+ ((eq byte-optimize 'byte) "with byte-level optimization only")
+ (byte-optimize "with all optimizations")
+ (t "without optimization"))
+ (if (byte-compile-version-cond byte-compile-compatibility)
+ "; compiled with Emacs 18 compatibility.\n"
+ ".\n"))
+ (if dynamic
+ (insert ";;; Function definitions are lazy-loaded.\n"))
+ (if (not (byte-compile-version-cond byte-compile-compatibility))
+ (let (intro-string minimum-version)
+ ;; Figure out which Emacs version to require,
+ ;; and what comment to use to explain why.
+ ;; Note that this fails to take account of whether
+ ;; the buffer contains multibyte characters. We may have to
+ ;; compensate at the end in byte-compile-fix-header.
+ (if dynamic-docstrings
- (setq intro-string
- ";;; This file uses dynamic docstrings, first added in Emacs 19.29.\n"
- minimum-version "19.29")
(setq intro-string
- ";;; This file uses opcodes which do not exist in Emacs 18.\n"
- minimum-version "19"))
- ;; Now insert the comment and the error check.
- (insert
- "\n"
- intro-string
- ;; Have to check if emacs-version is bound so that this works
- ;; in files loaded early in loadup.el.
- "(if (and (boundp 'emacs-version)\n"
- ;; If there is a name at the end of emacs-version,
- ;; don't try to check the version number.
- "\t (< (aref emacs-version (1- (length emacs-version))) ?A)\n"
- "\t (or (and (boundp 'epoch::version) epoch::version)\n"
- (format "\t (string-lessp emacs-version \"%s\")))\n"
- minimum-version)
- " (error \"`"
- ;; prin1-to-string is used to quote backslashes.
- (substring (prin1-to-string (file-name-nondirectory filename))
- 1 -1)
- (format "' was compiled for Emacs %s or later\"))\n\n"
- minimum-version)
- ;; Insert semicolons as ballast, so that byte-compile-fix-header
- ;; can delete them so as to keep the buffer positions
- ;; constant for the actual compiled code.
- ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n\n"))
- ;; Here if we want Emacs 18 compatibility.
- (when dynamic-docstrings
- (error "Version-18 compatibility doesn't support dynamic doc strings"))
- (when byte-compile-dynamic
- (error "Version-18 compatibility doesn't support dynamic byte code"))
- (insert "(or (boundp 'current-load-list) (setq current-load-list nil))\n"
+ ";;; This file uses dynamic docstrings, first added in Emacs 19.29.\n"
+ minimum-version "19.29")
+ (setq intro-string
+ ";;; This file uses opcodes which do not exist in Emacs 18.\n"
+ minimum-version "19"))
+ ;; Now insert the comment and the error check.
+ (insert
+ "\n"
+ intro-string
+ ;; Have to check if emacs-version is bound so that this works
+ ;; in files loaded early in loadup.el.
+ "(if (and (boundp 'emacs-version)\n"
+ ;; If there is a name at the end of emacs-version,
+ ;; don't try to check the version number.
+ "\t (< (aref emacs-version (1- (length emacs-version))) ?A)\n"
+ "\t (or (and (boundp 'epoch::version) epoch::version)\n"
+ (format "\t (string-lessp emacs-version \"%s\")))\n"
+ minimum-version)
+ " (error \"`"
+ ;; prin1-to-string is used to quote backslashes.
+ (substring (prin1-to-string (file-name-nondirectory filename))
+ 1 -1)
+ (format "' was compiled for Emacs %s or later\"))\n\n"
+ minimum-version)
+ ;; Insert semicolons as ballast, so that byte-compile-fix-header
+ ;; can delete them so as to keep the buffer positions
+ ;; constant for the actual compiled code.
+ ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n\n"))
+ ;; Here if we want Emacs 18 compatibility.
+ (when dynamic-docstrings
+ (error "Version-18 compatibility doesn't support dynamic doc strings"))
+ (when byte-compile-dynamic
+ (error "Version-18 compatibility doesn't support dynamic byte code"))
+ (insert "(or (boundp 'current-load-list) (setq current-load-list nil))\n"
- "\n"))))
+ "\n")))))
(defun byte-compile-output-file-form (form)
;; writes the given form to the output buffer, being careful of docstrings
(byte-defop-compiler-1 mapc byte-compile-funarg)
(byte-defop-compiler-1 maphash byte-compile-funarg)
(byte-defop-compiler-1 map-char-table byte-compile-funarg)
+(byte-defop-compiler-1 map-char-table byte-compile-funarg-2)
+;; map-charset-chars should be funarg but has optional third arg
(byte-defop-compiler-1 sort byte-compile-funarg-2)
(byte-defop-compiler-1 let)
(byte-defop-compiler-1 let*)
;;; cl-macs.el --- Common Lisp macros
- ;; Copyright (C) 1993, 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ ;; Copyright (C) 1993, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
;; Free Software Foundation, Inc.
;; Author: Dave Gillespie <daveg@synaptics.com>
((eq type 'real) `(numberp ,val))
((eq type 'fixnum) `(integerp ,val))
;; FIXME: Should `character' accept things like ?\C-\M-a ? -stef
- ((memq type '(character string-char)) `(char-valid-p ,val))
+ ((memq type '(character string-char)) `(characterp ,val))
(t
(let* ((name (symbol-name type))
(namep (intern (concat name "p"))))
;;; copyright.el --- update the copyright notice in current buffer
;; Copyright (C) 1991, 1992, 1993, 1994, 1995, 1998, 2001, 2002, 2003,
- ;; 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ ;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Daniel Pfeiffer <occitan@esperanto.org>
;; Keywords: maint, tools
:type '(choice (integer :tag "Limit")
(const :tag "No limit")))
-;; The character classes have the Latin-1 version and the Latin-9
-;; version, which is probably enough.
(defcustom copyright-regexp
- "\\([\81©\81©]\\|@copyright{}\\|[Cc]opyright\\s *:?\\s *\\(?:(C)\\)?\
-\\|[Cc]opyright\\s *:?\\s *[\81©\81©]\\)\
+ "\\(©\\|@copyright{}\\|[Cc]opyright\\s *:?\\s *\\(?:(C)\\)?\
+\\|[Cc]opyright\\s *:?\\s *©\\)\
\\s *\\([1-9]\\([-0-9, ';/*%#\n\t]\\|\\s<\\|\\s>\\)*[0-9]+\\)"
"What your copyright notice looks like.
The second \\( \\) construct must match the years."
;; For the copyright sign:
;; Local Variables:
-;; coding: emacs-mule
+;; coding: utf-8
;; End:
;; arch-tag: b4991afb-b6b1-4590-bebe-e076d9d4aee8
;;; generic.el --- defining simple major modes with comment and font-lock
;;
;; Copyright (C) 1997, 1999, 2001, 2002, 2003, 2004,
- ;; 2005, 2006, 2007 Free Software Foundation, Inc.
+ ;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;;
;; Author: Peter Breton <pbreton@cs.umb.edu>
;; Created: Fri Sep 27 1996
(when (consp start)
(setq end (cdr start))
(setq start (car start)))
- (when (char-valid-p start) (setq start (char-to-string start)))
+ (when (characterp start) (setq start (char-to-string start)))
(cond
- ((char-valid-p end) (setq end (char-to-string end)))
+ ((characterp end) (setq end (char-to-string end)))
((zerop (length end)) (setq end "\n")))
;; Setup the vars for `comment-region'
;;; regexp-opt.el --- generate efficient regexps to match strings
;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002,
- ;; 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ ;; 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Simon Marshall <simon@gnu.org>
;; Maintainer: FSF
(map-char-table
(lambda (c v)
(when v
- (if (= (1- c) end) (setq end c)
- (if (> end (+ start 2))
+ (if (consp c)
+ (if (= (1- (car c)) end) (setq end (cdr c))
+ (if (> end (+ start 2))
+ (setq charset (format "%s%c-%c" charset start end))
+ (while (>= end start)
+ (setq charset (format "%s%c" charset start))
+ (incf start)))
+ (setq start (car c) end (cdr c)))
+ (if (= (1- c) end) (setq end c)
+ (if (> end (+ start 2))
(setq charset (format "%s%c-%c" charset start end))
(while (>= end start)
(setq charset (format "%s%c" charset start))
(incf start)))
- (setq start c end c))))
+ (setq start c end c)))))
charmap)
(when (>= end start)
(if (> end (+ start 2))
;;; keypad.el --- simplified keypad bindings
;; Copyright (C) 2002, 2003, 2004, 2005, 2006,
- ;; 2007 Free Software Foundation, Inc.
+ ;; 2007, 2008 Free Software Foundation, Inc.
;; Author: Kim F. Storm <storm@cua.dk>
;; Keywords: keyboard convenience
(bind
(cond
((or (eq setup 'numeric)
- (char-valid-p setup))
+ (characterp setup))
(if (eq decimal 'numeric)
(setq decimal nil))
(vector (or decimal ?.) ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))
;;; esh-mode.el --- user interface
;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004,
- ;; 2005, 2006, 2007 Free Software Foundation, Inc.
+ ;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
(map-char-table
(function
(lambda (key val)
- (and (>= key 256)
- (/= (char-syntax key) ?w)
+ (and (if (consp key)
+ (and (>= (car key) 128)
+ (/= (char-syntax (car key)) ?w))
+ (and (>= key 256)
+ (/= (char-syntax key) ?w)))
(modify-syntax-entry key "_ "
eshell-mode-syntax-table))))
(standard-syntax-table)))))
;;; esh-opt.el --- command options processing
;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004,
- ;; 2005, 2006, 2007 Free Software Foundation, Inc.
+ ;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
(setq extcmd (eshell-search-path (cadr extcmd)))
(if extcmd
(throw 'eshell-ext-command extcmd)
- (if (char-valid-p switch)
+ (if (characterp switch)
(error "%s: unrecognized option -%c" name switch)
(error "%s: unrecognized option --%s" name switch))))))))
;;; faces.el --- Lisp faces
;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001,
- ;; 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ ;; 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: internal
(defcustom face-font-registry-alternatives
(if (eq system-type 'windows-nt)
'(("iso8859-1" "ms-oemlatin")
- ("gb2312.1980" "gb2312")
+ ("gb2312.1980" "gb2312" "gbk" "gb18030")
("jisx0208.1990" "jisx0208.1983" "jisx0208.1978")
("ksc5601.1989" "ksx1001.1992" "ksc5601.1987")
("muletibetan-2" "muletibetan-0"))
- '(("gb2312.1980" "gb2312.80&gb8565.88" "gbk*")
+ '(("gb2312.1980" "gb2312.80&gb8565.88" "gbk" "gb18030")
("jisx0208.1990" "jisx0208.1983" "jisx0208.1978")
("ksc5601.1989" "ksx1001.1992" "ksc5601.1987")
("muletibetan-2" "muletibetan-0")))
(internal-set-alternative-font-registry-alist value)))
+(defcustom font-weight-table
+ (if (eq system-type 'windows-nt)
+ '((thin . 100)
+ (ultralight . 200) (ultra-light . 200) (extra-light . 200)
+ (light . 300)
+ (semilight . 330) (semi-light . 330)
+ (book . 350)
+ (normal . 400) (regular . 400)
+ (medium . 500)
+ (semibold . 600) (semi-bold . 600) (demibold . 600) (demi . 600)
+ (bold . 700)
+ (extrabold . 800) (extra-bold . 800)
+ (ultrabold . 800) (ultra-bold . 800)
+ (black . 900) (heavy . 900))
+ '((thin . 0)
+ (ultralight . 40) (ultra-light . 40) (extra-light . 40)
+ (light . 50)
+ (semilight . 65) (semi-light . 65)
+ (book . 75)
+ (medium . 100) (regular . 100) (normal . 100)
+ (semibold . 180) (semi-bold . 180) (demibold . 180) (demi . 180)
+ (bold . 200)
+ (extrabold . 205) (extra-bold . 205)
+ (ultrabold . 205) (ultra-bold . 205)
+ (black . 210) (heavy . 210)))
+ "*Alist of font weight symbols vs the corresponding numeric values."
+ :tag "Font weight table"
+ :version "23.1"
+ :group 'font-selection
+ :type '(repeat (cons symbol integer))
+ :set #'(lambda (symbol value)
+ (set-default symbol value)
+ (if (fboundp 'internal-set-font-style-table)
+ (internal-set-font-style-table :weight value))))
+
+(defcustom font-slant-table
+ '((ro . 0)
+ (ri . 10)
+ (r . 100) (roman . 100) (normal . 100)
+ (i . 200) (italic . 200) (ot . 200)
+ (o . 210) (oblique . 210))
+ "*Alist of font slant symbols vs the corresponding numeric values."
+ :tag "Font slant table"
+ :version "23.1"
+ :group 'font-selection
+ :type '(repeat (cons symbol integer))
+ :set #'(lambda (symbol value)
+ (set-default symbol value)
+ (if (fboundp 'internal-set-font-style-table)
+ (internal-set-font-style-table :slant value))))
+
+(defcustom font-swidth-table
+ '((ultracondensed . 50) (ultra-condensed . 50)
+ (extracondensed . 63) (extra-condensed . 63)
+ (condensed . 75) (compressed . 75) (narrow . 75)
+ (semicondensed . 87) (semi-condensed . 87)
+ (normal . 100) (medium . 100) (regular . 100)
+ (semiexpanded . 113) (semi-expanded . 113) (demiexpanded . 113)
+ (expanded . 125)
+ (extraexpanded . 150) (extra-expanded . 150)
+ (ultraexpanded . 200) (ultra-expanded . 200) (wide . 200))
+ "*Alist of font swidth symbols vs the corresponding numeric values."
+ :tag "Font swidth table"
+ :version "23.1"
+ :group 'font-selection
+ :type '(repeat (cons symbol integer))
+ :set #'(lambda (symbol value)
+ (set-default symbol value)
+ (if (fboundp 'internal-set-font-style-table)
+ (internal-set-font-style-table :width value))))
\f
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Creation, copying.
If optional argument FRAME is nil or omitted, use the selected frame."
(let ((completion-ignore-case t))
(completing-read (format "Set font attributes of face `%s' from font: " face)
- (x-list-fonts "*" nil frame))))
+ (append (fontset-list) (x-list-fonts "*" nil frame)))))
(defun read-all-face-attributes (face &optional frame)
(:box . "Box")
(:inverse-video . "Inverse")
(:stipple . "Stipple")
- (:font . "Font or fontset")
+ (:font . "Font")
+ (:fontset . "Fontset")
(:inherit . "Inherit")))
(max-width (apply #'max (mapcar #'(lambda (x) (length (cdr x)))
attrs))))
;;; font-lock.el --- Electric font lock mode
;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- ;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ ;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: jwz, then rms, then sm
;; Maintainer: FSF
;; Move over any item value, etc., to the next item.
(while (not (looking-at "[ \t\n]*\\(\\(,\\)\\|;\\|\\'\\)"))
(goto-char (or (scan-sexps (point) 1) (point-max))))
- (goto-char (match-end 2)))
+ (if (match-end 2)
+ (goto-char (match-end 2))))
(error t)))))
;; C preprocessor(cpp) is used outside of C, C++ and Objective-C source file.
;;; format.el --- read and save files in multiple formats
;; Copyright (C) 1994, 1995, 1997, 1999, 2001, 2002, 2003, 2004,
- ;; 2005, 2006, 2007 Free Software Foundation, Inc.
+ ;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Boris Goldowsky <boris@gnu.org>
;; Plain only exists so that there is an obvious neutral choice in
;; the completion list.
nil nil nil nil nil)
- (ibm "IBM Code Page 850 (DOS)"
- nil ; The original "1\\(^\\)" is obscure.
- "recode -f ibm-pc:latin1" "recode -f latin1:ibm-pc" t nil)
- (mac "Apple Macintosh"
- nil
- "recode -f mac:latin1" "recode -f latin1:mac" t nil)
- (hp "HP Roman8"
- nil
- "recode -f roman8:latin1" "recode -f latin1:roman8" t nil)
(TeX "TeX (encoding)"
nil
iso-tex2iso iso-iso2tex t nil)
;;; gnus-start.el --- startup functions for Gnus
;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- ;; 2005, 2006, 2007 Free Software Foundation, Inc.
+ ;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
;;; Internal variables
+;; Fixme: deal with old emacs-mule when mm-universal-coding-system is
+;; utf-8-emacs.
(defvar gnus-ding-file-coding-system mm-universal-coding-system
"Coding system for ding file.")
;; We always, always read the .eld file.
(gnus-message 5 "Reading %s..." ding-file)
(let (gnus-newsrc-assoc)
- (let ((coding-system-for-read gnus-ding-file-coding-system))
- (gnus-load ding-file))
+ (gnus-load ding-file)
;; Older versions of `gnus-format-specs' are no longer valid
;; in Oort Gnus 0.01.
(let ((version
(defun gnus-gnus-to-quick-newsrc-format (&optional minimal name &rest specific-variables)
"Print Gnus variables such as `gnus-newsrc-alist' in Lisp format."
- (princ ";; -*- emacs-lisp -*-\n")
+ (princ (format ";; -*- mode:emacs-lisp; coding: %s; -*-\n"
+ gnus-ding-file-coding-system))
(if name
(princ (format ";; %s\n" name))
(princ ";; Gnus startup file.\n"))
;;; mm-bodies.el --- Functions for decoding MIME things
;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- ;; 2005, 2006, 2007 Free Software Foundation, Inc.
+ ;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
(mm-charset-to-coding-system charset))
charset)
(goto-char (point-min))
- (let ((charsets (mm-find-mime-charset-region (point-min) (point-max)
- mm-hack-charsets)))
+ (let ((charsets (mm-find-mime-charset-region (point-min) (point-max))))
(cond
;; No encoding.
((null charsets)
;;; mm-util.el --- Utility functions for Mule and low level things
;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- ;; 2005, 2006, 2007 Free Software Foundation, Inc.
+ ;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
(iso-2022-jp latin-jisx0201 japanese-jisx0208 japanese-jisx0208-1978)
(euc-kr korean-ksc5601)
(gb2312 chinese-gb2312)
+ (gbk chinese-gbk)
+ (gb18030 gb18030-2-byte
+ gb18030-4-byte-bmp gb18030-4-byte-smp
+ gb18030-4-byte-ext-1 gb18030-4-byte-ext-2)
(big5 chinese-big5-1 chinese-big5-2)
(tibetan tibetan)
(thai-tis620 thai-tis620)
cs mime mule alist)
(while css
(setq cs (pop css)
- mime (or (coding-system-get cs :mime-charset) ; Emacs 23 (unicode)
+ mime (or (coding-system-get cs :mime-charset); Emacs 23 (unicode)
(coding-system-get cs 'mime-charset)))
(when (and mime
(not (eq t (setq mule
(push (cons mime (delq 'ascii mule)) alist)))
(setq mm-mime-mule-charset-alist (nreverse alist)))))
-(defvar mm-hack-charsets '(iso-8859-15 iso-2022-jp-2)
- "A list of special charsets.
-Valid elements include:
-`iso-8859-15' convert ISO-8859-1, -9 to ISO-8859-15 if ISO-8859-15 exists.
-`iso-2022-jp-2' convert ISO-2022-jp to ISO-2022-jp-2 if ISO-2022-jp-2 exists."
-)
-
-(defvar mm-iso-8859-15-compatible
- '((iso-8859-1 "\xA4\xA6\xA8\xB4\xB8\xBC\xBD\xBE")
- (iso-8859-9 "\xA4\xA6\xA8\xB4\xB8\xBC\xBD\xBE\xD0\xDD\xDE\xF0\xFD\xFE"))
- "ISO-8859-15 exchangeable coding systems and inconvertible characters.")
-
-(defvar mm-iso-8859-x-to-15-table
- (and (fboundp 'coding-system-p)
- (mm-coding-system-p 'iso-8859-15)
- (mapcar
- (lambda (cs)
- (if (mm-coding-system-p (car cs))
- (let ((c (string-to-char
- (decode-coding-string "\341" (car cs)))))
- (cons (char-charset c)
- (cons
- (- (string-to-char
- (decode-coding-string "\341" 'iso-8859-15)) c)
- (string-to-list (decode-coding-string (car (cdr cs))
- (car cs))))))
- '(gnus-charset 0)))
- mm-iso-8859-15-compatible))
- "A table of the difference character between ISO-8859-X and ISO-8859-15.")
-
(defcustom mm-coding-system-priorities
(if (boundp 'current-language-environment)
(let ((lang (symbol-value 'current-language-environment)))
default-enable-multibyte-characters
t)))
-(defun mm-iso-8859-x-to-15-region (&optional b e)
- (if (fboundp 'char-charset)
- (let (charset item c inconvertible)
- (save-restriction
- (if e (narrow-to-region b e))
- (goto-char (point-min))
- (skip-chars-forward "\0-\177")
- (while (not (eobp))
- (cond
- ((not (setq item (assq (char-charset (setq c (char-after)))
- mm-iso-8859-x-to-15-table)))
- (forward-char))
- ((memq c (cdr (cdr item)))
- (setq inconvertible t)
- (forward-char))
- (t
- (insert-before-markers (prog1 (+ c (car (cdr item)))
- (delete-char 1)))))
- (skip-chars-forward "\0-\177")))
- (not inconvertible))))
-
(defun mm-sort-coding-systems-predicate (a b)
(let ((priorities
(mapcar (lambda (cs)
;; Otherwise, we'll get nil, and the next setq will get invoked.
(setq charsets (mm-xemacs-find-mime-charset b e))
+ ;; Fixme: won't work for unibyte Emacs 23:
+
;; We're not multibyte, or a single coding system won't cover it.
(setq charsets
(mm-delete-duplicates
(mapcar 'mm-mime-charset
(delq 'ascii
(mm-find-charset-region b e))))))
- (if (and (> (length charsets) 1)
- (memq 'iso-8859-15 charsets)
- (memq 'iso-8859-15 hack-charsets)
- (save-excursion (mm-iso-8859-x-to-15-region b e)))
- (dolist (x mm-iso-8859-15-compatible)
- (setq charsets (delq (car x) charsets))))
- (if (and (memq 'iso-2022-jp-2 charsets)
- (memq 'iso-2022-jp-2 hack-charsets))
- (setq charsets (delq 'iso-2022-jp charsets)))
- ;; Attempt to reduce the number of charsets if utf-8 is available.
- (if (and (featurep 'xemacs)
- (> (length charsets) 1)
- (mm-coding-system-p 'utf-8))
- (let ((mm-coding-system-priorities
- (cons 'utf-8 mm-coding-system-priorities)))
- (setq charsets
- (mm-delete-duplicates
- (mapcar 'mm-mime-charset
- (delq 'ascii
- (mm-find-charset-region b e)))))))
charsets))
(defmacro mm-with-unibyte-buffer (&rest forms)
;;; mml.el --- A package for parsing and validating MML documents
;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- ;; 2005, 2006, 2007 Free Software Foundation, Inc.
+ ;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; This file is part of GNU Emacs.
(list
(intern (downcase (cdr (assq 'charset tag))))))
(t
- (mm-find-mime-charset-region point (point)
- mm-hack-charsets))))
+ (mm-find-mime-charset-region point (point)))))
(when (and (not raw) (memq nil charsets))
(if (or (memq 'unknown-encoding mml-confirmation-set)
(message-options-get 'unknown-encoding)
;;; rfc2047.el --- functions for encoding and decoding rfc2047 messages
;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- ;; 2005, 2006, 2007 Free Software Foundation, Inc.
+ ;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
(iso-2022-jp . B)
(iso-2022-kr . B)
(gb2312 . B)
+ (gbk . B)
+ (gb18030 . B)
(big5 . B)
(cn-big5 . B)
(cn-gb . B)
;; (make-char-table 'syntax-table '(2)) only works in Emacs.
(let ((table (make-syntax-table)))
;; The following is done to work for setting all elements of the table
- ;; in Emacs 21 and 22 and XEmacs; it appears to be the cleanest way.
+ ;; in Emacs 21-23 and XEmacs; it appears to be the cleanest way.
;; Play safe and don't assume the form of the word syntax entry --
;; copy it from ?a.
(if (fboundp 'set-char-table-range) ; Emacs
;;; rfc2104.el --- RFC2104 Hashed Message Authentication Codes
;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- ;; 2005, 2006, 2007 Free Software Foundation, Inc.
+ ;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Simon Josefsson <jas@pdc.kth.se>
;; Keywords: mail
;;; 1999-10-23 included in pgnus
;;; 2000-08-15 `rfc2104-hexstring-to-bitstring'
;;; 2000-05-12 added sha-1 example, added test case reference
+;;; 2003-11-13 change rfc2104-hexstring-to-bitstring to ...-byte-list
;;; Code:
(rfc2104-hex-to-int (reverse (append str nil))))
0))
-(defun rfc2104-hexstring-to-bitstring (str)
+(defun rfc2104-hexstring-to-byte-list (str)
(let (out)
(while (< 0 (length str))
(push (rfc2104-hex-to-int (substring str -2)) out)
(setq str (substring str 0 -2)))
- (concat out)))
+ out))
(defun rfc2104-hash (hash block-length hash-length key text)
(let* (;; if key is longer than B, reset it to HASH(key)
(setq k_ipad (mapcar (lambda (c) (logxor c rfc2104-ipad)) k_ipad))
(setq k_opad (mapcar (lambda (c) (logxor c rfc2104-opad)) k_opad))
;; perform outer hash
- (funcall hash (concat k_opad (rfc2104-hexstring-to-bitstring
- ;; perform inner hash
- (funcall hash (concat k_ipad text)))))))
+ (funcall hash
+ (encode-coding-string
+ (concat k_opad (rfc2104-hexstring-to-byte-list
+ ;; perform inner hash
+ (funcall hash (concat k_ipad text))))
+ 'iso-latin-1))))
(provide 'rfc2104)
;;; info.el --- info package for Emacs
;; Copyright (C) 1985, 1986, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- ;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ ;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: help
(case-fold-search t)
paragraph-markers
(not-fontified-p ; the node hasn't already been fontified
- (not (let ((where (next-property-change (point-min))))
+ (not (let ((where (next-single-property-change (point-min)
+ 'font-lock-face)))
(and where (not (= where (point-max)))))))
(fontify-visited-p ; visited nodes need to be re-fontified
(and Info-fontify-visited-nodes
;;; ccl.el --- CCL (Code Conversion Language) compiler
;; Copyright (C) 1997, 1998, 2001, 2002, 2003, 2004, 2005,
- ;; 2006, 2007 Free Software Foundation, Inc.
+ ;; 2006, 2007, 2008 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- ;; 2005, 2006, 2007
+ ;; 2005, 2006, 2007, 2008
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
;; 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)))))
+ (if (> len #xFFFFF)
+ (error "CCL: String too long: %d" len))
+ (if (> (string-bytes str) len)
+ (dotimes (i len)
+ (ccl-embed-data (logior #x1000000 (aref str i))))
+ (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.
;; Compile WRITE statement with string argument.
(defun ccl-compile-write-string (str)
- (setq str (string-as-unibyte str))
(let ((len (length str)))
(ccl-embed-code 'write-const-string 1 len)
(ccl-embed-string len str))
(ccl-embed-code 'write-const-jump 0 ccl-loop-head)
(ccl-embed-data arg))
((stringp arg)
- (setq arg (string-as-unibyte arg))
(let ((len (length arg))
(i 0))
(ccl-embed-code 'write-string-jump 0 ccl-loop-head)
(error "CCL: Invalid number of arguments: %s" cmd))
(let ((rrr (nth 1 cmd)))
(cond ((integerp rrr)
- (ccl-embed-code 'write-const-string 0 rrr))
+ (if (> rrr #xFFFFF)
+ (ccl-compile-write-string (string rrr))
+ (ccl-embed-code 'write-const-string 0 rrr)))
((stringp rrr)
(ccl-compile-write-string rrr))
((and (symbolp rrr) (vectorp (nth 2 cmd)))
(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))))
+ (if (/= (logand code #x1000000) 0)
+ (progn
+ (insert (logand code #xFFFFFF))
+ (setq i (1+ i)))
+ (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)
MAP-SET := MAP-IDs | (MAP-IDs) MAP-SET
MAP-ID := integer
"
- `(let ((prog ,(ccl-compile (eval ccl-program))))
+ `(let ((prog ,(unwind-protect
+ (progn
+ ;; To make ,(charset-id CHARSET) works well.
+ (fset 'charset-id 'charset-id-internal)
+ (ccl-compile (eval ccl-program)))
+ (fmakunbound 'charset-id))))
(defconst ,name prog ,doc)
(put ',name 'ccl-program-idx (register-ccl-program ',name prog))
nil))
;;; characters.el --- set syntax and category for multibyte characters
- ;; Copyright (C) 1997, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ ;; Copyright (C) 1997, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
;; Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- ;; 2005, 2006, 2007
+ ;; 2005, 2006, 2007, 2008
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
+;; Copyright (C) 2003
+;; National Institute of Advanced Industrial Science and Technology (AIST)
+;; Registration Number H13PRO009
;; Keywords: multibyte character, character set, syntax, category
;;; Commentary:
-;; This file contains multibyte characters. Save this file always in
-;; the coding system `iso-2022-7bit'.
-
-;; This file does not define the syntax for Latin-N character sets;
-;; those are defined by the files latin-N.el.
-
;;; Code:
-;; We must set utf-translate-cjk-mode to nil while loading this file
-;; to avoid translating CJK characters in decode-char.
-(defvar saved-utf-translate-cjk-mode utf-translate-cjk-mode)
-(setq utf-translate-cjk-mode nil)
-
;;; Predefined categories.
;; For each character set.
(define-category ?1 "base (independent) vowel")
(define-category ?2 "upper diacritical mark (including upper vowel)")
(define-category ?3 "lower diacritical mark (including lower vowel)")
-(define-category ?4 "tone mark")
+(define-category ?4 "combining tone mark")
(define-category ?5 "symbol")
(define-category ?6 "digit")
(define-category ?7 "vowel-modifying diacritical mark")
;; ASCII
-(let ((ch 32))
- (while (< ch 127) ; All ASCII characters have
- (modify-category-entry ch ?a) ; the category `a' (ASCII)
- (modify-category-entry ch ?l) ; and `l' (Latin).
- (setq ch (1+ ch))))
+;; All ASCII characters have the category `a' (ASCII) and `l' (Latin).
+(modify-category-entry '(32 . 127) ?a)
+(modify-category-entry '(32 . 127) ?l)
-;; Arabic character set
+;; Deal with the CJK charsets first. Since the syntax of blocks is
+;; defined per charset, and the charsets may contain e.g. Latin
+;; characters, we end up with the wrong syntax definitions if we're
+;; not careful.
-(let ((charsets '(arabic-iso8859-6
- arabic-digit
- arabic-1-column
- arabic-2-column)))
- (while charsets
-;; (modify-syntax-entry (make-char (car charsets)) "w")
- (modify-category-entry (make-char (car charsets)) ?b)
- (setq charsets (cdr charsets))))
-(let ((ch #x600))
- (while (<= ch #x6ff)
- (modify-category-entry (decode-char 'ucs ch) ?b)
- (setq ch (1+ ch)))
- (setq ch #xfb50)
- (while (<= ch #xfdff)
- (modify-category-entry (decode-char 'ucs ch) ?b)
- (setq ch (1+ ch)))
- (setq ch #xfe70)
- (while (<= ch #xfefe)
- (modify-category-entry (decode-char 'ucs ch) ?b)
- (setq ch (1+ ch))))
-
-;; Chinese character set (GB2312)
-
-;; (modify-syntax-entry (make-char 'chinese-gb2312) "w")
-(modify-syntax-entry (make-char 'chinese-gb2312 33) "_")
-(modify-syntax-entry (make-char 'chinese-gb2312 34) "_")
-(modify-syntax-entry (make-char 'chinese-gb2312 41) "_")
-(modify-syntax-entry ?\\e$A!2\e(B "(\e$A!3\e(B")
-(modify-syntax-entry ?\\e$A!4\e(B "(\e$A!5\e(B")
-(modify-syntax-entry ?\\e$A!6\e(B "(\e$A!7\e(B")
-(modify-syntax-entry ?\\e$A!8\e(B "(\e$A!9\e(B")
-(modify-syntax-entry ?\\e$A!:\e(B "(\e$A!;\e(B")
-(modify-syntax-entry ?\\e$A!<\e(B "(\e$A!=\e(B")
-(modify-syntax-entry ?\\e$A!>\e(B "(\e$A!?\e(B")
-(modify-syntax-entry ?\\e$A#(\e(B "(\e$A#)\e(B")
-(modify-syntax-entry ?\\e$A#{\e(B "(\e$A#}\e(B")
-(modify-syntax-entry ?\\e$A#[\e(B "(\e$A#]\e(B")
-(modify-syntax-entry ?\\e$A!3\e(B ")\e$A!2\e(B")
-(modify-syntax-entry ?\\e$A!5\e(B ")\e$A!4\e(B")
-(modify-syntax-entry ?\\e$A!7\e(B ")\e$A!6\e(B")
-(modify-syntax-entry ?\\e$A!9\e(B ")\e$A!8\e(B")
-(modify-syntax-entry ?\\e$A!;\e(B ")\e$A!:\e(B")
-(modify-syntax-entry ?\\e$A!=\e(B ")\e$A!<\e(B")
-(modify-syntax-entry ?\\e$A!?\e(B ")\e$A!>\e(B")
-(modify-syntax-entry ?\\e$A#)\e(B ")\e$A#(\e(B")
-(modify-syntax-entry ?\\e$A#}\e(B ")\e$A#{\e(B")
-(modify-syntax-entry ?\\e$A#]\e(B ")\e$A#[\e(B")
-
-(let ((chars "\e$A#,!"!##.!$#;#:#?#!!C!-!'#|#_!.!/!0!1#"!e#`!d\e(B"))
- (dotimes (i (length chars))
- (modify-syntax-entry (aref chars i) ".")))
-
-(modify-category-entry (make-char 'chinese-gb2312) ?c)
-(modify-category-entry (make-char 'chinese-gb2312) ?\|)
-(modify-category-entry (make-char 'chinese-gb2312 35) ?A)
-(modify-category-entry (make-char 'chinese-gb2312 36) ?H)
-(modify-category-entry (make-char 'chinese-gb2312 37) ?K)
-(modify-category-entry (make-char 'chinese-gb2312 38) ?G)
-(modify-category-entry (make-char 'chinese-gb2312 39) ?Y)
-(let ((row 48))
- (while (< row 127)
- (modify-category-entry (make-char 'chinese-gb2312 row) ?C)
- (setq row (1+ row))))
-
-(let ((tbl (standard-case-table)))
- (dotimes (i 26)
- (set-case-syntax-pair (make-char 'chinese-gb2312 #x23 (+ #x41 i))
- (make-char 'chinese-gb2312 #x23 (+ #x61 i)) tbl))
- (dotimes (i 24)
- (set-case-syntax-pair (make-char 'chinese-gb2312 #x26 (+ #x21 i))
- (make-char 'chinese-gb2312 #x26 (+ #x41 i)) tbl))
- (dotimes (i 33)
- (set-case-syntax-pair (make-char 'chinese-gb2312 #x27 (+ #x21 i))
- (make-char 'chinese-gb2312 #x27 (+ #x51 i)) tbl)))
-
-;; Chinese character set (BIG5)
-
-(let ((from (decode-big5-char #xA141))
- (to (decode-big5-char #xA15D)))
- (while (< from to)
- (modify-syntax-entry from ".")
- (setq from (1+ from))))
-(let ((from (decode-big5-char #xA1A5))
- (to (decode-big5-char #xA1AD)))
- (while (< from to)
- (modify-syntax-entry from ".")
- (setq from (1+ from))))
-(let ((from (decode-big5-char #xA1AD))
- (to (decode-big5-char #xA2AF)))
- (while (< from to)
- (modify-syntax-entry from "_")
- (setq from (1+ from))))
-
-(let ((parens "\e$(0!>!?!@!A!B!C!D!E!F!G!H!I!J!K!L!M!N!O!P!Q!R!S!T!U!V!W!X!Y!Z![!\!]!^!_!`!a!b!c\e(B")
- open close)
- (dotimes (i (/ (length parens) 2))
- (setq open (aref parens (* i 2))
- close (aref parens (1+ (* i 2))))
- (modify-syntax-entry open (format "(%c" close))
- (modify-syntax-entry close (format ")%c" open))))
+;; Chinese characters (Unicode)
+(modify-category-entry '(#x2E80 . #x312F) ?|)
+(modify-category-entry '(#x3190 . #x33FF) ?|)
+(modify-category-entry '(#x3400 . #x9FAF) ?C)
+(modify-category-entry '(#x3400 . #x9FAF) ?c)
+(modify-category-entry '(#x3400 . #x9FAF) ?|)
+(modify-category-entry '(#xF900 . #xFAFF) ?C)
+(modify-category-entry '(#xF900 . #xFAFF) ?c)
+(modify-category-entry '(#xF900 . #xFAFF) ?|)
+(modify-category-entry '(#x20000 . #x2AFFF) ?|)
+(modify-category-entry '(#x2F800 . #x2FFFF) ?|)
-(let ((generic-big5-1-char (make-char 'chinese-big5-1))
- (generic-big5-2-char (make-char 'chinese-big5-2)))
-;; (modify-syntax-entry generic-big5-1-char "w")
-;; (modify-syntax-entry generic-big5-2-char "w")
- (modify-category-entry generic-big5-1-char ?c)
- (modify-category-entry generic-big5-2-char ?c)
+;; Chinese character set (GB2312)
- (modify-category-entry generic-big5-1-char ?C)
- (modify-category-entry generic-big5-2-char ?C)
+(map-charset-chars #'modify-syntax-entry 'chinese-gb2312 "_" #x2121 #x217E)
+(map-charset-chars #'modify-syntax-entry 'chinese-gb2312 "_" #x2221 #x227E)
+(map-charset-chars #'modify-syntax-entry 'chinese-gb2312 "_" #x2921 #x297E)
- (modify-category-entry generic-big5-1-char ?\|)
- (modify-category-entry generic-big5-2-char ?\|))
+(map-charset-chars #'modify-category-entry 'chinese-gb2312 ?c)
+(map-charset-chars #'modify-category-entry 'chinese-gb2312 ?A #x2330 #x2339)
+(map-charset-chars #'modify-category-entry 'chinese-gb2312 ?A #x2341 #x235A)
+(map-charset-chars #'modify-category-entry 'chinese-gb2312 ?A #x2361 #x237A)
+(map-charset-chars #'modify-category-entry 'chinese-gb2312 ?H #x2421 #x247E)
+(map-charset-chars #'modify-category-entry 'chinese-gb2312 ?K #x2521 #x257E)
+(map-charset-chars #'modify-category-entry 'chinese-gb2312 ?G #x2621 #x267E)
+(map-charset-chars #'modify-category-entry 'chinese-gb2312 ?Y #x2721 #x277E)
+(map-charset-chars #'modify-category-entry 'chinese-gb2312 ?C #x3021 #x7E7E)
-(let ((tbl (standard-case-table)))
- (dotimes (i 22)
- (set-case-syntax-pair (decode-big5-char (+ #xA2CF i))
- (decode-big5-char (+ #xA2CF i 26)) tbl))
- (dotimes (i 4)
- (set-case-syntax-pair (decode-big5-char (+ #xA2E4 i))
- (decode-big5-char (+ #xA340 i)) tbl))
- (dotimes (i 24)
- (set-case-syntax-pair (decode-big5-char (+ #xA344 i))
- (decode-big5-char (+ #xA344 i 24)) tbl)))
+;; Chinese character set (BIG5)
+(map-charset-chars #'modify-category-entry 'big5 ?c)
+(map-charset-chars #'modify-category-entry 'big5 ?C #xA259 #xA25F)
+(map-charset-chars #'modify-category-entry 'big5 ?C #xA440 #xC67E)
+(map-charset-chars #'modify-category-entry 'big5 ?C #xC940 #xF9DF)
;; Chinese character set (CNS11643)
-(let ((cns-list '(chinese-cns11643-1
- chinese-cns11643-2
- chinese-cns11643-3
- chinese-cns11643-4
- chinese-cns11643-5
- chinese-cns11643-6
- chinese-cns11643-7))
- generic-char)
- (while cns-list
- (setq generic-char (make-char (car cns-list)))
-;; (modify-syntax-entry generic-char "w")
- (modify-category-entry generic-char ?c)
- (modify-category-entry generic-char ?C)
- (modify-category-entry generic-char ?|)
- (setq cns-list (cdr cns-list))))
-
-(let ((parens "\e$(G!>!?!@!A!B!C!D!E!F!G!H!I!J!K!L!M!N!O!P!Q!R!S!T!U!V!W!X!Y!Z![!\!]!^!_!`!a!b!c\e(B")
- open close)
- (dotimes (i (/ (length parens) 2))
- (setq open (aref parens (* i 2))
- close (aref parens (1+ (* i 2))))
- (modify-syntax-entry open (format "(%c" close))
- (modify-syntax-entry close (format ")%c" open))))
+(dolist (c '(chinese-cns11643-1 chinese-cns11643-2 chinese-cns11643-3
+ chinese-cns11643-4 chinese-cns11643-5 chinese-cns11643-6
+ chinese-cns11643-7))
+ (map-charset-chars #'modify-category-entry c ?c)
+ (if (eq c 'chinese-cns11643-1)
+ (map-charset-chars #'modify-category-entry c ?C #x4421 #x7E7E)
+ (map-charset-chars #'modify-category-entry c ?C)))
-;; Cyrillic character set (ISO-8859-5)
+;; Japanese character set (JISX0201, JISX0208, JISX0212, JISX0213)
-(modify-category-entry (make-char 'cyrillic-iso8859-5) ?y)
-
-(modify-syntax-entry (make-char 'cyrillic-iso8859-5 160) " ")
-(modify-syntax-entry ?\e,L-\e(B ".")
-(modify-syntax-entry ?\e,Lp\e(B ".")
-(modify-syntax-entry ?\e,L}\e(B ".")
-(let ((tbl (standard-case-table)))
- (set-case-syntax-pair ?\e,L!\e(B ?\e,Lq\e(B tbl)
- (set-case-syntax-pair ?\e,L"\e(B ?\e,Lr\e(B tbl)
- (set-case-syntax-pair ?\e,L#\e(B ?\e,Ls\e(B tbl)
- (set-case-syntax-pair ?\e,L$\e(B ?\e,Lt\e(B tbl)
- (set-case-syntax-pair ?\e,L%\e(B ?\e,Lu\e(B tbl)
- (set-case-syntax-pair ?\e,L&\e(B ?\e,Lv\e(B tbl)
- (set-case-syntax-pair ?\e,L'\e(B ?\e,Lw\e(B tbl)
- (set-case-syntax-pair ?\e,L(\e(B ?\e,Lx\e(B tbl)
- (set-case-syntax-pair ?\e,L)\e(B ?\e,Ly\e(B tbl)
- (set-case-syntax-pair ?\e,L*\e(B ?\e,Lz\e(B tbl)
- (set-case-syntax-pair ?\e,L+\e(B ?\e,L{\e(B tbl)
- (set-case-syntax-pair ?\e,L,\e(B ?\e,L|\e(B tbl)
- (set-case-syntax-pair ?\e,L.\e(B ?\e,L~\e(B tbl)
- (set-case-syntax-pair ?\e,L/\e(B ?\e,L\7f\e(B tbl)
- (set-case-syntax-pair ?\e,L0\e(B ?\e,LP\e(B tbl)
- (set-case-syntax-pair ?\e,L1\e(B ?\e,LQ\e(B tbl)
- (set-case-syntax-pair ?\e,L2\e(B ?\e,LR\e(B tbl)
- (set-case-syntax-pair ?\e,L3\e(B ?\e,LS\e(B tbl)
- (set-case-syntax-pair ?\e,L4\e(B ?\e,LT\e(B tbl)
- (set-case-syntax-pair ?\e,L5\e(B ?\e,LU\e(B tbl)
- (set-case-syntax-pair ?\e,L6\e(B ?\e,LV\e(B tbl)
- (set-case-syntax-pair ?\e,L7\e(B ?\e,LW\e(B tbl)
- (set-case-syntax-pair ?\e,L8\e(B ?\e,LX\e(B tbl)
- (set-case-syntax-pair ?\e,L9\e(B ?\e,LY\e(B tbl)
- (set-case-syntax-pair ?\e,L:\e(B ?\e,LZ\e(B tbl)
- (set-case-syntax-pair ?\e,L;\e(B ?\e,L[\e(B tbl)
- (set-case-syntax-pair ?\e,L<\e(B ?\e,L\\e(B tbl)
- (set-case-syntax-pair ?\e,L=\e(B ?\e,L]\e(B tbl)
- (set-case-syntax-pair ?\e,L>\e(B ?\e,L^\e(B tbl)
- (set-case-syntax-pair ?\e,L?\e(B ?\e,L_\e(B tbl)
- (set-case-syntax-pair ?\e,L@\e(B ?\e,L`\e(B tbl)
- (set-case-syntax-pair ?\e,LA\e(B ?\e,La\e(B tbl)
- (set-case-syntax-pair ?\e,LB\e(B ?\e,Lb\e(B tbl)
- (set-case-syntax-pair ?\e,LC\e(B ?\e,Lc\e(B tbl)
- (set-case-syntax-pair ?\e,LD\e(B ?\e,Ld\e(B tbl)
- (set-case-syntax-pair ?\e,LE\e(B ?\e,Le\e(B tbl)
- (set-case-syntax-pair ?\e,LF\e(B ?\e,Lf\e(B tbl)
- (set-case-syntax-pair ?\e,LG\e(B ?\e,Lg\e(B tbl)
- (set-case-syntax-pair ?\e,LH\e(B ?\e,Lh\e(B tbl)
- (set-case-syntax-pair ?\e,LI\e(B ?\e,Li\e(B tbl)
- (set-case-syntax-pair ?\e,LJ\e(B ?\e,Lj\e(B tbl)
- (set-case-syntax-pair ?\e,LK\e(B ?\e,Lk\e(B tbl)
- (set-case-syntax-pair ?\e,LL\e(B ?\e,Ll\e(B tbl)
- (set-case-syntax-pair ?\e,LM\e(B ?\e,Lm\e(B tbl)
- (set-case-syntax-pair ?\e,LN\e(B ?\e,Ln\e(B tbl)
- (set-case-syntax-pair ?\e,LO\e(B ?\e,Lo\e(B tbl)
- (set-case-syntax-pair ?\e$,1(!\e(B ?\e$,1(q\e(B tbl)
- (set-case-syntax-pair ?\e$,1("\e(B ?\e$,1(r\e(B tbl)
- (set-case-syntax-pair ?\e$,1(#\e(B ?\e$,1(s\e(B tbl)
- (set-case-syntax-pair ?\e$,1($\e(B ?\e$,1(t\e(B tbl)
- (set-case-syntax-pair ?\e$,1(%\e(B ?\e$,1(u\e(B tbl)
- (set-case-syntax-pair ?\e$,1(&\e(B ?\e$,1(v\e(B tbl)
- (set-case-syntax-pair ?\e$,1('\e(B ?\e$,1(w\e(B tbl)
- (set-case-syntax-pair ?\e$,1((\e(B ?\e$,1(x\e(B tbl)
- (set-case-syntax-pair ?\e$,1()\e(B ?\e$,1(y\e(B tbl)
- (set-case-syntax-pair ?\e$,1(*\e(B ?\e$,1(z\e(B tbl)
- (set-case-syntax-pair ?\e$,1(+\e(B ?\e$,1({\e(B tbl)
- (set-case-syntax-pair ?\e$,1(,\e(B ?\e$,1(|\e(B tbl)
- (set-case-syntax-pair ?\e$,1(.\e(B ?\e$,1(~\e(B tbl)
- (set-case-syntax-pair ?\e$,1(/\e(B ?\e$,1(\7f\e(B tbl)
- (set-case-syntax-pair ?\e$,1(0\e(B ?\e$,1(P\e(B tbl)
- (set-case-syntax-pair ?\e$,1(1\e(B ?\e$,1(Q\e(B tbl)
- (set-case-syntax-pair ?\e$,1(2\e(B ?\e$,1(R\e(B tbl)
- (set-case-syntax-pair ?\e$,1(3\e(B ?\e$,1(S\e(B tbl)
- (set-case-syntax-pair ?\e$,1(4\e(B ?\e$,1(T\e(B tbl)
- (set-case-syntax-pair ?\e$,1(5\e(B ?\e$,1(U\e(B tbl)
- (set-case-syntax-pair ?\e$,1(6\e(B ?\e$,1(V\e(B tbl)
- (set-case-syntax-pair ?\e$,1(7\e(B ?\e$,1(W\e(B tbl)
- (set-case-syntax-pair ?\e$,1(8\e(B ?\e$,1(X\e(B tbl)
- (set-case-syntax-pair ?\e$,1(9\e(B ?\e$,1(Y\e(B tbl)
- (set-case-syntax-pair ?\e$,1(:\e(B ?\e$,1(Z\e(B tbl)
- (set-case-syntax-pair ?\e$,1(;\e(B ?\e$,1([\e(B tbl)
- (set-case-syntax-pair ?\e$,1(<\e(B ?\e$,1(\\e(B tbl)
- (set-case-syntax-pair ?\e$,1(=\e(B ?\e$,1(]\e(B tbl)
- (set-case-syntax-pair ?\e$,1(>\e(B ?\e$,1(^\e(B tbl)
- (set-case-syntax-pair ?\e$,1(?\e(B ?\e$,1(_\e(B tbl)
- (set-case-syntax-pair ?\e$,1(@\e(B ?\e$,1(`\e(B tbl)
- (set-case-syntax-pair ?\e$,1(A\e(B ?\e$,1(a\e(B tbl)
- (set-case-syntax-pair ?\e$,1(B\e(B ?\e$,1(b\e(B tbl)
- (set-case-syntax-pair ?\e$,1(C\e(B ?\e$,1(c\e(B tbl)
- (set-case-syntax-pair ?\e$,1(D\e(B ?\e$,1(d\e(B tbl)
- (set-case-syntax-pair ?\e$,1(E\e(B ?\e$,1(e\e(B tbl)
- (set-case-syntax-pair ?\e$,1(F\e(B ?\e$,1(f\e(B tbl)
- (set-case-syntax-pair ?\e$,1(G\e(B ?\e$,1(g\e(B tbl)
- (set-case-syntax-pair ?\e$,1(H\e(B ?\e$,1(h\e(B tbl)
- (set-case-syntax-pair ?\e$,1(I\e(B ?\e$,1(i\e(B tbl)
- (set-case-syntax-pair ?\e$,1(J\e(B ?\e$,1(j\e(B tbl)
- (set-case-syntax-pair ?\e$,1(K\e(B ?\e$,1(k\e(B tbl)
- (set-case-syntax-pair ?\e$,1(L\e(B ?\e$,1(l\e(B tbl)
- (set-case-syntax-pair ?\e$,1(M\e(B ?\e$,1(m\e(B tbl)
- (set-case-syntax-pair ?\e$,1(N\e(B ?\e$,1(n\e(B tbl)
- (set-case-syntax-pair ?\e$,1(O\e(B ?\e$,1(o\e(B tbl))
-
-;; Devanagari character set
-
-;;; Commented out since the categories appear not to be used anywhere
-;;; and word syntax is the default.
-;; (let ((deflist '(;; chars syntax category
-;; ("\e$(5!!!"!#\e(B" "w" ?7) ; vowel-modifying diacritical mark
-;; ; chandrabindu, anuswar, visarga
-;; ("\e$(5!$\e(B-\e$(5!2\e(B" "w" ?1) ; independent vowel
-;; ("\e$(5!3\e(B-\e$(5!X\e(B" "w" ?0) ; consonant
-;; ("\e$(5!Z\e(B-\e$(5!g\e(B" "w" ?8) ; matra
-;; ("\e$(5!q\e(B-\e$(5!z\e(B" "w" ?6) ; digit
-;; ;; Unicode equivalents
-;; ("\e$,15A5B5C\e(B" "w" ?7) ; vowel-modifying diacritical mark
-;; ; chandrabindu, anuswar, visarga
-;; ("\e$,15E\e(B-\e$,15M\e(B" "w" ?1) ; independent vowel
-;; ("\e$,15U\e(B-\e$,15y\e(B" "w" ?0) ; consonant
-;; ("\e$,15~\e(B-\e$,16)\e(B" "w" ?8) ; matra
-;; ("\e$,16F\e(B-\e$,16O\e(B" "w" ?6) ; digit
-;; ))
-;; elm chars len syntax category to ch i)
-;; (while deflist
-;; (setq elm (car deflist))
-;; (setq chars (car elm)
-;; len (length chars)
-;; syntax (nth 1 elm)
-;; category (nth 2 elm)
-;; i 0)
-;; (while (< i len)
-;; (if (= (aref chars i) ?-)
-;; (setq i (1+ i)
-;; to (aref chars i))
-;; (setq ch (aref chars i)
-;; to ch))
-;; (while (<= ch to)
-;; (modify-syntax-entry ch syntax)
-;; (modify-category-entry ch category)
-;; (setq ch (1+ ch)))
-;; (setq i (1+ i)))
-;; (setq deflist (cdr deflist))))
+(map-charset-chars #'modify-category-entry 'katakana-jisx0201 ?k)
-;; Ethiopic character set
+(map-charset-chars #'modify-category-entry 'latin-jisx0201 ?r)
-(modify-category-entry (make-char 'ethiopic) ?e)
-;; (modify-syntax-entry (make-char 'ethiopic) "w")
-(dotimes (i (1+ (- #x137c #x1200)))
- (modify-category-entry (decode-char 'ucs (+ #x1200 i)) ?e))
-(let ((chars '(?\e$(3$h\e(B ?\e$(3$i\e(B ?\e$(3$j\e(B ?\e$(3$k\e(B ?\e$(3$l\e(B ?\e$(3$m\e(B ?\e$(3$n\e(B ?\e$(3$o\e(B ?\e$(3%i\e(B ?\e$(3%t\e(B ?\e$(3%u\e(B ?\e$(3%v\e(B ?\e$(3%w\e(B ?\e$(3%x\e(B
- ;; Unicode equivalents of the above:
- ?\e$,1Q!\e(B ?\e$,1Q"\e(B ?\e$,1Q#\e(B ?\e$,1Q$\e(B ?\e$,1Q%\e(B ?\e$,1Q&\e(B ?\e$,1Q'\e(B ?\e$,1Q(\e(B ?\e$,3op\e(B ?\e$,3o{\e(B ?\e$,3o|\e(B ?\e$,3o}\e(B ?\e$,3o~\e(B ?\e$,3o\7f\e(B)))
- (while chars
- (modify-syntax-entry (car chars) ".")
- (setq chars (cdr chars))))
-
-;; Greek character set (ISO-8859-7)
-
-(modify-category-entry (make-char 'greek-iso8859-7) ?g)
-(let ((c #x370))
- (while (<= c #x3ff)
- (modify-category-entry (decode-char 'ucs c) ?g)
- (setq c (1+ c))))
-
-;; (let ((c 182))
-;; (while (< c 255)
-;; (modify-syntax-entry (make-char 'greek-iso8859-7 c) "w")
-;; (setq c (1+ c))))
-;; (modify-syntax-entry (make-char 'greek-iso8859-7 160) "w") ; NBSP
-(modify-syntax-entry ?\e,F7\e(B ".")
-(modify-syntax-entry ?\e,F;\e(B ".")
-(modify-syntax-entry ?\e,F=\e(B ".")
-(let ((tbl (standard-case-table)))
- ;; Fixme: non-letter syntax copied from latin-1, but that's dubious
- ;; in several cases.
- (set-case-syntax ?\e,F!\e(B "." tbl)
- (set-case-syntax ?\e,F"\e(B "." tbl)
- (set-case-syntax ?\e,F&\e(B "." tbl)
- (set-case-syntax ?\e,F&\e(B "_" tbl)
- (set-case-syntax ?\e,F'\e(B "." tbl)
- (set-case-syntax ?\e,F)\e(B "_" tbl)
- (set-case-syntax ?\e,F+\e(B "." tbl)
- (set-case-syntax ?\e,F,\e(B "_" tbl)
- (set-case-syntax ?\e,F-\e(B "_" tbl)
- (set-case-syntax ?\e,F/\e(B "." tbl)
- (set-case-syntax ?\e,F0\e(B "_" tbl)
- (set-case-syntax ?\e,F1\e(B "_" tbl)
-;; (set-case-syntax ?\e,F7\e(B "_" tbl)
-;; (set-case-syntax ?\e,F=\e(B "_" tbl)
- (set-case-syntax-pair ?\e,FA\e(B ?\e,Fa\e(B tbl)
- (set-case-syntax-pair ?\e,FB\e(B ?\e,Fb\e(B tbl)
- (set-case-syntax-pair ?\e,FC\e(B ?\e,Fc\e(B tbl)
- (set-case-syntax-pair ?\e,FD\e(B ?\e,Fd\e(B tbl)
- (set-case-syntax-pair ?\e,FE\e(B ?\e,Fe\e(B tbl)
- (set-case-syntax-pair ?\e,FF\e(B ?\e,Ff\e(B tbl)
- (set-case-syntax-pair ?\e,FG\e(B ?\e,Fg\e(B tbl)
- (set-case-syntax-pair ?\e,FH\e(B ?\e,Fh\e(B tbl)
- (set-case-syntax-pair ?\e,FI\e(B ?\e,Fi\e(B tbl)
- (set-case-syntax-pair ?\e,FJ\e(B ?\e,Fj\e(B tbl)
- (set-case-syntax-pair ?\e,FK\e(B ?\e,Fk\e(B tbl)
- (set-case-syntax-pair ?\e,FL\e(B ?\e,Fl\e(B tbl)
- (set-case-syntax-pair ?\e,FM\e(B ?\e,Fm\e(B tbl)
- (set-case-syntax-pair ?\e,FN\e(B ?\e,Fn\e(B tbl)
- (set-case-syntax-pair ?\e,FO\e(B ?\e,Fo\e(B tbl)
- (set-case-syntax-pair ?\e,FP\e(B ?\e,Fp\e(B tbl)
- (set-case-syntax-pair ?\e,FQ\e(B ?\e,Fq\e(B tbl)
- (set-upcase-syntax ?\e,FS\e(B ?\e,Fr\e(B tbl)
- (set-case-syntax-pair ?\e,FS\e(B ?\e,Fs\e(B tbl)
- (set-case-syntax-pair ?\e,FT\e(B ?\e,Ft\e(B tbl)
- (set-case-syntax-pair ?\e,FU\e(B ?\e,Fu\e(B tbl)
- (set-case-syntax-pair ?\e,FV\e(B ?\e,Fv\e(B tbl)
- (set-case-syntax-pair ?\e,FW\e(B ?\e,Fw\e(B tbl)
- (set-case-syntax-pair ?\e,FX\e(B ?\e,Fx\e(B tbl)
- (set-case-syntax-pair ?\e,FY\e(B ?\e,Fy\e(B tbl)
- (set-case-syntax-pair ?\e,FZ\e(B ?\e,Fz\e(B tbl)
- (set-case-syntax-pair ?\e,F[\e(B ?\e,F{\e(B tbl)
- (set-case-syntax-pair ?\e,F?\e(B ?\e,F~\e(B tbl)
- (set-case-syntax-pair ?\e,F>\e(B ?\e,F}\e(B tbl)
- (set-case-syntax-pair ?\e,F<\e(B ?\e,F|\e(B tbl)
- (set-case-syntax-pair ?\e,F6\e(B ?\e,F\\e(B tbl)
- (set-case-syntax-pair ?\e,F8\e(B ?\e,F]\e(B tbl)
- (set-case-syntax-pair ?\e,F9\e(B ?\e,F^\e(B tbl)
- (set-case-syntax-pair ?\e,F:\e(B ?\e,F_\e(B tbl)
- ;; Unicode equivalents
- (set-case-syntax-pair ?\e$,1&q\e(B ?\e$,1'1\e(B tbl)
- (set-case-syntax-pair ?\e$,1&r\e(B ?\e$,1'2\e(B tbl)
- (set-case-syntax-pair ?\e$,1&s\e(B ?\e$,1'3\e(B tbl)
- (set-case-syntax-pair ?\e$,1&t\e(B ?\e$,1'4\e(B tbl)
- (set-case-syntax-pair ?\e$,1&u\e(B ?\e$,1'5\e(B tbl)
- (set-case-syntax-pair ?\e$,1&v\e(B ?\e$,1'6\e(B tbl)
- (set-case-syntax-pair ?\e$,1&w\e(B ?\e$,1'7\e(B tbl)
- (set-case-syntax-pair ?\e$,1&x\e(B ?\e$,1'8\e(B tbl)
- (set-case-syntax-pair ?\e$,1&y\e(B ?\e$,1'9\e(B tbl)
- (set-case-syntax-pair ?\e$,1&z\e(B ?\e$,1':\e(B tbl)
- (set-case-syntax-pair ?\e$,1&{\e(B ?\e$,1';\e(B tbl)
- (set-case-syntax-pair ?\e$,1&|\e(B ?\e$,1'<\e(B tbl)
- (set-case-syntax-pair ?\e$,1&}\e(B ?\e$,1'=\e(B tbl)
- (set-case-syntax-pair ?\e$,1&~\e(B ?\e$,1'>\e(B tbl)
- (set-case-syntax-pair ?\e$,1&\7f\e(B ?\e$,1'?\e(B tbl)
- (set-case-syntax-pair ?\e$,1' \e(B ?\e$,1'@\e(B tbl)
- (set-case-syntax-pair ?\e$,1'!\e(B ?\e$,1'A\e(B tbl)
- (set-upcase-syntax ?\e$,1'#\e(B ?\e$,1'B\e(B tbl)
- (set-case-syntax-pair ?\e$,1'#\e(B ?\e$,1'C\e(B tbl)
- (set-case-syntax-pair ?\e$,1'$\e(B ?\e$,1'D\e(B tbl)
- (set-case-syntax-pair ?\e$,1'%\e(B ?\e$,1'E\e(B tbl)
- (set-case-syntax-pair ?\e$,1'&\e(B ?\e$,1'F\e(B tbl)
- (set-case-syntax-pair ?\e$,1''\e(B ?\e$,1'G\e(B tbl)
- (set-case-syntax-pair ?\e$,1'(\e(B ?\e$,1'H\e(B tbl)
- (set-case-syntax-pair ?\e$,1')\e(B ?\e$,1'I\e(B tbl)
- (set-case-syntax-pair ?\e$,1'*\e(B ?\e$,1'J\e(B tbl)
- (set-case-syntax-pair ?\e$,1'+\e(B ?\e$,1'K\e(B tbl)
- (set-case-syntax-pair ?\e$,1&o\e(B ?\e$,1'N\e(B tbl)
- (set-case-syntax-pair ?\e$,1&n\e(B ?\e$,1'M\e(B tbl)
- (set-case-syntax-pair ?\e$,1&l\e(B ?\e$,1'L\e(B tbl)
- (set-case-syntax-pair ?\e$,1&f\e(B ?\e$,1',\e(B tbl)
- (set-case-syntax-pair ?\e$,1&h\e(B ?\e$,1'-\e(B tbl)
- (set-case-syntax-pair ?\e$,1&i\e(B ?\e$,1'.\e(B tbl)
- (set-case-syntax-pair ?\e$,1&j\e(B ?\e$,1'/\e(B tbl))
-
-;; Hebrew character set (ISO-8859-8)
-
-(modify-category-entry (make-char 'hebrew-iso8859-8) ?w)
-(let ((c #x591))
- (while (<= c #x5f4)
- (modify-category-entry (decode-char 'ucs c) ?w)
- (setq c (1+ c))))
-
-(modify-syntax-entry (make-char 'hebrew-iso8859-8 208) ".") ; PASEQ
-(modify-syntax-entry (make-char 'hebrew-iso8859-8 211) ".") ; SOF PASUQ
-(modify-syntax-entry (decode-char 'ucs #x5be) ".") ; MAQAF
-(modify-syntax-entry (decode-char 'ucs #x5c0) ".") ; PASEQ
-(modify-syntax-entry (decode-char 'ucs #x5c3) ".") ; SOF PASUQ
-(modify-syntax-entry (decode-char 'ucs #x5f3) ".") ; GERESH
-(modify-syntax-entry (decode-char 'ucs #x5f4) ".") ; GERSHAYIM
-
-;; (let ((c 224))
-;; (while (< c 251)
-;; (modify-syntax-entry (make-char 'hebrew-iso8859-8 c) "w")
-;; (setq c (1+ c))))
-;; (modify-syntax-entry (make-char 'hebrew-iso8859-8 160) "w") ; NBSP
-
-;; Indian character set (IS 13194 and other Emacs original Indian charsets)
-
-(modify-category-entry (make-char 'indian-is13194) ?i)
-(modify-category-entry (make-char 'indian-2-column) ?I)
-(modify-category-entry (make-char 'indian-glyph) ?I)
-;; Unicode Devanagari block
-(let ((c #x901))
- (while (<= c #x970)
- (modify-category-entry (decode-char 'ucs c) ?i)
- (setq c (1+ c))))
-
-(let ((l '(;; RANGE CATEGORY MEANINGS
- (#x01 #x03 ?7) ; vowel modifier
- (#x05 #x14 ?1) ; base vowel
- (#x15 #x39 ?0) ; consonants
- (#x3e #x4d ?8) ; vowel modifier
- (#x51 #x54 ?4) ; stress/tone mark
- (#x58 #x5f ?0) ; consonants
- (#x60 #x61 ?1) ; base vowel
- (#x62 #x63 ?8) ; vowel modifier
- (#x66 #x6f ?6) ; digits
- )))
- (dolist (elt1 '(#x900 #x980 #xa00 #xa80 #xb00 #xb80 #xc00 #xc80 #xd00))
- (dolist (elt2 l)
- (let* ((from (car elt2))
- (counts (1+ (- (nth 1 elt2) from)))
- (category (nth 2 elt2)))
- (dotimes (i counts)
- (modify-category-entry (decode-char 'ucs (+ elt1 from i))
- category))))))
-
-;; Japanese character set (JISX0201-kana, JISX0201-roman, JISX0208, JISX0212)
-
-(modify-category-entry (make-char 'katakana-jisx0201) ?k)
-(modify-category-entry (make-char 'katakana-jisx0201) ?j)
-(modify-category-entry (make-char 'latin-jisx0201) ?r)
-(modify-category-entry (make-char 'japanese-jisx0208) ?j)
-(modify-category-entry (make-char 'japanese-jisx0212) ?j)
-(modify-category-entry (make-char 'katakana-jisx0201) ?\|)
-(modify-category-entry (make-char 'japanese-jisx0208) ?\|)
-(modify-category-entry (make-char 'japanese-jisx0212) ?\|)
+(dolist (l '(katakana-jisx0201 japanese-jisx0208 japanese-jisx0212
+ japanese-jisx0213-1 japanese-jisx0213-2))
+ (map-charset-chars #'modify-category-entry l ?j))
;; Unicode equivalents of JISX0201-kana
-(let ((c #xff61))
- (while (<= c #xff9f)
- (modify-category-entry (decode-char 'ucs c) ?k)
- (modify-category-entry (decode-char 'ucs c) ?j)
- (modify-category-entry (decode-char 'ucs c) ?\|)
- (setq c (1+ c))))
+(let ((range '(#xff61 . #xff9f)))
+ (modify-category-entry range ?k)
+ (modify-category-entry range ?j)
+ (modify-category-entry range ?\|))
;; Katakana block
-(let ((c #x30a0))
- (while (<= c #x30ff)
- ;; ?K is double width, ?k isn't specified
- (modify-category-entry (decode-char 'ucs c) ?k)
- (modify-category-entry (decode-char 'ucs c) ?j)
- (modify-category-entry (decode-char 'ucs c) ?\|)
- (setq c (1+ c))))
+(let ((range '(#x30a0 . #x30ff)))
+ ;; ?K is double width, ?k isn't specified
+ (modify-category-entry range ?K)
+ (modify-category-entry range ?\|))
;; Hiragana block
-(let ((c #x3040))
- (while (<= c #x309f)
- ;; ?H is actually defined to be double width
- (modify-category-entry (decode-char 'ucs c) ?H)
- ;;(modify-category-entry (decode-char 'ucs c) ?j)
- (modify-category-entry (decode-char 'ucs c) ?\|)
- (setq c (1+ c))))
+(let ((range '(#x3040 . #x309d)))
+ ;; ?H is actually defined to be double width
+ ;;(modify-category-entry range ?H)
+ (modify-category-entry range ?\|)
+ )
;; JISX0208
-;; (modify-syntax-entry (make-char 'japanese-jisx0208) "w")
-(modify-syntax-entry (make-char 'japanese-jisx0208 33) "_")
-(modify-syntax-entry (make-char 'japanese-jisx0208 34) "_")
-(modify-syntax-entry (make-char 'japanese-jisx0208 40) "_")
-(let ((chars '(?\e$B!<\e(B ?\e$B!+\e(B ?\e$B!,\e(B ?\e$B!3\e(B ?\e$B!4\e(B ?\e$B!5\e(B ?\e$B!6\e(B ?\e$B!7\e(B ?\e$B!8\e(B ?\e$B!9\e(B ?\e$B!:\e(B ?\e$B!;\e(B)))
- (while chars
- (modify-syntax-entry (car chars) "w")
- (setq chars (cdr chars))))
-(let ((parens "\e$B!J!K!L!M!N!O!P!Q!R!S!T!U!V!W!X!Y!Z![\e(B" )
- open close)
- (dotimes (i (/ (length parens) 2))
- (setq open (aref parens (* i 2))
- close (aref parens (1+ (* i 2))))
- (modify-syntax-entry open (format "(%c" close))
- (modify-syntax-entry close (format ")%c" open))))
-
-(modify-category-entry (make-char 'japanese-jisx0208 35) ?A)
-(modify-category-entry (make-char 'japanese-jisx0208 36) ?H)
-(modify-category-entry (make-char 'japanese-jisx0208 37) ?K)
-(modify-category-entry (make-char 'japanese-jisx0208 38) ?G)
-(modify-category-entry (make-char 'japanese-jisx0208 39) ?Y)
-(let ((row 48))
- (while (< row 127)
- (modify-category-entry (make-char 'japanese-jisx0208 row) ?C)
- (setq row (1+ row))))
-(modify-category-entry ?\e$B!<\e(B ?K)
-(let ((chars '(?\e$B!+\e(B ?\e$B!,\e(B)))
+(map-charset-chars #'modify-syntax-entry 'japanese-jisx0208 "_" #x2121 #x227E)
+(map-charset-chars #'modify-syntax-entry 'japanese-jisx0208 "_" #x2821 #x287E)
+(let ((chars '(?ー ?ã‚› ?ã‚œ ?ヽ ?ヾ ?ã‚ ?ã‚ž ?〃 ?ä» ?々 ?〆 ?〇)))
+ (dolist (elt chars)
+ (modify-syntax-entry (car chars) "w")))
+
+(map-charset-chars #'modify-category-entry 'japanese-jisx0208 ?A #x2321 #x237E)
+(map-charset-chars #'modify-category-entry 'japanese-jisx0208 ?H #x2421 #x247E)
+(map-charset-chars #'modify-category-entry 'japanese-jisx0208 ?K #x2521 #x257E)
+(map-charset-chars #'modify-category-entry 'japanese-jisx0208 ?G #x2621 #x267E)
+(map-charset-chars #'modify-category-entry 'japanese-jisx0208 ?Y #x2721 #x277E)
+(map-charset-chars #'modify-category-entry 'japanese-jisx0208 ?C #x3021 #x7E7E)
+(modify-category-entry ?ー ?K)
+(let ((chars '(?゛ ?゜)))
(while chars
(modify-category-entry (car chars) ?K)
(modify-category-entry (car chars) ?H)
(setq chars (cdr chars))))
-(let ((chars '(?\e$B!3\e(B ?\e$B!4\e(B ?\e$B!5\e(B ?\e$B!6\e(B ?\e$B!7\e(B ?\e$B!8\e(B ?\e$B!9\e(B ?\e$B!:\e(B ?\e$B!;\e(B)))
+(let ((chars '(?ヽ ?ヾ ?ã‚ ?ã‚ž ?〃 ?ä» ?々 ?〆 ?〇)))
(while chars
(modify-category-entry (car chars) ?C)
(setq chars (cdr chars))))
-(let ((tbl (standard-case-table)))
- (dotimes (i 26)
- (set-case-syntax-pair (make-char 'japanese-jisx0208 #x23 (+ #x41 i))
- (make-char 'japanese-jisx0208 #x23 (+ #x61 i)) tbl))
- (dotimes (i 24)
- (set-case-syntax-pair (make-char 'japanese-jisx0208 #x26 (+ #x21 i))
- (make-char 'japanese-jisx0208 #x26 (+ #x41 i)) tbl))
- (dotimes (i 33)
- (set-case-syntax-pair (make-char 'japanese-jisx0208 #x27 (+ #x21 i))
- (make-char 'japanese-jisx0208 #x27 (+ #x51 i)) tbl)))
-
;; JISX0212
-;; (modify-syntax-entry (make-char 'japanese-jisx0212) "w")
-(modify-syntax-entry (make-char 'japanese-jisx0212 33) "_")
-(modify-syntax-entry (make-char 'japanese-jisx0212 34) "_")
-(modify-syntax-entry (make-char 'japanese-jisx0212 35) "_")
-(modify-category-entry (make-char 'japanese-jisx0212 ) ?C)
+(map-charset-chars #'modify-syntax-entry 'japanese-jisx0212 "_" #x2121 #x237E)
;; JISX0201-Kana
-;; (modify-syntax-entry (make-char 'katakana-jisx0201) "w")
-(let ((chars '(?\e(I!\e(B ?\e(I$\e(B ?\e(I%\e(B
- ;; Unicode:
- ?\e$,3sa\e(B ?\e$,3sd\e(B ?\e$,3se\e(B)))
+
+(let ((chars '(?｡ ?､ ?･)))
(while chars
(modify-syntax-entry (car chars) ".")
(setq chars (cdr chars))))
-(modify-syntax-entry ?\\e(I"\e(B "(\e(I#\e(B")
-(modify-syntax-entry ?\\e(I#\e(B "(\e(I"\e(B")
+(modify-syntax-entry ?\ï½¢ "(ï½£")
+(modify-syntax-entry ?\ï½£ "(ï½¢")
;; Korean character set (KSC5601)
-;; (modify-syntax-entry (make-char 'korean-ksc5601) "w")
-(modify-syntax-entry (make-char 'korean-ksc5601 33) "_")
-(modify-syntax-entry (make-char 'korean-ksc5601 34) "_")
-(modify-syntax-entry (make-char 'korean-ksc5601 38) "_")
-(modify-syntax-entry (make-char 'korean-ksc5601 39) "_")
-(modify-syntax-entry (make-char 'korean-ksc5601 40) "_")
-(modify-syntax-entry (make-char 'korean-ksc5601 41) "_")
-
-(modify-category-entry (make-char 'korean-ksc5601) ?h)
-(modify-category-entry (make-char 'korean-ksc5601 35) ?A)
-(modify-category-entry (make-char 'korean-ksc5601 37) ?G)
-(modify-category-entry (make-char 'korean-ksc5601 42) ?H)
-(modify-category-entry (make-char 'korean-ksc5601 43) ?K)
-(modify-category-entry (make-char 'korean-ksc5601 44) ?Y)
-
-(let ((parens "\e$(C!2!3!4!5!6!7!8!9!:!;!<!=#(#)#[#]#{#}\e(B" )
+(map-charset-chars #'modify-category-entry 'korean-ksc5601 ?h)
+
+(map-charset-chars #'modify-syntax-entry 'korean-ksc5601 "_" #x2121 #x227E)
+(map-charset-chars #'modify-syntax-entry 'korean-ksc5601 "_" #x2621 #x277E)
+(map-charset-chars #'modify-syntax-entry 'korean-ksc5601 "_" #x2830 #x287E)
+(map-charset-chars #'modify-syntax-entry 'korean-ksc5601 "_" #x2930 #x297E)
+(map-charset-chars #'modify-category-entry 'korean-ksc5601 ?A #x2330 #x2339)
+(map-charset-chars #'modify-category-entry 'korean-ksc5601 ?A #x2341 #x235A)
+(map-charset-chars #'modify-category-entry 'korean-ksc5601 ?A #x2361 #x237A)
+(map-charset-chars #'modify-category-entry 'korean-ksc5601 ?G #x2521 #x257E)
+(map-charset-chars #'modify-category-entry 'korean-ksc5601 ?H #x2A21 #x2A7E)
+(map-charset-chars #'modify-category-entry 'korean-ksc5601 ?K #x2B21 #x2B7E)
+(map-charset-chars #'modify-category-entry 'korean-ksc5601 ?Y #x2C21 #x2C7E)
+
+;; These are in more than one charset.
+(let ((parens (concat "〈〉《》「ã€ã€Žã€ã€ã€‘〔〕〖〗〘〙〚〛"
+ "︵︶︷︸︹︺︻︼︽︾︿﹀ï¹ï¹‚﹃﹄"
+ "（）［］｛ï½"))
open close)
(dotimes (i (/ (length parens) 2))
(setq open (aref parens (* i 2))
(modify-syntax-entry open (format "(%c" close))
(modify-syntax-entry close (format ")%c" open))))
-(let ((tbl (standard-case-table)))
- (dotimes (i 26)
- (set-case-syntax-pair (make-char 'korean-ksc5601 #x23 (+ #x41 i))
- (make-char 'korean-ksc5601 #x23 (+ #x61 i)) tbl))
- (dotimes (i 10)
- (set-case-syntax-pair (make-char 'korean-ksc5601 #x25 (+ #x21 i))
- (make-char 'korean-ksc5601 #x25 (+ #x30 i)) tbl))
- (dotimes (i 24)
- (set-case-syntax-pair (make-char 'korean-ksc5601 #x25 (+ #x41 i))
- (make-char 'korean-ksc5601 #x25 (+ #x61 i)) tbl))
- (dotimes (i 33)
- (set-case-syntax-pair (make-char 'korean-ksc5601 #x2C (+ #x21 i))
- (make-char 'korean-ksc5601 #x2C (+ #x51 i)) tbl)))
-
-;; Latin character set (latin-1,2,3,4,5,8,9)
-
-(modify-category-entry (make-char 'latin-iso8859-1) ?l)
-(modify-category-entry (make-char 'latin-iso8859-2) ?l)
-(modify-category-entry (make-char 'latin-iso8859-3) ?l)
-(modify-category-entry (make-char 'latin-iso8859-4) ?l)
-(modify-category-entry (make-char 'latin-iso8859-9) ?l)
-(modify-category-entry (make-char 'latin-iso8859-14) ?l)
-(modify-category-entry (make-char 'latin-iso8859-15) ?l)
-
-(modify-category-entry (make-char 'latin-iso8859-1 160) ?\ )
-(modify-category-entry (make-char 'latin-iso8859-2 160) ?\ )
-(modify-category-entry (make-char 'latin-iso8859-3 160) ?\ )
-(modify-category-entry (make-char 'latin-iso8859-4 160) ?\ )
-(modify-category-entry (make-char 'latin-iso8859-9 160) ?\ )
-(modify-category-entry (make-char 'latin-iso8859-14 160) ?\ )
-(modify-category-entry (make-char 'latin-iso8859-15 160) ?\ )
+;; Arabic character set
-;; Lao character set
+(let ((charsets '(arabic-iso8859-6
+ arabic-digit
+ arabic-1-column
+ arabic-2-column)))
+ (while charsets
+ (map-charset-chars #'modify-category-entry (car charsets) ?b)
+ (setq charsets (cdr charsets))))
+(modify-category-entry '(#x600 . #x6ff) ?b)
+(modify-category-entry '(#xfb50 . #xfdff) ?b)
+(modify-category-entry '(#xfe70 . #xfefe) ?b)
+
+;; Cyrillic character set (ISO-8859-5)
-(modify-category-entry (make-char 'lao) ?o)
-(dotimes (i (1+ (- #xeff #xe80)))
- (modify-category-entry (decode-char 'ucs (+ i #xe80)) ?o))
+(modify-syntax-entry ?â„– ".")
-(let ((deflist '(;; chars syntax category
- ("\e(1!\e(B-\e(1N\e(B" "w" ?0) ; consonant
- ("\e(1PRS]`\e(B-\e(1d\e(B" "w" ?1) ; vowel base
- ("\e(1QT\e(B-\e(1W[m\e(B" "w" ?2) ; vowel upper
- ("\e(1XY\e(B" "w" ?3) ; vowel lower
- ("\e(1h\e(B-\e(1l\e(B" "w" ?4) ; tone mark
- ("\e(1\\e(B" "w" ?9) ; semivowel lower
- ("\e(1p\e(B-\e(1y\e(B" "w" ?6) ; digit
- ("\e(1Of\e(B" "_" ?5) ; symbol
- ;; Unicode equivalents
- ("\e$,1D!\e(B-\e$,1DN\e(B" "w" ?0) ; consonant
- ("\e$,1DPDRDSD]D`\e(B-\e$,1Dd\e(B" "w" ?1) ; vowel base
- ("\e$,1DQDT\e(B-\e$,1DWD[Dm\e(B" "w" ?2) ; vowel upper
- ("\e$,1DXDY\e(B" "w" ?3) ; vowel lower
- ("\e$,1Dh\e(B-\e$,1Dk\e(B" "w" ?4) ; tone mark
- ("\e$,1D\D]\e(B" "w" ?9) ; semivowel lower
- ("\e$,1Dp\e(B-\e$,1Dy\e(B" "w" ?6) ; digit
- ("\e$,1DODf\e(B" "_" ?5) ; symbol
+;; Ethiopic character set
+
+(modify-category-entry '(#x1200 . #x1399) ?e)
+(modify-category-entry '(#x2d80 . #x2dde) ?e)
+(let ((chars '(?á¡ ?ᢠ?ᣠ?ᤠ?ᥠ?ᦠ?᧠?ᨠ?ö ‡€ ?ö ‡‹ ?ö ‡Œ ?ö ‡ ?ö ‡Ž ?ö ‡)))
+ (while chars
+ (modify-syntax-entry (car chars) ".")
+ (setq chars (cdr chars))))
+(map-charset-chars #'modify-category-entry 'ethiopic ?e)
+
+;; Hebrew character set (ISO-8859-8)
+
+(modify-syntax-entry #x5be ".") ; MAQAF
+(modify-syntax-entry #x5c0 ".") ; PASEQ
+(modify-syntax-entry #x5c3 ".") ; SOF PASUQ
+(modify-syntax-entry #x5f3 ".") ; GERESH
+(modify-syntax-entry #x5f4 ".") ; GERSHAYIM
+
+;; Indian character set (IS 13194 and other Emacs original Indian charsets)
+
+(modify-category-entry '(#x901 . #x970) ?i)
+(map-charset-chars #'modify-category-entry 'indian-is13194 ?i)
+(map-charset-chars #'modify-category-entry 'indian-2-column ?i)
+
+;; Lao character set
+
+(modify-category-entry '(#xe80 . #xeff) ?o)
+(map-charset-chars #'modify-category-entry 'lao ?o)
+
+(let ((deflist '(("àº-ຮ" "w" ?0) ; consonant
+ ("ະາຳຽເ-ໄ" "w" ?1) ; vowel base
+ ("ັິ-ືົà»" "w" ?2) ; vowel upper
+ ("ຸູ" "w" ?3) ; vowel lower
+ ("່-໋" "w" ?4) ; tone mark
+ ("ຼຽ" "w" ?9) ; semivowel lower
+ ("à»-à»™" "w" ?6) ; digit
+ ("ຯໆ" "_" ?5) ; symbol
))
elm chars len syntax category to ch i)
(while deflist
;; Thai character set (TIS620)
-(modify-category-entry (make-char 'thai-tis620) ?t)
-(dotimes (i (1+ (- #xe7f #xe00)))
- (modify-category-entry (decode-char 'ucs (+ i #xe00)) ?t))
+(modify-category-entry '(#xe00 . #xe7f) ?t)
+(map-charset-chars #'modify-category-entry 'thai-tis620 ?t)
(let ((deflist '(;; chars syntax category
- ("\e,T!\e(B-\e,TCEG\e(B-\e,TN\e(B" "w" ?0) ; consonant
- ("\e,TDFPRS`\e(B-\e,Te\e(B" "w" ?1) ; vowel base
- ("\e,TQT\e(B-\e,TWgn\e(B" "w" ?2) ; vowel upper
- ("\e,TX\e(B-\e,TZ\e(B" "w" ?3) ; vowel lower
- ("\e,Th\e(B-\e,Tm\e(B" "w" ?4) ; tone mark
- ("\e,Tp\e(B-\e,Ty\e(B" "w" ?6) ; digit
- ("\e,TOf_oz{\e(B" "_" ?5) ; symbol
- ;; Unicode equivalents
- ("\e$,1Ba\e(B-\e$,1C#C%C'\e(B-\e$,1C.\e(B" "w" ?0) ; consonant
- ("\e$,1C$C&C0C2C3C@\e(B-\e$,1CE\e(B" "w" ?1) ; vowel base
- ("\e$,1C1C4\e(B-\e$,1C7CGCN\e(B" "w" ?2) ; vowel upper
- ("\e$,1C8\e(B-\e$,1C:\e(B" "w" ?3) ; vowel lower
- ("\e$,1CH\e(B-\e$,1CM\e(B" "w" ?4) ; tone mark
- ("\e$,1CP\e(B-\e$,1CY\e(B" "w" ?6) ; digit
- ("\e$,1C/CFC?COCZC[\e(B" "_" ?5) ; symbol
+ ("à¸-รลว-ฮ" "w" ?0) ; consonant
+ ("ฤฦะาำเ-ๅ" "w" ?1) ; vowel base
+ ("ัิ-ื็๎" "w" ?2) ; vowel upper
+ ("ุ-ฺ" "w" ?3) ; vowel lower
+ ("่-à¹" "w" ?4) ; tone mark
+ ("à¹-๙" "w" ?6) ; digit
+ ("ฯๆ฿à¹à¹šà¹›" "_" ?5) ; symbol
))
elm chars len syntax category to ch i)
(while deflist
;; Tibetan character set
-(modify-category-entry (make-char 'tibetan) ?q)
-(modify-category-entry (make-char 'tibetan-1-column) ?q)
-(dotimes (i (1+ (- #xfff #xf00)))
- (modify-category-entry (decode-char 'ucs (+ i #xf00)) ?q))
+(modify-category-entry '(#xf00 . #xfff) ?q)
+(map-charset-chars #'modify-category-entry 'tibetan ?q)
+(map-charset-chars #'modify-category-entry 'tibetan-1-column ?q)
(let ((deflist '(;; chars syntax category
- ("\e4\e$(7"!\e0"!\e1\e(B-\e4\e$(7"J\e0"J\e1\e4"K\e0"K\e1\e(B" "w" ?0) ; consonant
- ("\e$(7#!\e(B-\e$(7#J#K#L#M!"!#\e(B" "w" ?0) ;
- ("\e$(7$!\e(B-\e$(7$e\e(B" "w" ?0) ;
- ("\e$(7%!\e(B-\e$(7%u\e(B" "w" ?0) ;
- ("\e$(7"S"["\"]"^"a\e(B" "w" ?2) ; upper vowel
- ("\e$(7"_"c"d"g"h"i"j"k"l\e(B" "w" ?2) ; upper modifier
- ("\e$(7!I"Q"R"U"e!e!g\e(B" "w" ?3) ; lowel vowel/modifier
- ("\e$(7!P\e(B-\e$(7!Y!Z\e(B-\e$(7!c\e(B" "w" ?6) ; digit
- ("\e$(7!;!=\e(B-\e$(7!B!D"`\e(B" "." ?|) ; line-break char
- ("\e$(8!;!=!?!@!A!D"`\e(B" "." ?|) ;
- ("\e$(7!8!;!=\e(B-\e$(7!B!D"`!m!d\e(B" "." ?>) ; prohibition
- ("\e$(8!;!=!?!@!A!D"`\e(B" "." ?>) ;
- ("\e$(7!0\e(B-\e$(7!:!l#R#S"f\e(B" "." ?<) ; prohibition
- ("\e$(7!C!E\e(B-\e$(7!H!J\e(B-\e$(7!O!f!h\e(B-\e$(7!k!n!o#O#P\e(B-\e$(7#`\e(B" "." ?q) ; others
-
- ;; Unicode version (not complete)
- ("\e$,1F \e(B-\e$,1FIFJ\e(B" "w" ?0) ; consonant
- ("\e$,1Fp\e(B-\e$,1G9G:G;G<\e(B" "w" ?0) ;
- ("\e$,1FRFZF[F\F]F`\e(B" "w" ?2) ; upper vowel
- ("\e$,1F^FbFcFfFgFhFiFjFk\e(B" "w" ?2) ; upper modifier
- ("\e$,1EYFPFQFTFdEuEw\e(B" "w" ?3) ; lowel vowel/modifier
- ("\e$,1E`\e(B-\e$,1EiEj\e(B-\e$,1Es\e(B" "w" ?6) ; digit
- ("\e$,1EKEM\e(B-\e$,1ERETF_\e(B" "." ?|) ; line-break char
- ("\e$,1EHEKEM\e(B-\e$,1ERETF_E}Et\e(B" "." ?>) ; prohibition
- ("\e$,1E@\e(B-\e$,1EJE|GAGBFe\e(B" "." ?<) ; prohibition
- ("\e$,1ESEU\e(B-\e$,1EXEZ\e(B-\e$,1E_EvEx\e(B-\e$,1E{E~E\7fG>G?\e(B-\e$,1GO\e(B" "." ?q) ; others
+ ("ཀ-ཀྵཪ" "w" ?0) ; consonant
+ ("à¾-ྐྵྺྻྼö€ö€‚" "w" ?0) ;
+ ("ö„š-ö…ž" "w" ?0) ;
+ ("ö…¸-ö‡Œ" "w" ?0) ;
+ ("ིེཻོཽྀ" "w" ?2) ; upper vowel
+ ("ཾྂྃ྆྇ྈྉྊྋ" "w" ?2) ; upper modifier
+ ("༙ö‚Žà½±à½´à¾„༵༷" "w" ?3) ; lowel vowel/modifier
+ ("཰" "w" ?3) ; invisible vowel a
+ ("༠-༩༪-༳" "w" ?6) ; digit
+ ("་à¼-༒༔ཿ" "." ?|) ; line-break char
+ ("་à¼à¼à¼à¼‘༔ཿ" "." ?|) ;
+ ("༈་à¼-༒༔ཿ༽༴" "." ?>) ; prohibition
+ ("་à¼à¼à¼à¼‘༔ཿ" "." ?>) ;
+ ("ༀ-༊༼à¿à¿‚྅" "." ?<) ; prohibition
+ ("༓༕-༘༚-༟༶༸-༻༾༿྾྿-à¿" "." ?q) ; others
))
elm chars len syntax category to ch i)
(while deflist
;; Vietnamese character set
-(let ((lower (make-char 'vietnamese-viscii-lower))
- (upper (make-char 'vietnamese-viscii-upper)))
-;; (modify-syntax-entry lower "w")
-;; (modify-syntax-entry upper "w")
- (modify-category-entry lower ?v)
- (modify-category-entry upper ?v)
- (modify-category-entry lower ?l) ; To make a word with
- (modify-category-entry upper ?l) ; latin characters.
- )
+;; To make a word with Latin characters
+(map-charset-chars #'modify-category-entry 'vietnamese-viscii-lower ?l)
+(map-charset-chars #'modify-category-entry 'vietnamese-viscii-lower ?v)
+
+(map-charset-chars #'modify-category-entry 'vietnamese-viscii-upper ?l)
+(map-charset-chars #'modify-category-entry 'vietnamese-viscii-upper ?v)
(let ((tbl (standard-case-table))
(i 32))
(while (< i 128)
- (set-case-syntax-pair (make-char 'vietnamese-viscii-upper i)
- (make-char 'vietnamese-viscii-lower i)
- tbl)
+ (let* ((char (decode-char 'vietnamese-viscii-upper i))
+ (charl (decode-char 'vietnamese-viscii-lower i))
+ (uc (encode-char char 'ucs))
+ (lc (encode-char charl 'ucs)))
+ (set-case-syntax-pair char (decode-char 'vietnamese-viscii-lower i)
+ tbl)
+ (if uc (modify-category-entry uc ?v))
+ (if lc (modify-category-entry lc ?v)))
(setq i (1+ i))))
-;; Unicode (mule-unicode-0100-24ff)
+;; Tai Viet
+(let ((deflist '(;; chars syntax category
+ ((?ꪀ. ?ꪯ) "w" ?0) ; cosonant
+ ("ꪱꪵꪶ" "w" ?1) ; vowel base
+ ((?ꪹ . ?ꪽ) "w" ?1) ; vowel base
+ ("ꪰꪲꪳꪷꪸꪾ" "w" ?2) ; vowel upper
+ ("ꪴ" "w" ?3) ; vowel lower
+ ("ꫀꫂ" "w" ?1) ; non-combining tone-mark
+ ("꪿ê«" "w" ?4) ; combining tone-mark
+ ((?ê«› . ?ê«Ÿ) "_" ?5) ; symbol
+ )))
+ (dolist (elm deflist)
+ (let ((chars (car elm))
+ (syntax (nth 1 elm))
+ (category (nth 2 elm)))
+ (if (consp chars)
+ (progn
+ (modify-syntax-entry chars syntax)
+ (modify-category-entry chars category))
+ (mapc #'(lambda (x)
+ (modify-syntax-entry x syntax)
+ (modify-category-entry x category))
+ chars)))))
+
+;; Latin
+
+(modify-category-entry '(#x80 . #x024F) ?l)
(let ((tbl (standard-case-table)) c)
- ;; Latin Extended-A, Latin Extended-B, IPA
+ ;; Latin-1
+
+ ;; Fixme: Some of the non-word syntaxes here perhaps should be
+ ;; reviewed. (Note that the following all implicitly have word
+ ;; syntax: ¢£¤¥¨ª¯²³´¶¸¹º.) There should be a well-defined way of
+ ;; relating Unicode categories to Emacs syntax codes.
+
+ ;; NBSP isn't semantically interchangeable with other whitespace chars,
+ ;; so it's more like punctation.
+ (set-case-syntax ? "." tbl)
+ (set-case-syntax ?¡ "." tbl)
+ (set-case-syntax ?¦ "_" tbl)
+ (set-case-syntax ?§ "." tbl)
+ (set-case-syntax ?© "_" tbl)
+ (set-case-syntax-delims 171 187 tbl) ; « »
+ (set-case-syntax ?¬ "_" tbl)
+ (set-case-syntax ? "_" tbl)
+ (set-case-syntax ?® "_" tbl)
+ (set-case-syntax ?° "_" tbl)
+ (set-case-syntax ?± "_" tbl)
+ (set-case-syntax ?µ "_" tbl)
+ (set-case-syntax ?· "_" tbl)
+ (set-case-syntax ?¼ "_" tbl)
+ (set-case-syntax ?½ "_" tbl)
+ (set-case-syntax ?¾ "_" tbl)
+ (set-case-syntax ?¿ "." tbl)
+ (let ((c 192))
+ (while (<= c 222)
+ (set-case-syntax-pair c (+ c 32) tbl)
+ (setq c (1+ c))))
+ (set-case-syntax ?× "_" tbl)
+ (set-case-syntax ?ß "w" tbl)
+ (set-case-syntax ?÷ "_" tbl)
+ ;; See below for ÿ.
+
+ ;; Latin Extended-A, Latin Extended-B
(setq c #x0100)
- (while (<= c #x02AF)
- (modify-category-entry (decode-char 'ucs c) ?l)
- (setq c (1+ c)))
-
- (setq c #x0100)
- (while (<= c #x0177)
- (and (or (<= c #x012e)
- (and (>= c #x014a) (<= c #x0177)))
- (zerop (% c 2))
- (set-case-syntax-pair
- (decode-char 'ucs c) (decode-char 'ucs (1+ c)) tbl))
- (and (>= c #x013a)
- (<= c #x0148)
- (zerop (% c 2))
- (set-case-syntax-pair
- (decode-char 'ucs (1- c)) (decode-char 'ucs c) tbl))
+ (while (<= c #x02B8)
+ (modify-category-entry c ?l)
(setq c (1+ c)))
+ (let ((pair-ranges '((#x0100 . #x012F)
+ (#x0132 . #x0137)
+ (#x0139 . #x0148)
+ (#x014a . #x0177)
+ (#x0179 . #x017E)
+ (#x0182 . #x0185)
+ (#x0187 . #x018C)
+ (#x0191 . #x0192)
+ (#x0198 . #x0199)
+ (#x01A0 . #x01A5)
+ (#x01A7 . #x01A8)
+ (#x01AC . #x01AD)
+ (#x01AF . #x01B0)
+ (#x01B3 . #x01B6)
+ (#x01BC . #x01BD)
+ (#x01CD . #x01DC)
+ (#x01DE . #x01EF)
+ (#x01F4 . #x01F5)
+ (#x01F8 . #x021F)
+ (#x0222 . #x0233)
+ (#x023B . #x023C)
+ (#x0241 . #x0242)
+ (#x0246 . #x024F))))
+ (dolist (elt pair-ranges)
+ (let ((from (car elt)) (to (cdr elt)))
+ (while (< from to)
+ (set-case-syntax-pair from (1+ from) tbl)
+ (setq from (+ from 2))))))
;; In some languages, such as Turkish, U+0049 LATIN CAPITAL LETTER I
;; and U+0131 LATIN SMALL LETTER DOTLESS I make a case pair, and so
;; but that makes searches slow. So now we don't set up either half
;; of these correspondences by default.
- ;; (set-downcase-syntax ?\e$,1 P\e(B ?i tbl)
- ;; (set-upcase-syntax ?I ?\e$,1 Q\e(B tbl)
-
- (set-case-syntax-pair ?\e$,1 R\e(B ?\e$,1 S\e(B tbl)
- (set-case-syntax-pair ?\e$,1 T\e(B ?\e$,1 U\e(B tbl)
- (set-case-syntax-pair ?\e$,1 V\e(B ?\e$,1 W\e(B tbl)
- (set-case-syntax-pair ?\e$,1!8\e(B ?\e,A\7f\e(B tbl)
- (set-case-syntax-pair ?\e$,1!9\e(B ?\e$,1!:\e(B tbl)
- (set-case-syntax-pair ?\e$,1!;\e(B ?\e$,1!<\e(B tbl)
- (set-case-syntax-pair ?\e$,1!=\e(B ?\e$,1!>\e(B tbl)
-
- ;; Latin Extended-B
- (set-case-syntax-pair ?\e$,1!A\e(B ?\e$,1#S\e(B tbl)
- (set-case-syntax-pair ?\e$,1!B\e(B ?\e$,1!C\e(B tbl)
- (set-case-syntax-pair ?\e$,1!D\e(B ?\e$,1!E\e(B tbl)
- (set-case-syntax-pair ?\e$,1!F\e(B ?\e$,1#T\e(B tbl)
- (set-case-syntax-pair ?\e$,1!G\e(B ?\e$,1!H\e(B tbl)
- (set-case-syntax-pair ?\e$,1!I\e(B ?\e$,1#V\e(B tbl)
- (set-case-syntax-pair ?\e$,1!J\e(B ?\e$,1#W\e(B tbl)
- (set-case-syntax-pair ?\e$,1!K\e(B ?\e$,1!L\e(B tbl)
- (set-case-syntax-pair ?\e$,1!N\e(B ?\e$,1"=\e(B tbl)
- (set-case-syntax-pair ?\e$,1!O\e(B ?\e$,1#Y\e(B tbl)
- (set-case-syntax-pair ?\e$,1!P\e(B ?\e$,1#[\e(B tbl)
- (set-case-syntax-pair ?\e$,1!Q\e(B ?\e$,1!R\e(B tbl)
- (set-case-syntax-pair ?\e$,1!S\e(B ?\e$,1#`\e(B tbl)
- (set-case-syntax-pair ?\e$,1!T\e(B ?\e$,1#c\e(B tbl)
- (set-case-syntax-pair ?\e$,1!V\e(B ?\e$,1#i\e(B tbl)
- (set-case-syntax-pair ?\e$,1!W\e(B ?\e$,1#h\e(B tbl)
- (set-case-syntax-pair ?\e$,1!X\e(B ?\e$,1!Y\e(B tbl)
- (set-case-syntax-pair ?\e$,1!\\e(B ?\e$,1#o\e(B tbl)
- (set-case-syntax-pair ?\e$,1!]\e(B ?\e$,1#r\e(B tbl)
- (set-case-syntax-pair ?\e$,1!_\e(B ?\e$,1#u\e(B tbl)
- (set-case-syntax-pair ?\e$,1!`\e(B ?\e$,1!a\e(B tbl)
- (set-case-syntax-pair ?\e$,1!b\e(B ?\e$,1!c\e(B tbl)
- (set-case-syntax-pair ?\e$,1!d\e(B ?\e$,1!e\e(B tbl)
- (set-case-syntax-pair ?\e$,1!f\e(B ?\e$,1$ \e(B tbl)
- (set-case-syntax-pair ?\e$,1!g\e(B ?\e$,1!h\e(B tbl)
- (set-case-syntax-pair ?\e$,1!i\e(B ?\e$,1$#\e(B tbl)
- (set-case-syntax-pair ?\e$,1!l\e(B ?\e$,1!m\e(B tbl)
- (set-case-syntax-pair ?\e$,1!n\e(B ?\e$,1$(\e(B tbl)
- (set-case-syntax-pair ?\e$,1!o\e(B ?\e$,1!p\e(B tbl)
- (set-case-syntax-pair ?\e$,1!q\e(B ?\e$,1$*\e(B tbl)
- (set-case-syntax-pair ?\e$,1!r\e(B ?\e$,1$+\e(B tbl)
- (set-case-syntax-pair ?\e$,1!s\e(B ?\e$,1!t\e(B tbl)
- (set-case-syntax-pair ?\e$,1!u\e(B ?\e$,1!v\e(B tbl)
- (set-case-syntax-pair ?\e$,1!w\e(B ?\e$,1$2\e(B tbl)
- (set-case-syntax-pair ?\e$,1!x\e(B ?\e$,1!y\e(B tbl)
- (set-case-syntax-pair ?\e$,1!|\e(B ?\e$,1!}\e(B tbl)
- (set-case-syntax-pair ?\e$,1"$\e(B ?\e$,1"&\e(B tbl)
- (set-case-syntax-pair ?\e$,1"%\e(B ?\e$,1"&\e(B tbl)
- (set-case-syntax-pair ?\e$,1"'\e(B ?\e$,1")\e(B tbl)
- (set-case-syntax-pair ?\e$,1"(\e(B ?\e$,1")\e(B tbl)
- (set-case-syntax-pair ?\e$,1"*\e(B ?\e$,1",\e(B tbl)
- (set-case-syntax-pair ?\e$,1"+\e(B ?\e$,1",\e(B tbl)
- (set-case-syntax-pair ?\e$,1"-\e(B ?\e$,1".\e(B tbl)
- (set-case-syntax-pair ?\e$,1"/\e(B ?\e$,1"0\e(B tbl)
- (set-case-syntax-pair ?\e$,1"1\e(B ?\e$,1"2\e(B tbl)
- (set-case-syntax-pair ?\e$,1"3\e(B ?\e$,1"4\e(B tbl)
- (set-case-syntax-pair ?\e$,1"5\e(B ?\e$,1"6\e(B tbl)
- (set-case-syntax-pair ?\e$,1"7\e(B ?\e$,1"8\e(B tbl)
- (set-case-syntax-pair ?\e$,1"9\e(B ?\e$,1":\e(B tbl)
- (set-case-syntax-pair ?\e$,1";\e(B ?\e$,1"<\e(B tbl)
- (set-case-syntax-pair ?\e$,1">\e(B ?\e$,1"?\e(B tbl)
- (set-case-syntax-pair ?\e$,1"@\e(B ?\e$,1"A\e(B tbl)
- (set-case-syntax-pair ?\e$,1"B\e(B ?\e$,1"C\e(B tbl)
- (set-case-syntax-pair ?\e$,1"D\e(B ?\e$,1"E\e(B tbl)
- (set-case-syntax-pair ?\e$,1"F\e(B ?\e$,1"G\e(B tbl)
- (set-case-syntax-pair ?\e$,1"H\e(B ?\e$,1"I\e(B tbl)
- (set-case-syntax-pair ?\e$,1"J\e(B ?\e$,1"K\e(B tbl)
- (set-case-syntax-pair ?\e$,1"L\e(B ?\e$,1"M\e(B tbl)
- (set-case-syntax-pair ?\e$,1"N\e(B ?\e$,1"O\e(B tbl)
+ ;; (set-downcase-syntax ?Ä° ?i tbl)
+ ;; (set-upcase-syntax ?I ?ı tbl)
+
+ (set-case-syntax-pair ?DŽ ?dž tbl)
+ (set-case-syntax-pair ?Dž ?dž tbl)
+ (set-case-syntax-pair ?LJ ?lj tbl)
+ (set-case-syntax-pair ?Lj ?lj tbl)
+ (set-case-syntax-pair ?NJ ?nj tbl)
+ (set-case-syntax-pair ?Nj ?nj tbl)
+
;; 01F0; F; 006A 030C; # LATIN SMALL LETTER J WITH CARON
- (set-case-syntax-pair ?\e$,1"Q\e(B ?\e$,1"S\e(B tbl)
- (set-case-syntax-pair ?\e$,1"R\e(B ?\e$,1"S\e(B tbl)
- (set-case-syntax-pair ?\e$,1"T\e(B ?\e$,1"U\e(B tbl)
- (set-case-syntax-pair ?\e$,1"V\e(B ?\e$,1!U\e(B tbl)
- (set-case-syntax-pair ?\e$,1"W\e(B ?\e$,1!\7f\e(B tbl)
- (set-case-syntax-pair ?\e$,1"X\e(B ?\e$,1"Y\e(B tbl)
- (set-case-syntax-pair ?\e$,1"Z\e(B ?\e$,1"[\e(B tbl)
- (set-case-syntax-pair ?\e$,1"\\e(B ?\e$,1"]\e(B tbl)
- (set-case-syntax-pair ?\e$,1"^\e(B ?\e$,1"_\e(B tbl)
- (set-case-syntax-pair ?\e$,1"`\e(B ?\e$,1"a\e(B tbl)
- (set-case-syntax-pair ?\e$,1"b\e(B ?\e$,1"c\e(B tbl)
- (set-case-syntax-pair ?\e$,1"d\e(B ?\e$,1"e\e(B tbl)
- (set-case-syntax-pair ?\e$,1"f\e(B ?\e$,1"g\e(B tbl)
- (set-case-syntax-pair ?\e$,1"h\e(B ?\e$,1"i\e(B tbl)
- (set-case-syntax-pair ?\e$,1"j\e(B ?\e$,1"k\e(B tbl)
- (set-case-syntax-pair ?\e$,1"l\e(B ?\e$,1"m\e(B tbl)
- (set-case-syntax-pair ?\e$,1"n\e(B ?\e$,1"o\e(B tbl)
- (set-case-syntax-pair ?\e$,1"p\e(B ?\e$,1"q\e(B tbl)
- (set-case-syntax-pair ?\e$,1"r\e(B ?\e$,1"s\e(B tbl)
- (set-case-syntax-pair ?\e$,1"t\e(B ?\e$,1"u\e(B tbl)
- (set-case-syntax-pair ?\e$,1"v\e(B ?\e$,1"w\e(B tbl)
- (set-case-syntax-pair ?\e$,1"x\e(B ?\e$,1"y\e(B tbl)
- (set-case-syntax-pair ?\e$,1"z\e(B ?\e$,1"{\e(B tbl)
- (set-case-syntax-pair ?\e$,1"|\e(B ?\e$,1"}\e(B tbl)
- (set-case-syntax-pair ?\e$,1"~\e(B ?\e$,1"\7f\e(B tbl)
- (set-case-syntax-pair ?\e$,1#"\e(B ?\e$,1##\e(B tbl)
- (set-case-syntax-pair ?\e$,1#$\e(B ?\e$,1#%\e(B tbl)
- (set-case-syntax-pair ?\e$,1#&\e(B ?\e$,1#'\e(B tbl)
- (set-case-syntax-pair ?\e$,1#(\e(B ?\e$,1#)\e(B tbl)
- (set-case-syntax-pair ?\e$,1#*\e(B ?\e$,1#+\e(B tbl)
- (set-case-syntax-pair ?\e$,1#,\e(B ?\e$,1#-\e(B tbl)
- (set-case-syntax-pair ?\e$,1#.\e(B ?\e$,1#/\e(B tbl)
- (set-case-syntax-pair ?\e$,1#0\e(B ?\e$,1#1\e(B tbl)
- (set-case-syntax-pair ?\e$,1#2\e(B ?\e$,1#3\e(B tbl)
+ (set-case-syntax-pair ?DZ ?dz tbl)
+ (set-case-syntax-pair ?Dz ?dz tbl)
+ (set-case-syntax-pair ?Ƕ ?ƕ tbl)
+ (set-case-syntax-pair ?Ç· ?Æ¿ tbl)
;; Latin Extended Additional
+ (modify-category-entry '(#x1e00 . #x1ef9) ?l)
(setq c #x1e00)
(while (<= c #x1ef9)
- (modify-category-entry (decode-char 'ucs c) ?l)
(and (zerop (% c 2))
(or (<= c #x1e94) (>= c #x1ea0))
- (set-case-syntax-pair
- (decode-char 'ucs c) (decode-char 'ucs (1+ c)) tbl))
+ (set-case-syntax-pair c (1+ c) tbl))
(setq c (1+ c)))
;; Greek
+ (modify-category-entry '(#x0370 . #x03ff) ?g)
(setq c #x0370)
(while (<= c #x03ff)
- (modify-category-entry (decode-char 'ucs c) ?g)
(if (or (and (>= c #x0391) (<= c #x03a1))
(and (>= c #x03a3) (<= c #x03ab)))
- (set-case-syntax-pair
- (decode-char 'ucs c) (decode-char 'ucs (+ c 32)) tbl))
+ (set-case-syntax-pair c (+ c 32) tbl))
(and (>= c #x03da)
(<= c #x03ee)
(zerop (% c 2))
- (set-case-syntax-pair
- (decode-char 'ucs c) (decode-char 'ucs (1+ c)) tbl))
+ (set-case-syntax-pair c (1+ c) tbl))
(setq c (1+ c)))
- (set-case-syntax-pair ?\e$,1&f\e(B ?\e$,1',\e(B tbl)
- (set-case-syntax-pair ?\e$,1&h\e(B ?\e$,1'-\e(B tbl)
- (set-case-syntax-pair ?\e$,1&i\e(B ?\e$,1'.\e(B tbl)
- (set-case-syntax-pair ?\e$,1&j\e(B ?\e$,1'/\e(B tbl)
- (set-case-syntax-pair ?\e$,1&l\e(B ?\e$,1'L\e(B tbl)
- (set-case-syntax-pair ?\e$,1&n\e(B ?\e$,1'M\e(B tbl)
- (set-case-syntax-pair ?\e$,1&o\e(B ?\e$,1'N\e(B tbl)
+ (set-case-syntax-pair ?Ά ?ά tbl)
+ (set-case-syntax-pair ?Έ ?Πtbl)
+ (set-case-syntax-pair ?Ή ?ή tbl)
+ (set-case-syntax-pair ?Ί ?ί tbl)
+ (set-case-syntax-pair ?Ό ?ό tbl)
+ (set-case-syntax-pair ?ÎŽ ?Ï tbl)
+ (set-case-syntax-pair ?Î ?ÏŽ tbl)
;; Armenian
(setq c #x531)
(while (<= c #x556)
- (set-case-syntax-pair (decode-char 'ucs c)
- (decode-char 'ucs (+ c #x30)) tbl)
+ (set-case-syntax-pair c (+ c #x30) tbl)
(setq c (1+ c)))
;; Greek Extended
+ (modify-category-entry '(#x1f00 . #x1fff) ?g)
(setq c #x1f00)
(while (<= c #x1fff)
- (modify-category-entry (decode-char 'ucs c) ?g)
(and (<= (logand c #x000f) 7)
(<= c #x1fa7)
(not (memq c '(#x1f50 #x1f52 #x1f54 #x1f56)))
(/= (logand c #x00f0) 7)
- (set-case-syntax-pair
- (decode-char 'ucs (+ c 8)) (decode-char 'ucs c) tbl))
+ (set-case-syntax-pair (+ c 8) c tbl))
(setq c (1+ c)))
- (set-case-syntax-pair ?\e$,1qx\e(B ?\e$,1qp\e(B tbl)
- (set-case-syntax-pair ?\e$,1qy\e(B ?\e$,1qq\e(B tbl)
- (set-case-syntax-pair ?\e$,1qz\e(B ?\e$,1q0\e(B tbl)
- (set-case-syntax-pair ?\e$,1q{\e(B ?\e$,1q1\e(B tbl)
- (set-case-syntax-pair ?\e$,1q|\e(B ?\e$,1qs\e(B tbl)
- (set-case-syntax-pair ?\e$,1r(\e(B ?\e$,1q2\e(B tbl)
- (set-case-syntax-pair ?\e$,1r)\e(B ?\e$,1q3\e(B tbl)
- (set-case-syntax-pair ?\e$,1r*\e(B ?\e$,1q4\e(B tbl)
- (set-case-syntax-pair ?\e$,1r+\e(B ?\e$,1q5\e(B tbl)
- (set-case-syntax-pair ?\e$,1r,\e(B ?\e$,1r#\e(B tbl)
- (set-case-syntax-pair ?\e$,1r8\e(B ?\e$,1r0\e(B tbl)
- (set-case-syntax-pair ?\e$,1r9\e(B ?\e$,1r1\e(B tbl)
- (set-case-syntax-pair ?\e$,1r:\e(B ?\e$,1q6\e(B tbl)
- (set-case-syntax-pair ?\e$,1r;\e(B ?\e$,1q7\e(B tbl)
- (set-case-syntax-pair ?\e$,1rH\e(B ?\e$,1r@\e(B tbl)
- (set-case-syntax-pair ?\e$,1rI\e(B ?\e$,1rA\e(B tbl)
- (set-case-syntax-pair ?\e$,1rJ\e(B ?\e$,1q:\e(B tbl)
- (set-case-syntax-pair ?\e$,1rK\e(B ?\e$,1q;\e(B tbl)
- (set-case-syntax-pair ?\e$,1rL\e(B ?\e$,1rE\e(B tbl)
- (set-case-syntax-pair ?\e$,1rX\e(B ?\e$,1q8\e(B tbl)
- (set-case-syntax-pair ?\e$,1rY\e(B ?\e$,1q9\e(B tbl)
- (set-case-syntax-pair ?\e$,1rZ\e(B ?\e$,1q<\e(B tbl)
- (set-case-syntax-pair ?\e$,1r[\e(B ?\e$,1q=\e(B tbl)
- (set-case-syntax-pair ?\e$,1r\\e(B ?\e$,1rS\e(B tbl)
+ (set-case-syntax-pair ?Ᾰ ?ᾰ tbl)
+ (set-case-syntax-pair ?á¾¹ ?á¾± tbl)
+ (set-case-syntax-pair ?Ὰ ?ὰ tbl)
+ (set-case-syntax-pair ?á¾» ?á½± tbl)
+ (set-case-syntax-pair ?á¾¼ ?á¾³ tbl)
+ (set-case-syntax-pair ?Ὲ ?ὲ tbl)
+ (set-case-syntax-pair ?Έ ?έ tbl)
+ (set-case-syntax-pair ?á¿Š ?á½´ tbl)
+ (set-case-syntax-pair ?á¿‹ ?á½µ tbl)
+ (set-case-syntax-pair ?ῌ ?ῃ tbl)
+ (set-case-syntax-pair ?Ῐ ?ῠtbl)
+ (set-case-syntax-pair ?á¿™ ?á¿‘ tbl)
+ (set-case-syntax-pair ?Ὶ ?ὶ tbl)
+ (set-case-syntax-pair ?á¿› ?á½· tbl)
+ (set-case-syntax-pair ?Ῠ ?ῠtbl)
+ (set-case-syntax-pair ?á¿© ?á¿¡ tbl)
+ (set-case-syntax-pair ?Ὺ ?ὺ tbl)
+ (set-case-syntax-pair ?á¿« ?á½» tbl)
+ (set-case-syntax-pair ?Ῥ ?ῥ tbl)
+ (set-case-syntax-pair ?Ὸ ?ὸ tbl)
+ (set-case-syntax-pair ?Ό ?ό tbl)
+ (set-case-syntax-pair ?Ὼ ?ὼ tbl)
+ (set-case-syntax-pair ?á¿» ?á½½ tbl)
+ (set-case-syntax-pair ?ῼ ?ῳ tbl)
;; cyrillic
+ (modify-category-entry '(#x0400 . #x04FF) ?y)
(setq c #x0400)
(while (<= c #x04ff)
- (modify-category-entry (decode-char 'ucs c) ?y)
(and (>= c #x0400)
(<= c #x040f)
- (set-case-syntax-pair
- (decode-char 'ucs c) (decode-char 'ucs (+ c 80)) tbl))
+ (set-case-syntax-pair c (+ c 80) tbl))
(and (>= c #x0410)
(<= c #x042f)
- (set-case-syntax-pair
- (decode-char 'ucs c) (decode-char 'ucs (+ c 32)) tbl))
+ (set-case-syntax-pair c (+ c 32) tbl))
(and (zerop (% c 2))
(or (and (>= c #x0460) (<= c #x0480))
(and (>= c #x048c) (<= c #x04be))
(and (>= c #x04d0) (<= c #x04f4)))
- (set-case-syntax-pair
- (decode-char 'ucs c) (decode-char 'ucs (1+ c)) tbl))
+ (set-case-syntax-pair c (1+ c) tbl))
(setq c (1+ c)))
- (set-case-syntax-pair ?\e$,1*!\e(B ?\e$,1*"\e(B tbl)
- (set-case-syntax-pair ?\e$,1*#\e(B ?\e$,1*$\e(B tbl)
- (set-case-syntax-pair ?\e$,1*'\e(B ?\e$,1*(\e(B tbl)
- (set-case-syntax-pair ?\e$,1*+\e(B ?\e$,1*,\e(B tbl)
- (set-case-syntax-pair ?\e$,1*X\e(B ?\e$,1*Y\e(B tbl)
+ (set-case-syntax-pair ?Ó ?Ó‚ tbl)
+ (set-case-syntax-pair ?Óƒ ?Ó„ tbl)
+ (set-case-syntax-pair ?Ó‡ ?Óˆ tbl)
+ (set-case-syntax-pair ?Ӌ ?ӌ tbl)
+ (set-case-syntax-pair ?Ó¸ ?Ó¹ tbl)
;; general punctuation
(setq c #x2000)
(while (<= c #x200b)
- (set-case-syntax (decode-char 'ucs c) " " tbl)
+ (set-case-syntax c " " tbl)
+ (setq c (1+ c)))
+ (while (<= c #x200F)
+ (set-case-syntax c "." tbl)
(setq c (1+ c)))
+ ;; Fixme: These aren't all right:
(setq c #x2010)
(while (<= c #x2016)
- (set-case-syntax (decode-char 'ucs c) "_" tbl)
+ (set-case-syntax c "_" tbl)
(setq c (1+ c)))
;; Punctuation syntax for quotation marks (like `)
(while (<= c #x201f)
- (set-case-syntax (decode-char 'ucs c) "." tbl)
+ (set-case-syntax c "." tbl)
(setq c (1+ c)))
+ ;; Fixme: These aren't all right:
(while (<= c #x2027)
- (set-case-syntax (decode-char 'ucs c) "_" tbl)
+ (set-case-syntax c "_" tbl)
+ (setq c (1+ c)))
+ (while (<= c #x206F)
+ (set-case-syntax c "." tbl)
(setq c (1+ c)))
;; Roman numerals
(setq c #x2160)
(while (<= c #x216f)
- (set-case-syntax-pair (decode-char 'ucs c)
- (decode-char 'ucs (+ c #x10)) tbl)
+ (set-case-syntax-pair c (+ c #x10) tbl)
+ (setq c (1+ c)))
+
+ ;; Fixme: The following blocks might be better as symbol rather than
+ ;; punctuation.
+ ;; Arrows
+ (setq c #x2190)
+ (while (<= c #x21FF)
+ (set-case-syntax c "." tbl)
+ (setq c (1+ c)))
+ ;; Mathematical Operators
+ (while (<= c #x22FF)
+ (set-case-syntax c "." tbl)
+ (setq c (1+ c)))
+ ;; Miscellaneous Technical
+ (while (<= c #x23FF)
+ (set-case-syntax c "." tbl)
+ (setq c (1+ c)))
+ ;; Control Pictures
+ (while (<= c #x243F)
+ (set-case-syntax c "_" tbl)
(setq c (1+ c)))
;; Circled Latin
(setq c #x24b6)
(while (<= c #x24cf)
- (set-case-syntax-pair (decode-char 'ucs c)
- (decode-char 'ucs (+ c 26)) tbl)
- (modify-category-entry (decode-char 'ucs c) ?l)
- (modify-category-entry (decode-char 'ucs (+ c 26)) ?l)
+ (set-case-syntax-pair c (+ c 26) tbl)
+ (modify-category-entry c ?l)
+ (modify-category-entry (+ c 26) ?l)
(setq c (1+ c)))
;; Fullwidth Latin
(setq c #xff21)
(while (<= c #xff3a)
- (set-case-syntax-pair (decode-char 'ucs c)
- (decode-char 'ucs (+ c #x20)) tbl)
- (modify-category-entry (decode-char 'ucs c) ?l)
- (modify-category-entry (decode-char 'ucs (+ c #x20)) ?l)
+ (set-case-syntax-pair c (+ c #x20) tbl)
+ (modify-category-entry c ?l)
+ (modify-category-entry (+ c #x20) ?l)
(setq c (1+ c)))
;; Combining diacritics
- (setq c #x300)
- (while (<= c #x362)
- (modify-category-entry (decode-char 'ucs c) ?^)
- (setq c (1+ c)))
-
+ (modify-category-entry '(#x300 . #x362) ?^)
;; Combining marks
- (setq c #x20d0)
- (while (<= c #x20e3)
- (modify-category-entry (decode-char 'ucs c) ?^)
- (setq c (1+ c)))
+ (modify-category-entry '(#x20d0 . #x20e3) ?^)
;; Fixme: syntax for symbols &c
)
(let ((pairs
- '("\e$,1sEsF\e(B" ; U+2045 U+2046
- "\e$,1s}s~\e(B" ; U+207D U+207E
- "\e$,1t-t.\e(B" ; U+208D U+208E
- "\e$,1{){*\e(B" ; U+2329 U+232A
- "\e$,1|T|U\e(B" ; U+23B4 U+23B5
- "\e$,2&H&I\e(B" ; U+2768 U+2769
- "\e$,2&J&K\e(B" ; U+276A U+276B
- "\e$,2&L&M\e(B" ; U+276C U+276D
- "\e$,2&P&Q\e(B" ; U+2770 U+2771
- "\e$,2&R&S\e(B" ; U+2772 U+2773
- "\e$,2&T&U\e(B" ; U+2774 U+2775
- "\e$,2'f'g\e(B" ; U+27E6 U+27E7
- "\e$,2'h'i\e(B" ; U+27E8 U+27E9
- "\e$,2'j'k\e(B" ; U+27EA U+27EB
- "\e$,2,#,$\e(B" ; U+2983 U+2984
- "\e$,2,%,&\e(B" ; U+2985 U+2986
- "\e$,2,',(\e(B" ; U+2987 U+2988
- "\e$,2,),*\e(B" ; U+2989 U+298A
- "\e$,2,+,,\e(B" ; U+298B U+298C
- "\e$,2,-,.\e(B" ; U+298D U+298E
- "\e$,2,/,0\e(B" ; U+298F U+2990
- "\e$,2,1,2\e(B" ; U+2991 U+2992
- "\e$,2,3,4\e(B" ; U+2993 U+2994
- "\e$,2,5,6\e(B" ; U+2995 U+2996
- "\e$,2,7,8\e(B" ; U+2997 U+2998
- "\e$,2-<-=\e(B" ; U+29FC U+29FD
- "\e$,2=H=I\e(B" ; U+3008 U+3009
- "\e$,2=J=K\e(B" ; U+300A U+300B
- "\e$,2=L=M\e(B" ; U+300C U+300D
- "\e$,2=N=O\e(B" ; U+300E U+300F
- "\e$,2=P=Q\e(B" ; U+3010 U+3011
- "\e$,2=T=U\e(B" ; U+3014 U+3015
- "\e$,2=V=W\e(B" ; U+3016 U+3017
- "\e$,2=X=Y\e(B" ; U+3018 U+3019
- "\e$,2=Z=[\e(B" ; U+301A U+301B
- "\e$,3m~m\7f\e(B" ; U+FD3E U+FD3F
- "\e$,3pUpV\e(B" ; U+FE35 U+FE36
- "\e$,3pWpX\e(B" ; U+FE37 U+FE38
- "\e$,3pYpZ\e(B" ; U+FE39 U+FE3A
- "\e$,3p[p\\e(B" ; U+FE3B U+FE3C
- "\e$,3p]p^\e(B" ; U+FE3D U+FE3E
- "\e$,3p_p`\e(B" ; U+FE3F U+FE40
- "\e$,3papb\e(B" ; U+FE41 U+FE42
- "\e$,3pcpd\e(B" ; U+FE43 U+FE44
- "\e$,3pypz\e(B" ; U+FE59 U+FE5A
- "\e$,3p{p|\e(B" ; U+FE5B U+FE5C
- "\e$,3p}p~\e(B" ; U+FE5D U+FE5E
- "\e$,3rhri\e(B" ; U+FF08 U+FF09
- "\e$,3s;s=\e(B" ; U+FF3B U+FF3D
- "\e$,3s[s]\e(B" ; U+FF5B U+FF5D
- "\e$,3s_s`\e(B" ; U+FF5F U+FF60
- "\e$,3sbsc\e(B" ; U+FF62 U+FF63
+ '("â…â†" ; U+2045 U+2046
+ "â½â¾" ; U+207D U+207E
+ "â‚â‚Ž" ; U+208D U+208E
+ "〈〉" ; U+2329 U+232A
+ "⎴⎵" ; U+23B4 U+23B5
+ "â¨â©" ; U+2768 U+2769
+ "âªâ«" ; U+276A U+276B
+ "â¬â" ; U+276C U+276D
+ "â°â±" ; U+2770 U+2771
+ "â²â³" ; U+2772 U+2773
+ "â´âµ" ; U+2774 U+2775
+ "⟦⟧" ; U+27E6 U+27E7
+ "⟨⟩" ; U+27E8 U+27E9
+ "⟪⟫" ; U+27EA U+27EB
+ "⦃⦄" ; U+2983 U+2984
+ "⦅⦆" ; U+2985 U+2986
+ "⦇⦈" ; U+2987 U+2988
+ "⦉⦊" ; U+2989 U+298A
+ "⦋⦌" ; U+298B U+298C
+ "â¦â¦Ž" ; U+298D U+298E
+ "â¦â¦" ; U+298F U+2990
+ "⦑⦒" ; U+2991 U+2992
+ "⦓⦔" ; U+2993 U+2994
+ "⦕⦖" ; U+2995 U+2996
+ "⦗⦘" ; U+2997 U+2998
+ "⧼⧽" ; U+29FC U+29FD
+ "〈〉" ; U+3008 U+3009
+ "《》" ; U+300A U+300B
+ "「ã€" ; U+300C U+300D
+ "『ã€" ; U+300E U+300F
+ "ã€ã€‘" ; U+3010 U+3011
+ "〔〕" ; U+3014 U+3015
+ "〖〗" ; U+3016 U+3017
+ "〘〙" ; U+3018 U+3019
+ "〚〛" ; U+301A U+301B
+ "﴾﴿" ; U+FD3E U+FD3F
+ "︵︶" ; U+FE35 U+FE36
+ "︷︸" ; U+FE37 U+FE38
+ "︹︺" ; U+FE39 U+FE3A
+ "︻︼" ; U+FE3B U+FE3C
+ "︽︾" ; U+FE3D U+FE3E
+ "︿﹀" ; U+FE3F U+FE40
+ "ï¹ï¹‚" ; U+FE41 U+FE42
+ "﹃﹄" ; U+FE43 U+FE44
+ "﹙﹚" ; U+FE59 U+FE5A
+ "﹛﹜" ; U+FE5B U+FE5C
+ "ï¹ï¹ž" ; U+FE5D U+FE5E
+ "（）" ; U+FF08 U+FF09
+ "［］" ; U+FF3B U+FF3D
+ "ï½›ï½" ; U+FF5B U+FF5D
+ "ï½Ÿï½ " ; U+FF5F U+FF60
+ "｢｣" ; U+FF62 U+FF63
)))
(dolist (elt pairs)
(modify-syntax-entry (aref elt 0) (string ?\( (aref elt 1)))
(modify-syntax-entry (aref elt 1) (string ?\) (aref elt 0)))))
-\f
-;;; Setting word boundary.
-
-(setq word-combining-categories
- '((?l . ?l)
- (?C . ?C)
- (?C . ?H)
- (?C . ?K)))
-
-(setq word-separating-categories ; (2-byte character sets)
- '((?A . ?K) ; Alpha numeric - Katakana
- (?A . ?C) ; Alpha numeric - Chinese
- (?H . ?A) ; Hiragana - Alpha numeric
- (?H . ?K) ; Hiragana - Katakana
- (?H . ?C) ; Hiragana - Chinese
- (?K . ?A) ; Katakana - Alpha numeric
- (?K . ?C) ; Katakana - Chinese
- (?C . ?A) ; Chinese - Alpha numeric
- (?C . ?K) ; Chinese - Katakana
- ))
-
\f
;; For each character set, put the information of the most proper
;; coding system to encode it by `preferred-coding-system' property.
+;; Fixme: should this be junked?
(let ((l '((latin-iso8859-1 . iso-latin-1)
(latin-iso8859-2 . iso-latin-2)
(latin-iso8859-3 . iso-latin-3)
(cyrillic-iso8859-5 . cyrillic-iso-8bit)
(latin-iso8859-9 . iso-latin-5)
(japanese-jisx0208-1978 . iso-2022-jp)
- (chinese-gb2312 . cn-gb-2312)
+ (chinese-gb2312 . chinese-iso-8bit)
+ (chinese-gbk . chinese-gbk)
+ (gb18030-2-byte . chinese-gb18030)
+ (gb18030-4-byte-bmp . chinese-gb18030)
+ (gb18030-4-byte-smp . chinese-gb18030)
+ (gb18030-4-byte-ext-1 . chinese-gb18030)
+ (gb18030-4-byte-ext-2 . chinese-gb18030)
(japanese-jisx0208 . iso-2022-jp)
(korean-ksc5601 . iso-2022-kr)
(japanese-jisx0212 . iso-2022-jp)
- (chinese-cns11643-1 . iso-2022-cn)
- (chinese-cns11643-2 . iso-2022-cn)
(chinese-big5-1 . chinese-big5)
(chinese-big5-2 . chinese-big5)
(chinese-sisheng . iso-2022-7bit)
(vietnamese-viscii-upper . vietnamese-viscii)
(arabic-digit . iso-2022-7bit)
(arabic-1-column . iso-2022-7bit)
- (ascii-right-to-left . iso-2022-7bit)
(lao . lao)
(arabic-2-column . iso-2022-7bit)
(indian-is13194 . devanagari)
(indian-glyph . devanagari)
(tibetan-1-column . tibetan)
(ethiopic . iso-2022-7bit)
+ (chinese-cns11643-1 . iso-2022-cn)
+ (chinese-cns11643-2 . iso-2022-cn)
(chinese-cns11643-3 . iso-2022-cn)
(chinese-cns11643-4 . iso-2022-cn)
(chinese-cns11643-5 . iso-2022-cn)
\f
;; Setup auto-fill-chars for charsets that should invoke auto-filling.
-;; SPACE and NEWLINE are already set. Also put `nospace-between-words'
-;; property on the charsets.
-(let ((l '(katakana-jisx0201
- japanese-jisx0208 japanese-jisx0212
- chinese-gb2312 chinese-big5-1 chinese-big5-2)))
- (while l
- (aset auto-fill-chars (make-char (car l)) t)
- (put-charset-property (car l) 'nospace-between-words t)
- (setq l (cdr l))))
+;; SPACE and NEWLINE are already set.
+
+(set-char-table-range auto-fill-chars '(#x3041 . #x30FF) t)
+(set-char-table-range auto-fill-chars '(#x3400 . #x4DB5) t)
+(set-char-table-range auto-fill-chars '(#x4e00 . #x9fbb) t)
+(set-char-table-range auto-fill-chars '(#xF900 . #xFAFF) t)
+(set-char-table-range auto-fill-chars '(#xFF00 . #xFF9F) t)
+(set-char-table-range auto-fill-chars '(#x20000 . #x2FFFF) t)
\f
-(setq utf-translate-cjk-mode saved-utf-translate-cjk-mode)
-(makunbound 'saved-utf-translate-cjk-mode)
+;;; Setting char-width-table. The default is 1.
+
+;; 0: non-spacing, enclosing combining, formatting, Hangul Jamo medial
+;; and final characters.
+(let ((l '((#x00AD . #x00AD)
+ (#x0300 . #x036F)
+ (#x0483 . #x0489)
+ (#x0591 . #x05BD)
+ (#x05BF . #x05BF)
+ (#x05C1 . #x05C2)
+ (#x05C4 . #x05C5)
+ (#x05C7 . #x05C7)
+ (#x0600 . #x0603)
+ (#x0610 . #x0615)
+ (#x064B . #x065E)
+ (#x0670 . #x0670)
+ (#x06D6 . #x06E4)
+ (#x06E7 . #x06E8)
+ (#x06EA . #x06ED)
+ (#x070F . #x070F)
+ (#x0711 . #x0711)
+ (#x0730 . #x074A)
+ (#x07A6 . #x07B0)
+ (#x07EB . #x07F3)
+ (#x0901 . #x0902)
+ (#x093C . #x093C)
+ (#x0941 . #x0948)
+ (#x094D . #x094D)
+ (#x0951 . #x0954)
+ (#x0962 . #x0963)
+ (#x0981 . #x0981)
+ (#x09BC . #x09BC)
+ (#x09C1 . #x09C4)
+ (#x09CD . #x09CD)
+ (#x09E2 . #x09E3)
+ (#x0A01 . #x0A02)
+ (#x0A3C . #x0A3C)
+ (#x0A41 . #x0A4D)
+ (#x0A70 . #x0A71)
+ (#x0A81 . #x0A82)
+ (#x0ABC . #x0ABC)
+ (#x0AC1 . #x0AC8)
+ (#x0ACD . #x0ACD)
+ (#x0AE2 . #x0AE3)
+ (#x0B01 . #x0B01)
+ (#x0B3C . #x0B3C)
+ (#x0B3F . #x0B3F)
+ (#x0B41 . #x0B43)
+ (#x0B4D . #x0B56)
+ (#x0B82 . #x0B82)
+ (#x0BC0 . #x0BC0)
+ (#x0BCD . #x0BCD)
+ (#x0C3E . #x0C40)
+ (#x0C46 . #x0C56)
+ (#x0CBC . #x0CBC)
+ (#x0CBF . #x0CBF)
+ (#x0CC6 . #x0CC6)
+ (#x0CCC . #x0CCD)
+ (#x0CE2 . #x0CE3)
+ (#x0D41 . #x0D43)
+ (#x0D4D . #x0D4D)
+ (#x0DCA . #x0DCA)
+ (#x0DD2 . #x0DD6)
+ (#x0E31 . #x0E31)
+ (#x0E34 . #x0E3A)
+ (#x0E47 . #x0E4E)
+ (#x0EB1 . #x0EB1)
+ (#x0EB4 . #x0EBC)
+ (#x0EC8 . #x0ECD)
+ (#x0F18 . #x0F19)
+ (#x0F35 . #x0F35)
+ (#x0F37 . #x0F37)
+ (#x0F39 . #x0F39)
+ (#x0F71 . #x0F7E)
+ (#x0F80 . #x0F84)
+ (#x0F86 . #x0F87)
+ (#x0F90 . #x0FBC)
+ (#x0FC6 . #x0FC6)
+ (#x102D . #x1030)
+ (#x1032 . #x1037)
+ (#x1039 . #x1039)
+ (#x1058 . #x1059)
+ (#x1160 . #x11FF)
+ (#x135F . #x135F)
+ (#x1712 . #x1714)
+ (#x1732 . #x1734)
+ (#x1752 . #x1753)
+ (#x1772 . #x1773)
+ (#x17B4 . #x17B5)
+ (#x17B7 . #x17BD)
+ (#x17C6 . #x17C6)
+ (#x17C9 . #x17D3)
+ (#x17DD . #x17DD)
+ (#x180B . #x180D)
+ (#x18A9 . #x18A9)
+ (#x1920 . #x1922)
+ (#x1927 . #x1928)
+ (#x1932 . #x1932)
+ (#x1939 . #x193B)
+ (#x1A17 . #x1A18)
+ (#x1B00 . #x1B03)
+ (#x1B34 . #x1B34)
+ (#x1B36 . #x1B3A)
+ (#x1B3C . #x1B3C)
+ (#x1B42 . #x1B42)
+ (#x1B6B . #x1B73)
+ (#x1DC0 . #x1DFF)
+ (#x200B . #x200F)
+ (#x202A . #x202E)
+ (#x2060 . #x206F)
+ (#x20D0 . #x20EF)
+ (#x302A . #x302F)
+ (#x3099 . #x309A)
+ (#xA806 . #xA806)
+ (#xA80B . #xA80B)
+ (#xA825 . #xA826)
+ (#xFB1E . #xFB1E)
+ (#xFE00 . #xFE0F)
+ (#xFE20 . #xFE23)
+ (#xFEFF . #xFEFF)
+ (#xFFF9 . #xFFFB)
+ (#x10A01 . #x10A0F)
+ (#x10A38 . #x10A3F)
+ (#x1D167 . #x1D169)
+ (#x1D173 . #x1D182)
+ (#x1D185 . #x1D18B)
+ (#x1D1AA . #x1D1AD)
+ (#x1D242 . #x1D244)
+ (#xE0001 . #xE01EF))))
+ (dolist (elt l)
+ (set-char-table-range char-width-table elt 0)))
+
+;; 2: East Asian Wide and Full-width characters.
+(let ((l '((#x1100 . #x115F)
+ (#x2329 . #x232A)
+ (#x2E80 . #x303E)
+ (#x3040 . #xA4CF)
+ (#xAC00 . #xD7A3)
+ (#xF900 . #xFAFF)
+ (#xFE30 . #xFE6F)
+ (#xFF01 . #xFF60)
+ (#xFFE0 . #xFFE6)
+ (#x20000 . #x2FFFF)
+ (#x30000 . #x3FFFF))))
+ (dolist (elt l)
+ (set-char-table-range char-width-table elt 2)))
+
+;; Other double width
+;;(map-charset-chars
+;; (lambda (range ignore) (set-char-table-range char-width-table range 2))
+;; 'ethiopic)
+;; (map-charset-chars
+;; (lambda (range ignore) (set-char-table-range char-width-table range 2))
+;; 'tibetan)
+(map-charset-chars
+ (lambda (range ignore) (set-char-table-range char-width-table range 2))
+ 'indian-2-column)
+(map-charset-chars
+ (lambda (range ignore) (set-char-table-range char-width-table range 2))
+ 'arabic-2-column)
+
+(optimize-char-table (standard-case-table))
+(optimize-char-table (standard-category-table))
+(optimize-char-table (standard-syntax-table))
+
+;; The Unicode blocks actually extend past some of these ranges with
+;; undefined codepoints.
+(let ((script-list nil))
+ (dolist
+ (elt
+ '((#x0000 #x007F latin)
+ (#x00A0 #x036F latin)
+ (#x0370 #x03E1 greek)
+ (#x03E2 #x03EF coptic)
+ (#x03F0 #x03F3 greek)
+ (#x0400 #x04FF cyrillic)
+ (#x0530 #x058F armenian)
+ (#x0590 #x05FF hebrew)
+ (#x0600 #x06FF arabic)
+ (#x0700 #x074F syriac)
+ (#x07C0 #x07FA nko)
+ (#x0780 #x07BF thaana)
+ (#x0900 #x097F devanagari)
+ (#x0980 #x09FF bengali)
+ (#x0A00 #x0A7F gurmukhi)
+ (#x0A80 #x0AFF gujarati)
+ (#x0B00 #x0B7F oriya)
+ (#x0B80 #x0BFF tamil)
+ (#x0C00 #x0C7F telugu)
+ (#x0C80 #x0CFF kannada)
+ (#x0D00 #x0D7F malayalam)
+ (#x0D80 #x0DFF sinhala)
+ (#x0E00 #x0E5F thai)
+ (#x0E80 #x0EDF lao)
+ (#x0F00 #x0FFF tibetan)
+ (#x1000 #x105F myanmar)
+ (#x10A0 #x10FF georgian)
+ (#x1100 #x11FF hangul)
+ (#x1200 #x139F ethiopic)
+ (#x13A0 #x13FF cherokee)
+ (#x1400 #x167F canadian-aboriginal)
+ (#x1680 #x169F ogham)
+ (#x16A0 #x16FF runic)
+ (#x1780 #x17FF khmer)
+ (#x1800 #x18AF mongolian)
+ (#x1E00 #x1EFF latin)
+ (#x1F00 #x1FFF greek)
+ (#x2000 #x27FF symbol)
+ (#x2800 #x28FF braille)
+ (#x2D80 #x2DDF ethiopic)
+ (#x2E80 #x2FDF han)
+ (#x2FF0 #x2FFF ideographic-description)
+ (#x3000 #x303F cjk-misc)
+ (#x3040 #x30FF kana)
+ (#x3100 #x312F bopomofo)
+ (#x3130 #x318F hangul)
+ (#x3190 #x319F kanbun)
+ (#x31A0 #x31BF bopomofo)
+ (#x3400 #x9FAF han)
+ (#xA000 #xA4CF yi)
+ (#xAA80 #xAADF tai-viet)
+ (#xAC00 #xD7AF hangul)
+ (#xF900 #xFAFF han)
+ (#xFB1D #xFB4F hebrew)
+ (#xFB50 #xFDFF arabic)
+ (#xFE70 #xFEFC arabic)
+ (#xFF00 #xFF5F cjk-misc)
+ (#xFF61 #xFF9F kana)
+ (#xFFE0 #xFFE6 cjk-misc)
+ (#x1D000 #x1D0FF byzantine-musical-symbol)
+ (#x1D100 #x1D1FF musical-symbol)
+ (#x1D400 #x1D7FF mathematical)
+ (#x20000 #x2AFFF han)
+ (#x2F800 #x2FFFF han)))
+ (set-char-table-range char-script-table
+ (cons (car elt) (nth 1 elt)) (nth 2 elt))
+ (or (memq (nth 2 elt) script-list)
+ (setq script-list (cons (nth 2 elt) script-list))))
+ (set-char-table-extra-slot char-script-table 0 (nreverse script-list)))
+
+(map-charset-chars
+ #'(lambda (range ignore)
+ (set-char-table-range char-script-table range 'tibetan))
+ 'tibetan)
+
+\f
+;;; Setting word boundary.
+
+(defun next-word-boundary-han (pos limit)
+ (if (<= pos limit)
+ (save-excursion
+ (goto-char pos)
+ (looking-at "\\cC+")
+ (goto-char (match-end 0))
+ (if (looking-at "\\cH+")
+ (goto-char (match-end 0)))
+ (point))
+ (while (and (> pos limit)
+ (eq (aref char-script-table (char-after (1- pos))) 'han))
+ (setq pos (1- pos)))
+ pos))
+
+(defun next-word-boundary-kana (pos limit)
+ (if (<= pos limit)
+ (save-excursion
+ (goto-char pos)
+ (if (looking-at "\\cK+")
+ (goto-char (match-end 0)))
+ (if (looking-at "\\cH+")
+ (goto-char (match-end 0)))
+ (if (looking-at "\\ck+")
+ (goto-char (match-end 0)))
+ (point))
+ (let ((category-set (char-category-set (char-after pos)))
+ category)
+ (if (or (aref category-set ?K) (aref category-set ?k))
+ (while (and (> pos limit)
+ (setq category-set
+ (char-category-set (char-after (1- pos))))
+ (or (aref category-set ?K) (aref category-set ?k)))
+ (setq pos (1- pos)))
+ (while (and (> pos limit)
+ (aref (setq category-set
+ (char-category-set (char-after (1- pos)))) ?H))
+ (setq pos (1- pos)))
+ (setq category (cond ((aref category-set ?C) ?C)
+ ((aref category-set ?K) ?K)
+ ((aref category-set ?A) ?A)))
+ (when category
+ (setq pos (1- pos))
+ (while (and (> pos limit)
+ (aref (char-category-set (char-after (1- pos)))
+ category))
+ (setq pos (1- pos)))))
+ pos)))
+
+(map-char-table
+ #'(lambda (char script)
+ (cond ((eq script 'han)
+ (set-char-table-range find-word-boundary-function-table
+ char #'next-word-boundary-han))
+ ((eq script 'kana)
+ (set-char-table-range find-word-boundary-function-table
+ char #'next-word-boundary-kana))))
+ char-script-table)
+
+(setq word-combining-categories
+ '((?l . ?l)
+ (?C . ?C)
+ (?C . ?H)
+ (?C . ?K)))
+
+(setq word-separating-categories ; (2-byte character sets)
+ '((?A . ?K) ; Alpha numeric - Katakana
+ (?A . ?C) ; Alpha numeric - Chinese
+ (?H . ?A) ; Hiragana - Alpha numeric
+ (?H . ?K) ; Hiragana - Katakana
+ (?H . ?C) ; Hiragana - Chinese
+ (?K . ?A) ; Katakana - Alpha numeric
+ (?K . ?C) ; Katakana - Chinese
+ (?C . ?A) ; Chinese - Alpha numeric
+ (?C . ?K) ; Chinese - Katakana
+ ))
;; Local Variables:
-;; coding: iso-2022-7bit
+;; coding: utf-8
;; End:
;; arch-tag: 85889c35-9f4d-4912-9bf5-82de31b0d42d
;;; codepage.el --- MS-DOS/MS-Windows specific coding systems
-;; Copyright (C) 1998, 1999, 2000, 2002 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 1999, 2000, 2002, 2005 Free Software Foundation, Inc.
- ;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ ;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
;; Author: Eli Zaretskii
;; Maintainer: FSF
-;; Keywords: i18n ms-dos ms-windows codepage
+;; Keywords: i18n ms-dos ms-windows codepage obsolete
;; This file is part of GNU Emacs.
;;; Commentary:
;; Special coding systems for DOS/Windows codepage support.
-;;
-;; These coding systems perform conversion from the DOS/Windows
-;; codepage encoding to one of the ISO-8859 character sets. Each
-;; codepage has its corresponding ISO-8859 charset, chosen so as to be
-;; able to convert all (or most) of the characters. The idea is that
-;; Emacs internally works with the usual MULE charsets, and the
-;; conversion to and from the DOS codepage is performed on I/O only.
-;; See term/internal.el for the complementary setup of the DOS
-;; terminal display and input methods.
-;;
-;; Thanks to Ken'ichi Handa <handa@etl.go.jp> for writing the CCL
-;; encoders/decoders, and for help in debugging this code.
+;; Obsolete.
;;; Code:
(defvar dos-unsupported-char-glyph)
-(defun cp-coding-system-for-codepage-1 (coding mnemonic iso-name
- decoder encoder)
- "Make coding system CODING for a DOS codepage using translation tables.
-MNEMONIC is a character to be displayed on mode line for the coding system.
-ISO-NAME is the name of the ISO-8859 charset which corresponds to this
-codepage.
-DECODER is a translation table for converting characters in the DOS codepage
-encoding to Emacs multibyte characters.
-ENCODER is a translation table for encoding Emacs multibyte characters into
-external DOS codepage codes."
- (save-match-data
- (let* ((coding-name (symbol-name coding))
- (undef (if (eq system-type 'ms-dos)
- (if dos-unsupported-char-glyph
- (logand dos-unsupported-char-glyph 255)
- 127)
- ??))
- (safe-chars (make-char-table 'safe-chars))
- (ccl-decoder
- (ccl-compile
- ;; The 4 here supplies the buf_magnification parameter
- ;; for the CCL program. A multibyte character may take
- ;; at most 4-bytes.
- `(4 (loop (read r1)
- (if (r1 >= 128)
- ((r0 = ,(charset-id 'ascii))
- (translate-character ,decoder r0 r1)
- (write-multibyte-character r0 r1))
- (write r1))
- (repeat)))))
- (ccl-encoder
- (ccl-compile
- ;; The 2 here supplies the buf_magnification parameter for
- ;; the CCL program. Since the -dos coding system generates
- ;; \r\n for each \n, a factor of 2 covers even the worst case
- ;; of empty lines with a single \n.
- `(2 (loop (read-multibyte-character r0 r1)
- (if (r0 != ,(charset-id 'ascii))
- ((translate-character ,encoder r0 r1)
- (if (r0 == ,(charset-id 'japanese-jisx0208))
- ((r1 = ,undef)
- (write r1)))))
- (write-repeat r1))))))
-
- ;; Set elements of safe multibyte characters for this codepage
- ;; to t in the char-table safe-chars.
- (let ((tbl (get decoder 'translation-table))
- (i 128)
- ch)
- (while (< i 256)
- (setq ch (aref tbl i))
- (if ch (aset safe-chars ch t))
- (setq i (1+ i))))
-
- ;; Make coding system CODING.
- (make-coding-system
- coding 4 mnemonic
- (concat "8-bit encoding of " (symbol-name iso-name)
- " characters using IBM codepage " coding-name)
- (cons ccl-decoder ccl-encoder)
- `((safe-charsets ascii eight-bit-control eight-bit-graphic ,iso-name)
- (safe-chars . ,safe-chars)
- (valid-codes (0 . 255)))))))
-
-(defun cp-decoding-vector-for-codepage (table charset offset)
- "Create a vector for decoding IBM PC characters using conversion table
-TABLE into an ISO-8859 character set CHARSET whose first non-ASCII
-character is generated by (make-char CHARSET OFFSET)."
- (let* ((len (length table))
- (undefined-char
- (if (eq system-type 'ms-dos)
- (if dos-unsupported-char-glyph
- (logand dos-unsupported-char-glyph 255)
- 127)
- 32))
- (vec1 (make-vector 256 undefined-char))
- (i 0))
- (while (< i 256)
- (aset vec1 i i)
- (setq i (1+ i)))
- (setq i 0)
- (while (< i len)
- (if (aref table i)
- (aset vec1 (aref table i) (make-char charset (+ i offset))))
- (setq i (1+ i)))
- vec1))
-
-;;; You don't think I created all these tables below by hand, do you?
-;;; The following Awk script will create the table for cp850-to-Latin-1
-;;; conversion from the RFC 1345 file (the other tables are left as an
-;;; excercise):
-;;; BEGIN { n_pages = 11;
-;;; pn["IBM437"] = 0; pn["IBM850"] = 1; pn["IBM851"] = 2;
-;;; pn["IBM852"] = 3; pn["IBM855"] = 4; pn["IBM860"] = 5;
-;;; pn["IBM861"] = 6; pn["IBM862"] = 7; pn["IBM863"] = 8;
-;;; pn["IBM864"] = 9; pn["IBM865"] = 10;
-;;; }
-;;; $1 == "&charset" { charset = $2; }
-;;; $1 == "&code" { code = $2; }
-;;; /^ [^&]/ {
-;;; if ((charset ~ /^IBM(437|8(5[0125]|6[0-5]))$/) || (charset ~ /^ISO_8859-1/))
-;;; {
-;;; for (i = 1; i <= NF; i++)
-;;; chars[charset,code++] = $i;
-;;; }
-;;; }
-;;;
-;;; END {
-;;; for (i = 160; i < 256; i++)
-;;; {
-;;; c = chars["ISO_8859-1:1987",i];
-;;; if (c == "??") # skip unused positions
-;;; {
-;;; printf " nil";
-;;; if ((i - 159)%16 == 0)
-;;; printf "\n";
-;;; continue;
-;;; }
-;;; found = 0;
-;;; for (j in pn)
-;;; map[j] = "nil";
-;;; for (combined in chars)
-;;; {
-;;; candidate = chars[combined];
-;;; split (combined, separate, SUBSEP);
-;;; if (separate[1] == "IBM850" && candidate == c)
-;;; {
-;;; found = 1;
-;;; map[separate[1]] = separate[2];
-;;; }
-;;; }
-;;; printf " %s", map["IBM850"];
-;;; if ((i - 159)%16 == 0)
-;;; printf "\n";
-;;; }
-;;; }
-
-;;; WARNING WARNING WARNING!!!
-;;;
-;;; If you want to get fancy with these tables, remember that the inverse
-;;; tables, created by `cp-decoding-vector-for-codepage' above, are installed
-;;; on MS-DOS as nonascii-translation-table (see `dos-codepage-setup' on
-;;; internal.el). Therefore, you should NOT put any codes below 128 in
-;;; these tables! Otherwise, various Emacs commands and functions will
-;;; mysteriously fail! For example, a typical screwup is to map the Latin-N
-;;; acute accent character to the apostrophe, and have all regexps which
-;;; end with "\\'" begin to fail (e.g., the automatic setting of the major
-;;; mode by file name extension will stop working).
-;;;
-;;; You HAVE BEEN warned!
-
-;; US/English/PC-8/IBM-2. This doesn't support Latin-1 characters very
-;; well, but why not use what we can salvage?
-(defvar cp437-decode-table
- ;; Nth element is the code of a cp437 glyph for the multibyte
- ;; character created by (make-char 'latin-iso8859-1 (+ N 160)).
- ;; The element nil means there's no corresponding cp437 glyph.
- [
- 255 173 155 156 nil 157 179 nil nil nil 166 174 170 196 nil nil
- 248 241 253 nil nil nil nil 249 nil nil 167 175 172 171 nil 168
- nil nil nil nil 142 143 146 128 nil 144 nil nil nil nil nil nil
- nil 165 nil nil nil nil 153 nil nil nil nil nil 154 nil nil 225
- 133 160 131 nil 132 134 145 135 138 130 136 137 141 161 140 139
- nil 164 149 162 147 nil 148 246 nil 151 163 150 129 nil nil 152]
- "Table for converting ISO-8859-1 characters into codepage 437 glyphs.")
-(setplist 'cp437-decode-table
- '(charset latin-iso8859-1 language "Latin-1" offset 160))
-
-;; Multilingual (Latin-1)
-(defvar cp850-decode-table
- ;; Nth element is the code of a cp850 glyph for the multibyte
- ;; character created by (make-char 'latin-iso8859-1 (+ N 160)).
- ;; The element nil means there's no corresponding cp850 glyph.
- [
- 255 173 189 156 207 190 221 245 249 184 166 174 170 240 169 238
- 248 241 253 252 239 230 244 250 247 251 167 175 172 171 243 168
- 183 181 182 199 142 143 146 128 212 144 210 211 222 214 215 216
- 209 165 227 224 226 229 153 158 157 235 233 234 154 237 232 225
- 133 160 131 198 132 134 145 135 138 130 136 137 141 161 140 139
- 208 164 149 162 147 228 148 246 155 151 163 150 129 236 231 152]
- "Table for converting ISO-8859-1 characters into codepage 850 glyphs.")
-(setplist 'cp850-decode-table
- '(charset latin-iso8859-1 language "Latin-1" offset 160))
-
-;; Multilingual (Latin-9)
-(defvar cp858-decode-table
- ;; Nth element is the code of a cp858 glyph for the multibyte
- ;; character created by (make-char 'latin-iso8859-15 (+ N 160)).
- ;; The element nil means there's no corresponding cp858 glyph.
- [
- 255 173 189 156 213 190 221 245 249 184 166 174 170 240 169 238
- 248 241 253 252 239 230 244 250 247 251 167 175 172 171 243 168
- 183 181 182 199 142 143 146 128 212 144 210 211 222 214 215 216
- 209 165 227 224 226 229 153 158 157 235 233 234 154 237 232 225
- 133 160 131 198 132 134 145 135 138 130 136 137 141 161 140 139
- 208 164 149 162 147 228 148 246 155 151 163 150 129 236 231 152]
- "Table for converting ISO-8859-15 characters into codepage 858 glyphs.")
-(setplist 'cp858-decode-table
- '(charset latin-iso8859-15 language "Latin-9" offset 160))
-
-;; Greek
-(defvar cp851-decode-table
- [
- 255 nil nil 156 nil nil nil 245 249 nil nil 174 nil 240 nil nil
- 248 241 nil nil 239 nil 134 nil 141 143 144 175 146 171 149 152
- 161 164 165 166 167 168 169 170 172 173 181 182 184 183 189 190
- 198 199 nil 207 208 209 210 211 212 213 nil nil 155 157 158 159
- 252 214 215 216 221 222 224 225 226 227 228 229 230 231 232 233
- 234 235 237 236 238 242 243 244 246 250 160 251 162 163 253 nil]
- "Table for converting ISO-8859-7 characters into codepage 851 glyphs.")
-(setplist 'cp851-decode-table
- '(charset greek-iso8859-7 language "Greek" offset 160))
-
-;; Slavic/Eastern Europe (Latin-2)
-(defvar cp852-decode-table
- [
- 255 164 244 157 207 149 151 245 249 230 184 155 141 240 166 189
- 248 165 247 136 239 150 152 243 242 231 173 156 171 241 167 190
- 232 181 182 198 142 145 143 128 172 144 168 211 183 214 215 210
- 209 227 213 224 226 138 153 158 252 222 233 235 154 237 221 225
- 234 160 131 199 132 146 134 135 159 130 169 137 216 161 140 212
- 208 228 229 162 147 139 148 246 253 133 163 251 129 236 238 250]
- "Table for converting ISO-8859-2 characters into codepage 852 glyphs.")
-(setplist 'cp852-decode-table
- '(charset latin-iso8859-2 language "Latin-2" offset 160))
-
-;; Russian
-(defvar cp855-decode-table
- [
- 255 133 129 131 135 137 139 141 143 145 147 149 151 240 153 155
- 161 163 236 173 167 169 234 244 184 190 199 209 211 213 215 221
- 226 228 230 232 171 182 165 252 246 250 159 242 238 248 157 224
- 160 162 235 172 166 168 233 243 183 189 198 208 210 212 214 216
- 225 227 229 231 170 181 164 251 245 249 158 241 237 247 156 222
- 239 132 128 130 134 136 138 140 142 144 146 148 150 253 152 154]
- "Table for converting ISO-8859-5 characters into codepage 855 glyphs.")
-(setplist 'cp855-decode-table
- '(charset cyrillic-iso8859-5 language "Cyrillic-ISO" offset 160))
-
-;; Turkish
-(defvar cp857-decode-table
- [
- 255 nil nil 156 207 nil 245 249 152 158 166 nil 240 nil
- 248 nil 253 252 239 nil nil nil nil 141 159 167 nil 171 nil
- 183 181 182 142 nil nil 128 212 144 210 211 222 214 215 216
- 165 227 224 226 nil 153 232 nil 235 233 234 154 nil nil 225
- 133 160 131 132 nil nil 135 138 130 136 137 236 161 140 139
- 164 149 162 147 nil 148 246 nil 151 163 150 129 nil nil 250]
- "Table for converting ISO-8859-3 characters into codepage 857 glyphs.")
-(setplist 'cp857-decode-table
- '(charset latin-iso8859-3 language "Latin-3" offset 160))
-
-;; Portuguese
-(defvar cp860-decode-table
- [
- 255 173 155 156 nil nil 179 nil nil nil 166 174 170 nil nil nil
- nil 241 253 nil nil nil nil 249 nil nil 167 175 172 171 nil 168
- 145 134 143 142 nil nil nil 128 146 144 137 nil 152 nil 139 nil
- nil 165 159 169 140 153 nil nil nil 157 150 nil 154 nil nil nil
- 133 160 131 132 nil nil nil 135 138 130 136 nil 141 161 nil nil
- nil 164 149 162 147 148 nil 246 nil 151 163 nil 129 nil nil nil]
- "Table for converting ISO-8859-1 characters into codepage 860 glyphs.")
-(setplist 'cp860-decode-table
- '(charset latin-iso8859-1 language "Latin-1" offset 160))
-
-;; Icelandic
-(defvar cp861-decode-table
- [
- 255 173 nil 156 nil nil nil nil nil nil nil 174 170 nil nil nil
- nil 241 253 nil nil nil nil 249 nil nil nil 175 172 171 nil 168
- nil 164 nil nil 142 143 146 128 nil 144 nil nil nil 165 nil nil
- 139 nil 159 166 nil nil 153 nil 157 nil 167 nil 154 151 141 nil
- 133 160 131 nil 132 134 145 135 138 130 136 137 nil 161 nil nil
- 140 nil nil 162 147 nil 148 246 155 nil 163 150 129 152 149 nil]
- "Table for converting ISO-8859-1 characters into codepage 861 glyphs.")
-(setplist 'cp861-decode-table
- '(charset latin-iso8859-1 language "Latin-1" offset 160))
-
-;; Hebrew
-(defvar cp862-decode-table
- ;; Nth element is the code of a cp862 glyph for the multibyte
- ;; character created by (make-char 'hebrew-iso8859-8 (+ N 160)).
- ;; The element nil means there's no corresponding cp862 glyph.
- [
- 255 173 155 156 nil 157 179 nil nil nil nil 174 170 196 nil nil
- 248 241 253 nil nil 230 nil 249 nil nil 246 175 172 171 nil nil
- nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
- nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 205
- 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 nil nil nil nil nil]
- "Table for converting ISO-8859-8 characters into codepage 862 glyphs.")
-(setplist 'cp862-decode-table
- '(charset hebrew-iso8859-8 language "Hebrew" offset 160))
-
-;; French Canadian
-(defvar cp863-decode-table
- [
- 255 nil 155 156 152 nil 160 143 164 nil nil 174 170 nil nil 167
- nil 241 253 166 161 nil 134 249 165 nil nil 175 172 171 173 nil
- 142 nil 132 nil nil nil nil 128 145 144 146 148 nil nil 168 149
- nil nil nil nil 153 nil nil nil nil 157 nil 158 154 nil nil nil
- 133 nil 131 nil nil nil nil 135 138 130 136 137 141 nil 140 139
- nil nil nil 162 147 nil nil 246 nil 151 163 150 129 nil nil nil]
- "Table for converting ISO-8859-1 characters into codepage 863 glyphs.")
-(setplist 'cp863-decode-table
- '(charset latin-iso8859-1 language "Latin-1" offset 160))
-
-;; Arabic
-;; FIXME: Emacs doesn't seem to support the "Arabic" language
-;; environment yet. So this is only partially usable, for now
-(defvar cp864-decode-table
- [
- 255 nil nil nil 164 nil nil nil nil nil nil nil 172 161 nil nil
- nil nil nil nil nil nil nil nil nil nil nil 187 nil nil nil 191
- nil 193 194 195 196 nil 198 199 169 201 170 171 173 174 175 207
- 208 209 210 188 189 190 235 215 216 223 238 nil nil nil nil nil
- 224 247 248 252 251 239 242 243 232 233 253 nil nil nil nil nil
- nil 241 nil nil nil nil nil nil nil nil nil nil nil nil nil nil]
- "Table for converting ISO-8859-6 characters into codepage 864 glyphs.")
-(setplist 'cp864-decode-table
- '(charset arabic-iso8859-6 language nil offset 160))
-
-;; Arabic OEM codepage used by Windows
-;; FIXME: Emacs doesn't seem to support the "Arabic" language
-;; environment yet. So this is only partially usable, for now
-(defvar cp720-decode-table
- [
- 255 nil nil nil 148 nil nil nil nil nil nil nil nil 196 nil nil
- nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
- nil 152 153 154 155 157 158 159 160 161 162 163 164 165 166 167
- 168 169 170 171 172 173 224 225 226 227 228 nil nil nil nil nil
- 149 229 231 232 233 234 235 236 237 238 239 241 242 243 244 245
- 246 145 146 nil nil nil nil nil nil nil nil nil nil nil nil nil]
- "Table for converting ISO-8859-6 characters into codepage 720 glyphs.")
-(setplist 'cp720-decode-table
- '(charset arabic-iso8859-6 language nil offset 160))
-
-
-;; Nordic (Norwegian/Danish)
-(defvar cp865-decode-table
- [
- 255 173 nil 156 nil nil nil nil nil nil 166 174 170 nil nil nil
- nil 241 253 nil nil nil nil 249 nil nil 167 175 172 171 nil 168
- nil nil nil nil 142 143 146 128 nil 144 nil nil nil nil nil nil
- nil 165 nil nil nil nil 153 nil 157 nil nil nil 154 nil nil nil
- 133 160 131 nil 132 134 145 135 138 130 136 137 141 161 140 139
- nil 164 149 162 147 nil 148 246 155 151 163 150 129 nil nil 152]
- "Table for converting ISO-8859-1 characters into codepage 865 glyphs.")
-(setplist 'cp865-decode-table
- '(charset latin-iso8859-1 language "Latin-1" offset 160))
-
-;; Russian (Yes, another one! This one's supposed to be used
-;; on Windows as the Russian OEM code page.)
-(defvar cp866-decode-table
- [
- 255 240 nil nil 242 nil nil 244 nil nil nil nil nil nil 246 nil
- 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
- 252 241 nil nil 243 nil nil 245 nil nil nil nil nil nil 247 nil]
- "Table for converting ISO-8859-5 characters into codepage 866 glyphs.")
-(setplist 'cp866-decode-table
- '(charset cyrillic-iso8859-5 language "Cyrillic-ISO" offset 160))
-
-;; Greek (yes, another one!)
-(defvar cp869-decode-table
- [
- 255 139 140 156 nil nil 138 245 249 151 nil 174 137 240 nil 142
- 248 241 153 154 239 247 134 136 141 143 144 175 146 171 149 152
- 161 164 165 166 167 168 169 170 172 173 181 182 183 184 189 190
- 198 199 nil 207 208 209 210 211 212 213 145 150 155 157 158 159
- 252 214 215 216 221 222 224 225 226 227 228 229 230 231 232 233
- 234 235 237 236 238 242 243 244 246 250 160 251 162 163 253 nil]
- "Table for converting ISO-8859-7 characters into codepage 869 glyphs.")
-(setplist 'cp869-decode-table
- '(charset greek-iso8859-7 language "Greek" offset 160))
-
-;; Greek OEM codepage used by Windows
-(defvar cp737-decode-table
- [
- 255 nil nil nil nil nil 179 nil nil nil nil nil nil 196 nil nil
- 248 241 253 nil nil nil 234 250 235 236 237 nil 238 nil 239 240
- nil 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142
- 143 144 nil 145 146 147 148 149 150 151 244 245 225 226 227 229
- nil 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166
- 167 168 170 169 171 172 173 174 175 224 228 232 230 231 233 nil]
- "Table for converting ISO-8859-7 characters into codepage 737 glyphs.")
-(setplist 'cp737-decode-table
- '(charset greek-iso8859-7 language "Greek" offset 160))
-
-;; Conversion from codepages 770-775 to Latin-4 for Baltic countries.
-;; FIXME: Once we support Latin-7, these should be remapped into it.
-(defvar cp770-decode-table
- [
- 255 143 nil nil 155 nil 156 nil 157 159 137 168 nil 196 146 nil
- 248 133 nil nil nil nil 134 nil nil 158 136 152 nil nil 145 nil
- 160 nil nil nil 142 nil nil 173 128 nil 139 nil 144 nil nil 161
- nil nil nil 163 nil 149 153 nil nil 167 nil nil 154 nil 166 225
- 131 nil nil nil 132 nil nil 141 135 nil 138 nil 130 nil nil 140
- nil nil nil 162 nil 147 148 247 nil 151 nil nil 129 nil 150 nil]
- "Table for converting ISO-8859-4 characters into codepage 770 glyphs.")
-(setplist 'cp770-decode-table
- '(charset latin-iso8859-4 language "Latin-4" offset 160))
-
-(defvar cp773-decode-table
- [
- 255 220 nil 138 150 nil 234 190 166 246 237 149 173 196 252 nil
- 208 nil nil 139 239 nil 235 nil nil 247 137 133 136 nil 253 nil
- 160 nil nil nil 142 143 146 244 222 144 240 nil 242 nil nil 161
- nil 238 226 232 nil 229 153 158 157 248 nil nil 154 nil 250 225
- 131 nil nil nil 132 134 145 245 223 130 241 nil 243 nil nil 140
- nil 236 147 233 nil 228 148 198 155 249 nil nil 129 nil 251 nil]
- "Table for converting ISO-8859-4 characters into codepage 773 glyphs.")
-(setplist 'cp773-decode-table
- '(charset latin-iso8859-4 language "Latin-4" offset 160))
-
-(defvar cp774-decode-table
- [
- 255 181 nil nil 155 nil nil nil 245 190 nil nil nil 196 207 nil
- 248 208 nil nil nil nil nil nil nil 213 nil nil nil nil 216 nil
- nil nil nil nil 142 143 146 189 182 144 183 nil 184 nil nil nil
- nil nil nil nil nil nil 153 nil nil 198 nil nil 154 nil 199 225
- nil 160 nil nil 132 134 145 212 209 130 210 137 211 161 140 nil
- nil nil nil nil 147 nil 148 246 237 214 163 150 129 nil 215 248]
- "Table for converting ISO-8859-4 characters into codepage 774 glyphs.")
-(setplist 'cp774-decode-table
- '(charset latin-iso8859-4 language "Latin-4" offset 160))
-
-(defvar cp775-decode-table
- [
- 255 181 nil 138 150 nil 234 245 166 190 237 149 173 240 207 nil
- 248 208 nil 139 239 nil 235 nil nil 213 137 133 136 nil 216 nil
- 160 nil nil nil 142 143 146 189 182 144 183 nil 184 nil nil 161
- nil 238 226 232 nil 229 153 158 157 198 nil nil 154 nil 199 225
- 131 nil nil nil 132 134 145 212 209 130 210 nil 211 nil nil 140
- nil 236 147 233 nil 228 148 247 155 214 nil nil 129 nil 215 nil]
- "Table for converting ISO-8859-4 characters into codepage 775 glyphs.")
-(setplist 'cp775-decode-table
- '(charset latin-iso8859-4 language "Latin-4" offset 160))
-
-;; Support for the Windows 12xx series of codepages that MS has
-;; butchered from the ISO-8859 specs. This does not add support for
-;; the extended characters that MS has added in the 128 - 159 coding
-;; range, only translates those characters that can be expressed in
-;; the corresponding iso-8859 charset.
-
-;; Codepage Mapping:
-;;
-;; Windows-1250: ISO-8859-2 (Central Europe) - differs in some positions
-;; Windows-1251: ISO-8859-5 (Cyrillic) - differs wildly
-;; Windows-1252: ISO-8859-1 (West Europe) - exact match
-;; Windows-1253: ISO-8859-7 (Greek) - differs in some positions
-;; Windows-1254: ISO-8859-9 (Turkish) - exact match
-;; Windows-1255: ISO-8859-8 (Hebrew) - exact match
-;; Windows-1256: ISO-8859-6 (Arabic) - half match
-;; Windows-1257: ISO-8859-4 (Baltic) - differs, future Latin-7
-;; Windows-1258: VISCII (Vietnamese) - Completely different
-
-(defvar cp1250-decode-table
- [
- 160 165 162 163 164 188 140 167 168 138 170 141 143 173 142 175
- 176 185 178 179 180 190 156 161 184 154 186 157 159 189 158 191
- 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207
- 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223
- 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239
- 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 ]
- "ISO-8859-2 to Windows-1250 (Central Europe) codepage decoding table.")
-(setplist 'cp1250-decode-table
- '(charset latin-iso8859-2 language "Latin-2" offset 160))
-
-(defvar cp1251-decode-table
- [
- 160 168 128 129 170 189 178 175 163 138 140 142 141 173 161 143
- 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207
- 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223
- 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239
- 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255
- 185 184 144 131 186 190 179 191 188 154 156 158 157 167 162 159 ]
- "ISO-8859-5 to Windows-1251 (Cyrillic) codepage decoding table.")
-(setplist 'cp1251-decode-table
- '(charset cyrillic-iso8859-5 language "Cyrillic-ISO" offset 160))
-
-;; cp1253 is missing nbsp so we cannot quite translate perfectly. It
-;; also has two micro/mu characters which would require more complex
-;; processing to accomodate.
-(defvar cp1253-decode-table
- [
- nil 145 146 163 nil nil 166 167 168 169 nil 171 172 173 nil 151
- 176 177 178 179 180 161 162 183 184 185 186 187 188 189 190 191
- 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207
- 208 209 nil 211 212 213 214 215 216 217 218 219 220 221 222 223
- 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239
- 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 nil ]
- "ISO-8859-7 to Windows-1253 (Greek) codepage decoding table.")
-(setplist 'cp1253-decode-table
- '(charset greek-iso8859-7 language "Greek" offset 160))
-
-;; Since Latin-7 is not yet official, and Emacs does not support it,
-;; provide translation between Windows-1257 and Latin-4 the best we
-;; can.
-(defvar cp1257-decode-table
- [
- 160 192 nil 170 164 nil 207 167 nil 208 199 204 nil 173 222 nil
- 176 224 nil 186 nil nil 239 nil nil 240 231 236 nil nil 254 nil
- 194 nil nil nil 196 197 175 193 200 201 198 nil 203 nil nil 206
- nil 210 212 205 nil 213 214 215 168 216 nil nil 220 nil 219 223
- 226 nil nil nil 228 229 191 225 232 233 230 nil 235 nil nil 238
- nil 242 244 237 nil 245 246 247 184 248 nil nil 252 nil 251 nil ]
- "ISO-8859-4 to Windows-1257 (Baltic) codepage decoding table.")
-(setplist 'cp1257-decode-table
- '(charset latin-iso8859-4 language "Latin-4" offset 160))
-
-;;;###autoload
-(defun cp-make-coding-systems-for-codepage (codepage iso-name offset)
- "Create a coding system to convert IBM CODEPAGE into charset ISO-NAME
-whose first character is at offset OFFSET from the beginning of 8-bit
-ASCII table.
-
-The created coding system has the usual 3 subsidiary systems: for Unix-,
-DOS- and Mac-style EOL conversion. However, unlike built-in coding
-systems, the Mac-style EOL conversion is currently not supported by the
-decoder and encoder created by this function."
- (let* ((decode-table (intern (format "%s-decode-table" codepage)))
- (nonascii-table
- (intern (format "%s-nonascii-translation-table" codepage)))
- (decode-translation
- (intern (format "%s-decode-translation-table" codepage)))
- (encode-translation
- (intern (format "%s-encode-translation-table" codepage))))
- (set nonascii-table
- (make-translation-table-from-vector
- (cp-decoding-vector-for-codepage
- (symbol-value decode-table) iso-name offset)))
- (define-translation-table encode-translation
- (char-table-extra-slot (symbol-value nonascii-table) 0))
- ;; For charsets other than ascii, eight-bit-* and ISO-NAME, set
- ;; `?' for one-column charsets, and some Japanese character for
- ;; wide-column charsets. CCL encoder convert that Japanese
- ;; character to either dos-unsupported-char-glyph or "??".
- (let ((tbl (char-table-extra-slot (symbol-value nonascii-table) 0))
- (undef (if (eq system-type 'ms-dos)
- (if dos-unsupported-char-glyph
- (logand dos-unsupported-char-glyph 255)
- 127)
- ??))
- (charsets (delq 'ascii
- (delq 'eight-bit-control
- (delq 'eight-bit-graphic
- (delq iso-name
- (copy-sequence charset-list))))))
- (wide-column-char (make-char 'japanese-jisx0208 32 32)))
- (while charsets
- (aset tbl (make-char (car charsets))
- (if (= (charset-width (car charsets)) 1) undef wide-column-char))
- (setq charsets (cdr charsets))))
- (define-translation-table decode-translation
- (symbol-value nonascii-table))
- (cp-coding-system-for-codepage-1
- (intern codepage) ?D iso-name decode-translation encode-translation)
- ))
-
-(defun cp-codepage-decoder (codepage)
- "If CODEPAGE is the name of a supported codepage, return its decode table.
-Otherwise return nil."
- (let ((cp (if (symbolp codepage) (symbol-name codepage) codepage)))
- (cond
- ((stringp cp)
- (intern-soft (format "%s-decode-table" cp)))
- (t nil))))
+;; I doubt we need compatibility versions of any of these autoloaded
+;; functions apart from codepage-setup, which users may call.
+
+;; ;;;###autoload
+;; (defun cp-make-coding-systems-for-codepage (codepage iso-name offset)
+;; "Create a coding system to convert IBM CODEPAGE into charset ISO-NAME
+;; whose first character is at offset OFFSET from the beginning of 8-bit
+;; ASCII table.
+
+;; The created coding system has the usual 3 subsidiary systems: for Unix-,
+;; DOS- and Mac-style EOL conversion. However, unlike built-in coding
+;; systems, the Mac-style EOL conversion is currently not supported by the
+;; decoder and encoder created by this function."
+;; (let* ((decode-table (intern (format "%s-decode-table" codepage)))
+;; (nonascii-table
+;; (intern (format "%s-nonascii-translation-table" codepage)))
+;; (decode-translation
+;; (intern (format "%s-decode-translation-table" codepage)))
+;; (encode-translation
+;; (intern (format "%s-encode-translation-table" codepage))))
+;; (set nonascii-table
+;; (make-translation-table-from-vector
+;; (cp-decoding-vector-for-codepage
+;; (symbol-value decode-table) iso-name offset)))
+;; (define-translation-table encode-translation
+;; (char-table-extra-slot (symbol-value nonascii-table) 0))
+;; ;; For charsets other than ascii, eight-bit-* and ISO-NAME, set
+;; ;; `?' for one-column charsets, and some Japanese character for
+;; ;; wide-column charsets. CCL encoder convert that Japanese
+;; ;; character to either dos-unsupported-char-glyph or "??".
+;; (let ((tbl (char-table-extra-slot (symbol-value nonascii-table) 0))
+;; (undef (if (eq system-type 'ms-dos)
+;; (if dos-unsupported-char-glyph
+;; (logand dos-unsupported-char-glyph 255)
+;; 127)
+;; ??))
+;; (charsets (delq 'ascii
+;; (delq 'eight-bit-control
+;; (delq 'eight-bit-graphic
+;; (delq iso-name
+;; (copy-sequence charset-list))))))
+;; (wide-column-char (make-char 'japanese-jisx0208 32 32)))
+;; (while charsets
+;; (aset tbl (make-char (car charsets))
+;; (if (= (charset-width (car charsets)) 1) undef wide-column-char))
+;; (setq charsets (cdr charsets))))
+;; (define-translation-table decode-translation
+;; (symbol-value nonascii-table))
+;; (cp-coding-system-for-codepage-1
+;; (intern codepage) ?D iso-name decode-translation encode-translation)
+;; ))
+
+;; ;;;###autoload
+;; (defun cp-charset-for-codepage (codepage)
+;; "Return the charset for which there is a translation table to DOS CODEPAGE.
+;; CODEPAGE must be the name of a DOS codepage, a string."
+;; (let ((cp-decoder (cp-codepage-decoder codepage)))
+;; (if (null cp-decoder)
+;; (error "Unsupported codepage %s" codepage)
+;; (get cp-decoder 'charset))))
+
+;; ;;;###autoload
+;; (defun cp-language-for-codepage (codepage)
+;; "Return the name of the MULE language environment for CODEPAGE.
+;; CODEPAGE must be the name of a DOS codepage, a string."
+;; (let ((cp-decoder (cp-codepage-decoder codepage)))
+;; (if (null cp-decoder)
+;; (error "Unsupported codepage %s" codepage)
+;; (get cp-decoder 'language))))
+
+;; ;;;###autoload
+;; (defun cp-offset-for-codepage (codepage)
+;; "Return the offset to be used in setting up coding systems for CODEPAGE.
+;; CODEPAGE must be the name of a DOS codepage, a string."
+;; (let ((cp-decoder (cp-codepage-decoder codepage)))
+;; (if (null cp-decoder)
+;; (error "Unsupported codepage %s" codepage)
+;; (get cp-decoder 'offset))))
+
+;; ;;;###autoload
+;; (defun cp-supported-codepages ()
+;; "Return an alist of supported codepages.
+
+;; Each association in the alist has the form (NNN . CHARSET), where NNN is the
+;; codepage number, and CHARSET is the MULE charset which is the closest match
+;; for the character set supported by that codepage.
+
+;; A codepage NNN is supported if a variable called `cpNNN-decode-table' exists,
+;; is a vector, and has a charset property."
+;; (save-match-data
+;; (let (alist chset sname)
+;; (mapatoms
+;; (function
+;; (lambda (sym)
+;; (if (and (boundp sym)
+;; (string-match "\\`cp\\([1-9][0-9][0-9][0-9]?\\)-decode-table\\'"
+;; (setq sname (symbol-name sym)))
+;; (vectorp (symbol-value sym))
+;; (setq chset (get sym 'charset)))
+;; (setq alist
+;; (cons (cons (match-string 1 sname) chset) alist))))))
+;; alist)))
;;;###autoload
-(defun cp-charset-for-codepage (codepage)
- "Return the charset for which there is a translation table to DOS CODEPAGE.
-CODEPAGE must be the name of a DOS codepage, a string."
- (let ((cp-decoder (cp-codepage-decoder codepage)))
- (if (null cp-decoder)
- (error "Unsupported codepage %s" codepage)
- (get cp-decoder 'charset))))
-
-;;;###autoload
-(defun cp-language-for-codepage (codepage)
- "Return the name of the MULE language environment for CODEPAGE.
-CODEPAGE must be the name of a DOS codepage, a string."
- (let ((cp-decoder (cp-codepage-decoder codepage)))
- (if (null cp-decoder)
- (error "Unsupported codepage %s" codepage)
- (get cp-decoder 'language))))
-
-;;;###autoload
-(defun cp-offset-for-codepage (codepage)
- "Return the offset to be used in setting up coding systems for CODEPAGE.
-CODEPAGE must be the name of a DOS codepage, a string."
- (let ((cp-decoder (cp-codepage-decoder codepage)))
- (if (null cp-decoder)
- (error "Unsupported codepage %s" codepage)
- (get cp-decoder 'offset))))
-
-;;;###autoload
-(defun cp-supported-codepages ()
- "Return an alist of supported codepages.
-
-Each association in the alist has the form (NNN . CHARSET), where NNN is the
-codepage number, and CHARSET is the MULE charset which is the closest match
-for the character set supported by that codepage.
-
-A codepage NNN is supported if a variable called `cpNNN-decode-table' exists,
-is a vector, and has a charset property."
- (save-match-data
- (let (alist chset sname)
- (mapatoms
- (function
- (lambda (sym)
- (if (and (boundp sym)
- (string-match "\\`cp\\([1-9][0-9][0-9][0-9]?\\)-decode-table\\'"
- (setq sname (symbol-name sym)))
- (vectorp (symbol-value sym))
- (setq chset (get sym 'charset)))
- (setq alist
- (cons (cons (match-string 1 sname) chset) alist))))))
- alist)))
-
-;;;###autoload
-(defun codepage-setup (codepage)
- "Create a coding system cpCODEPAGE to support the IBM codepage CODEPAGE.
-
-These coding systems are meant for encoding and decoding 8-bit non-ASCII
-characters used by the IBM codepages, typically in conjunction with files
-read/written by MS-DOS software, or for display on the MS-DOS terminal."
- (interactive
- (let ((completion-ignore-case t)
- (candidates (cp-supported-codepages)))
- (list (completing-read "Setup DOS Codepage (default 437): " candidates
- nil t nil nil "437"))))
- (let* ((cp (format "cp%s" codepage))
- (cp-defined (intern-soft cp)))
- (or (and cp-defined ;; avoid defining if already defined
- (coding-system-p cp-defined))
- (cp-make-coding-systems-for-codepage
- cp (cp-charset-for-codepage cp) (cp-offset-for-codepage cp)))))
-
-;; Add DOS codepages to `non-iso-charset-alist'.
-(eval-after-load "mule-diag"
- '(let ((tail (cp-supported-codepages))
- elt)
- (while tail
- (setq elt (car tail) tail (cdr tail))
- ;; Now ELT is (CODEPAGE . CHARSET), where CODEPAGE is a string
- ;; (e.g. "850"), CHARSET is a charset that characters in CODEPAGE
- ;; are mapped to.
- (unless (assq (intern (concat "cp" (car elt))) non-iso-charset-alist)
- (setq non-iso-charset-alist
- (cons (list (intern (concat "cp" (car elt)))
- (list 'ascii (cdr elt))
- `(lambda (code)
- (decode-codepage-char ,(string-to-int (car elt))
- code))
- (list (list 0 255)))
- non-iso-charset-alist))))))
+(defun codepage-setup (&optional codepage)
+ "Obsolete. All coding systems are set up initially."
+ (interactive))
+(make-obsolete 'codepage-setup "no longer relevant" "23.1")
(provide 'codepage)
;;; encoded-kb.el --- handler to input multibyte characters encoded somehow
- ;; Copyright (C) 1997, 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ ;; Copyright (C) 1997, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
;; Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- ;; 2005, 2006, 2007
+ ;; 2005, 2006, 2007, 2008
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
+;; Copyright (C) 2003
+;; National Institute of Advanced Industrial Science and Technology (AIST)
+;; Registration Number H13PRO009
;; This file is part of GNU Emacs.
(defun encoded-kbd-self-insert-ccl (ignore)
(let ((str (char-to-string (encoded-kbd-last-key)))
- (ccl (car (aref (coding-system-spec (keyboard-coding-system)) 4)))
+ (ccl (coding-system-get (keyboard-coding-system) :ccl-decoder))
(vec [nil nil nil nil nil nil nil nil nil])
result)
(while (= (length (setq result (ccl-execute-on-string ccl vec str t))) 0)
(setq str (format "%s%c" str (read-char-exclusive))))
(vector (aref result 0))))
+
+;; Decode list of codes in CODE-LIST by CHARSET and return the decoded
+;; characters. If CODE-LIST is too short for the dimension of
+;; CHARSET, read new codes and append them to the tail of CODE-LIST.
+;; Return nil if CODE-LIST can't be decoded.
+
+(defun encoded-kbd-decode-code-list (charset code-list)
+ (let ((dimension (charset-dimension charset))
+ code)
+ (while (> dimension (length code-list))
+ (nconc code-list (list (read-char-exclusive))))
+ (setq code (car code-list))
+ (if (= dimension 1)
+ (decode-char charset code)
+ (setq code-list (cdr code-list)
+ code (logior (lsh code 8) (car code-list)))
+ (if (= dimension 2)
+ (decode-char charset code)
+ (setq code-list (cdr code-list)
+ code (logior (lsh code 8) (car code-list)))
+ (if (= dimension 3)
+ (decode-char charset code)
+ ;; As Emacs can't handle full 32-bit integer, we must give a
+ ;; cons of higher and lower 16-bit codes to decode-char.
+ (setq code (cons (lsh code -8)
+ (logior (lsh (car code-list) 8) (cadr code-list))))
+ (decode-char charset code))))))
+
+(defun encoded-kbd-self-insert-charset (ignore)
+ (let ((charset-list
+ (coding-system-get (keyboard-coding-system) :charset-list))
+ (code-list (list (encoded-kbd-last-key)))
+ tail char)
+ (while (and charset-list (not char))
+ (setq char (encoded-kbd-decode-code-list (car charset-list) code-list)
+ charset-list (cdr charset-list)))
+ (if char
+ (vector char)
+ (setq unread-command-events (cdr code-list))
+ (vector (car code-list)))))
+
+(defun encoded-kbd-self-insert-utf-8 (arg)
+ (interactive "p")
+ (let ((char (encoded-kbd-last-key))
+ len)
+ (cond ((< char #xE0)
+ (setq len 1 char (logand char #x1F)))
+ ((< char #xF0)
+ (setq len 2 char (logand char #x0F)))
+ ((< char #xF8)
+ (setq len 3 char (logand char #x07)))
+ (t
+ (setq len 4 char 0)))
+ (while (> len 0)
+ (setq char (logior (lsh char 6) (logand (read-char-exclusive) #x3F))
+ len (1- len)))
+ (vector char)))
+
(defun encoded-kbd-setup-keymap (keymap coding)
;; At first, reset the keymap.
(define-key encoded-kbd-mode-map "\e" nil)
;; Then setup the keymap according to the keyboard coding system.
(cond
- ((eq (coding-system-type coding) 1) ; SJIS
+ ((eq (coding-system-type coding) 'shift-jis)
(let ((i 128))
(while (< i 256)
(define-key keymap
(setq i (1+ i))))
8)
- ((eq (coding-system-type coding) 3) ; Big5
- (let ((i 161))
- (while (< i 255)
- (define-key keymap
- (vector i) 'encoded-kbd-self-insert-big5)
- (setq i (1+ i))))
+ ((eq (coding-system-type coding) 'charset)
+ (dolist (elt (mapcar
+ #'(lambda (x)
+ (let ((dim (charset-dimension x))
+ (code-space (get-charset-property x :code-space)))
+ (cons (aref code-space (* (1- dim) 2))
+ (aref code-space (1+ (* (1- dim) 2))))))
+ (coding-system-get coding :charset-list)))
+ (let ((from (max (car elt) 128))
+ (to (cdr elt)))
+ (while (<= from to)
+ (define-key keymap
+ (vector from) 'encoded-kbd-self-insert-charset)
+ (setq from (1+ from)))))
8)
- ((eq (coding-system-type coding) 2) ; ISO-2022
- (let ((flags (coding-system-flags coding))
- use-designation)
- (if (aref flags 8)
+ ((eq (coding-system-type coding) 'iso-2022)
+ (let ((flags (coding-system-get coding :flags))
+ (designation (coding-system-get coding :designation)))
+ (if (memq 'locking-shift flags)
nil ; Don't support locking-shift.
(setq encoded-kbd-iso2022-designations (make-vector 4 nil)
encoded-kbd-iso2022-invocations (make-vector 3 nil))
(dotimes (i 4)
- (if (aref flags i)
- (if (charsetp (aref flags i))
+ (if (aref designation i)
+ (if (charsetp (aref designation i))
(aset encoded-kbd-iso2022-designations
- i (aref flags i))
- (setq use-designation t)
- (if (charsetp (car-safe (aref flags i)))
+ i (aref designation i))
+ (if (charsetp (car-safe (aref designation i)))
(aset encoded-kbd-iso2022-designations
- i (car (aref flags i)))))))
+ i (car (aref designation i)))))))
(aset encoded-kbd-iso2022-invocations 0 0)
(if (aref encoded-kbd-iso2022-designations 1)
(aset encoded-kbd-iso2022-invocations 1 1))
- (when use-designation
+ (when (memq 'designation flags)
(define-key encoded-kbd-mode-map "\e" 'encoded-kbd-iso2022-esc-prefix)
(define-key keymap "\e" 'encoded-kbd-iso2022-esc-prefix))
- (when (or (aref flags 2) (aref flags 3))
+ (when (or (aref designation 2) (aref designation 3))
(define-key keymap
[?\216] 'encoded-kbd-iso2022-single-shift)
(define-key keymap
[?\217] 'encoded-kbd-iso2022-single-shift))
- (or (eq (aref flags 0) 'ascii)
+ (or (eq (aref designation 0) 'ascii)
(dotimes (i 96)
(define-key keymap
(vector (+ 32 i)) 'encoded-kbd-self-insert-iso2022-7bit)))
- (if (aref flags 7)
+ (if (memq '7-bit flags)
t
(dotimes (i 96)
(define-key keymap
8))))
((eq (coding-system-type coding) 4) ; CCL-base
- (let ((valid-codes (or (coding-system-get coding 'valid-codes)
+ (let ((valid-codes (or (coding-system-get coding :valid)
'((128 . 255))))
elt from to valid)
(while valid-codes
(setq from (1+ from))))
8))
+ ((eq (coding-system-type coding) 'utf-8)
+ (let ((i #xC0))
+ (while (< i 256)
+ (define-key keymap
+ (vector i) 'encoded-kbd-self-insert-utf-8)
+ (setq i (1+ i))))
+ 8)
+
(t
nil)))
;;; fontset.el --- commands for handling fontset
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- ;; 2005, 2006, 2007 Free Software Foundation, Inc.
+ ;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- ;; 2005, 2006, 2007
+ ;; 2005, 2006, 2007, 2008
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
+;; Copyright (C) 2003, 2006
+;; National Institute of Advanced Industrial Science and Technology (AIST)
+;; Registration Number H13PRO009
-;; Keywords: mule, multilingual, fontset
+;; Keywords: mule, i18n, fontset
;; This file is part of GNU Emacs.
;;; Code:
+;; Setup font-encoding-alist for all known encodings.
+
+(setq font-encoding-alist
+ '(("iso8859-1$" . iso-8859-1)
+ ("iso8859-2$" . iso-8859-2)
+ ("iso8859-3$" . iso-8859-3)
+ ("iso8859-4$" . iso-8859-4)
+ ("iso8859-5$" . iso-8859-5)
+ ("iso8859-6$" . iso-8859-6)
+ ("iso8859-7$" . iso-8859-7)
+ ("iso8859-8$" . iso-8859-8)
+ ("iso8859-9$" . iso-8859-9)
+ ("iso8859-10$" . iso-8859-10)
+ ("iso8859-11$" . iso-8859-11)
+ ("iso8859-13$" . iso-8859-13)
+ ("iso8859-14$" . iso-8859-14)
+ ("iso8859-15$" . iso-8859-15)
+ ("gb2312.1980" . chinese-gb2312)
+ ("gbk" . chinese-gbk)
+ ("gb18030" . (unicode . nil))
+ ("jisx0208.1978" . japanese-jisx0208-1978)
+ ("jisx0208" . japanese-jisx0208)
+ ("jisx0201" . jisx0201)
+ ("jisx0212" . japanese-jisx0212)
+ ("ksc5601.1987" . korean-ksc5601)
+ ("cns11643.1992.*1" . chinese-cns11643-1)
+ ("cns11643.1992.*2" . chinese-cns11643-2)
+ ("cns11643.1992.*3" . chinese-cns11643-3)
+ ("cns11643.1992.*4" . chinese-cns11643-4)
+ ("cns11643.1992.*5" . chinese-cns11643-5)
+ ("cns11643.1992.*6" . chinese-cns11643-6)
+ ("cns11643.1992.*7" . chinese-cns11643-7)
+ ("cns11643.92p1-0" . chinese-cns11643-1)
+ ("cns11643.92p2-0" . chinese-cns11643-2)
+ ("cns11643.92p3-0" . chinese-cns11643-3)
+ ("cns11643.92p4-0" . chinese-cns11643-4)
+ ("cns11643.92p5-0" . chinese-cns11643-5)
+ ("cns11643.92p6-0" . chinese-cns11643-6)
+ ("cns11643.92p7-0" . chinese-cns11643-7)
+ ("big5" . big5)
+ ("viscii" . viscii)
+ ("tis620" . tis620-2533)
+ ("microsoft-cp1251" . windows-1251)
+ ("koi8-r" . koi8-r)
+ ("jisx0213.2000-1" . japanese-jisx0213-1)
+ ("jisx0213.2000-2" . japanese-jisx0213-2)
+ ("jisx0213.2004-1" . japanese-jisx0213.2004-1)
+ ("iso10646-1$" . (unicode-bmp . nil))
+ ("iso10646.indian-1" . (unicode-bmp . nil))
+ ("unicode-bmp" . (unicode-bmp . nil))
+ ("abobe-symbol" . symbol)
+ ("sisheng_cwnn" . chinese-sisheng)
+ ("mulearabic-0" . arabic-digit)
+ ("mulearabic-1" . arabic-1-column)
+ ("mulearabic-2" . arabic-2-column)
+ ("muleipa" . ipa)
+ ("ethiopic-unicode" . (unicode-bmp . ethiopic))
+ ("is13194-devanagari" . indian-is13194)
+ ("Devanagari-CDAC" . devanagari-cdac)
+ ("Sanskrit-CDAC" . sanskrit-cdac)
+ ("Bengali-CDAC" . bengali-cdac)
+ ("Assamese-CDAC" . assamese-cdac)
+ ("Punjabi-CDAC" . punjabi-cdac)
+ ("Gujarati-CDAC" . gujarati-cdac)
+ ("Oriya-CDAC" . oriya-cdac)
+ ("Tamil-CDAC" . tamil-cdac)
+ ("Telugu-CDAC" . telugu-cdac)
+ ("Kannada-CDAC" . kannada-cdac)
+ ("Malayalam-CDAC" . malayalam-cdac)
+ ("Devanagari-Akruti" . devanagari-akruti)
+ ("Bengali-Akruti" . bengali-akruti)
+ ("Punjabi-Akruti" . punjabi-akruti)
+ ("Gujarati-Akruti" . gujarati-akruti)
+ ("Oriya-Akruti" . oriya-akruti)
+ ("Tamil-Akruti" . tamil-akruti)
+ ("Telugu-Akruti" . telugu-akruti)
+ ("Kannada-Akruti" . kannada-akruti)
+ ("Malayalam-Akruti" . malayalam-akruti)
+ ("muleindian-2" . indian-2-column)
+ ("muleindian-1" . indian-1-column)
+ ("mulelao-1" . mule-lao)
+ ("muletibetan-2" . tibetan)
+ ("muletibetan-1" . tibetan-1-column)))
+
+(setq font-encoding-charset-alist
+ '((latin-iso8859-1 . iso-8859-1)
+ (latin-iso8859-2 . iso-8859-2)
+ (latin-iso8859-3 . iso-8859-3)
+ (latin-iso8859-4 . iso-8859-4)
+ (latin-iso8859-9 . iso-8859-9)
+ (latin-iso8859-10 . iso-8859-10)
+ (latin-iso8859-13 . iso-8859-13)
+ (latin-iso8859-14 . iso-8859-14)
+ (latin-iso8859-15 . iso-8859-15)
+ (latin-iso8859-16 . iso-8859-16)
+ (cyrillic-iso8859-5 . iso-8859-5)
+ (greek-iso8859-7 . iso-8859-7)
+ (arabic-iso8859-6 . iso-8859-6)
+ (thai-tis620 . tis620-2533)
+ (latin-jisx0201 . jisx0201)
+ (katakana-jisx0201 . jisx0201)
+ (chinese-big5-1 . big5)
+ (chinese-big5-2 . big5)
+ (vietnamese-viscii-lower . viscii)
+ (vietnamese-viscii-upper . viscii)
+ (tibetan . unicode-bmp)))
+
+(setq script-representative-chars
+ '((latin ?A ?Z ?a ?z)
+ (greek #x3A9)
+ (coptic #x3E2)
+ (cyrillic #x42F)
+ (armenian #x531)
+ (hebrew #x5D0)
+ (arabic #x628)
+ (syriac #x710)
+ (thaana #x78C)
+ (devanagari #x915)
+ (bengali #x995)
+ (gurmukhi #xA15)
+ (gujarati #xA95)
+ (oriya #xB15)
+ (tamil #xB95)
+ (telugu #xC15)
+ (kannada #xC95)
+ (malayalam #xD15)
+ (sinhala #xD95)
+ (thai #xE17)
+ (lao #xEA5)
+ (tibetan #xF40)
+ (myanmar #x1000)
+ (georgian #x10D3)
+ (ethiopic #x1208)
+ (cherokee #x13B6)
+ (canadian-aboriginal #x14C0)
+ (ogham #x168F)
+ (runic #x16A0)
+ (khmer #x1780)
+ (mongolian #x1826)
+ (braille #x2800)
+ (ideographic-description #x2FF0)
+ (cjk-misc #x300E)
+ (kana #x304B)
+ (bopomofo #x3105)
+ (kanbun #x319D)
+ (han #x5B57)
+ (yi #xA288)
+ (hangul #xAC00)))
+
+(setq otf-script-alist
+ '((arab . arabic)
+ (armn . armenian)
+ (bali . balinese)
+ (beng . bengali)
+ (bopo . bopomofo)
+ (brai . braille)
+ (bugi . buginese)
+ (buhd . buhid)
+ (byzm . byzantine-musical-symbol)
+ (cans . canadian-aboriginal)
+ (cher . cherokee)
+ (copt . coptic)
+ (xsux . cuneiform)
+ (cyrl . cyrillic)
+ (cprt . cypriot)
+ (dsrt . deseret)
+ (deva . devanagari)
+ (ethi . ethiopic)
+ (geor . georgian)
+ (glag . glagolitic)
+ (goth . gothic)
+ (grek . greek)
+ (gujr . gujarati)
+ (guru . gurmukhi)
+ (hani . han)
+ (hang . hangul)
+ (hano . hanunoo)
+ (hebr . hebrew)
+ (kana . kana)
+ (knda . kannada)
+ (khar . kharoshthi)
+ (khmr . khmer)
+ (lao\ . lao)
+ (latn . latin)
+ (limb . limbu)
+ (linb . linear_b)
+ (mlym . malayalam)
+ (math . mathematical)
+ (mong . mongolian)
+ (musc . musical-symbol)
+ (mymr . myanmar)
+ (nko\ . nko)
+ (ogam . ogham)
+ (ital . old_italic)
+ (xpeo . old_persian)
+ (orya . oriya)
+ (osma . osmanya)
+ (phag . phags-pa)
+ (phnx . phoenician)
+ (runr . runic)
+ (shaw . shavian)
+ (sinh . sinhala)
+ (sylo . syloti_nagri)
+ (syrc . syriac)
+ (tglg . tagalog)
+ (tagb . tagbanwa)
+ (taml . tamil)
+ (tale . tai_le)
+ (telu . telugu)
+ (thaa . thaana)
+ (thai . thai)
+ (tibt . tibetan)
+ (tfng . tifinagh)
+ (ugar . ugaritic)
+ (yi\ \ . yi)))
+
;; Set standard fontname specification of characters in the default
-;; fontset to find an appropriate font for each charset. This is used
-;; to generate a font name for a fontset if the fontset doesn't
-;; specify a font name for a specific character. The specification
-;; has the form (FAMILY . REGISTRY). FAMILY may be nil, in which
-;; case, the family name of default face is used. If REGISTRY
-;; contains a character `-', the string before that is embedded in
-;; `CHARSET_REGISTRY' field, and the string after that is embedded in
-;; `CHARSET_ENCODING' field. If it does not contain `-', the whole
-;; string is embedded in `CHARSET_REGISTRY' field, and a wild card
-;; character `*' is embedded in `CHARSET_ENCODING' field. The
-;; REGISTRY for ASCII characters are predefined as "ISO8859-1".
+;; fontset to find an appropriate font for each script/charset. The
+;; specification has the form ((SCRIPT FONT-SPEC ...) ...), where
+;; FONT-SPEC is:
+;; a cons (FAMILY . REGISTRY),
+;; or a string FONT-NAME,
+;; or an object created by `font-spec'.
+;;
+;; FAMILY may be nil, in which case, the the corresponding name of
+;; default face is used. If REGISTRY contains a character `-', the
+;; string before that is embedded in `CHARSET_REGISTRY' field, and the
+;; string after that is embedded in `CHARSET_ENCODING' field. If it
+;; does not contain `-', the whole string is embedded in
+;; `CHARSET_REGISTRY' field, and a wild card character `*' is embedded
+;; in `CHARSET_ENCODING' field.
+;;
+;; SCRIPT is a symbol that appears as an element of the char table
+;; `char-script-table'. SCRIPT may be a charset specifying the range
+;; of characters.
(defun setup-default-fontset ()
"Setup the default fontset."
- (dolist (elt
- `((latin-iso8859-1 . (nil . "ISO8859-1"))
- (latin-iso8859-2 . (nil . "ISO8859-2"))
- (latin-iso8859-3 . (nil . "ISO8859-3"))
- (latin-iso8859-4 . (nil . "ISO8859-4"))
- ;; Setting "*" family is for a workaround of the problem
- ;; that a font of wrong size is preferred if the font
- ;; family matches with a requested one.
- (thai-tis620 . ("*" . "TIS620"))
- (greek-iso8859-7 . (nil . "ISO8859-7"))
- (arabic-iso8859-6 . (nil . "ISO8859-6"))
- (hebrew-iso8859-8 . (nil . "ISO8859-8"))
- (katakana-jisx0201 . (nil . "JISX0201"))
- (latin-jisx0201 . (nil . "JISX0201"))
- (cyrillic-iso8859-5 . (nil . "ISO8859-5"))
- (latin-iso8859-9 . (nil . "ISO8859-9"))
- (japanese-jisx0208-1978 . (nil . "JISX0208.1978"))
- (chinese-gb2312 . (nil . "GB2312.1980"))
- (japanese-jisx0208 . (nil . "JISX0208.1990"))
- (korean-ksc5601 . (nil . "KSC5601.1989"))
- (japanese-jisx0212 . (nil . "JISX0212"))
- (chinese-cns11643-1 . (nil . "CNS11643.1992-1"))
- (chinese-cns11643-2 . (nil . "CNS11643.1992-2"))
- (chinese-cns11643-3 . (nil . "CNS11643.1992-3"))
- (chinese-cns11643-4 . (nil . "CNS11643.1992-4"))
- (chinese-cns11643-5 . (nil . "CNS11643.1992-5"))
- (chinese-cns11643-6 . (nil . "CNS11643.1992-6"))
- (chinese-cns11643-7 . (nil . "CNS11643.1992-7"))
- (chinese-big5-1 . (nil . "Big5"))
- (chinese-big5-2 . (nil . "Big5"))
- (chinese-sisheng . (nil . "sisheng_cwnn"))
- (vietnamese-viscii-lower . (nil . "VISCII1.1"))
- (vietnamese-viscii-upper . (nil . "VISCII1.1"))
- (arabic-digit . (nil . "MuleArabic-0"))
- (arabic-1-column . (nil . "MuleArabic-1"))
- (arabic-2-column . (nil . "MuleArabic-2"))
- (ipa . (nil . "MuleIPA"))
- (ethiopic . (nil . "Ethiopic-Unicode"))
- (ascii-right-to-left . (nil . "ISO8859-1"))
- (indian-is13194 . (nil . "IS13194-Devanagari"))
- (indian-2-column . (nil . "MuleIndian-2"))
- (lao . (nil . "MuleLao-1"))
- (tibetan . ("proportional" . "MuleTibetan-2"))
- (tibetan-1-column . (nil . "MuleTibetan-1"))
- (latin-iso8859-14 . (nil . "ISO8859-14"))
- (latin-iso8859-15 . (nil . "ISO8859-15"))
- (mule-unicode-0100-24ff . (nil . "ISO10646-1"))
- (mule-unicode-2500-33ff . (nil . "ISO10646-1"))
- (mule-unicode-e000-ffff . (nil . "ISO10646-1"))
- (japanese-jisx0213-1 . (nil . "JISX0213.2000-1"))
- (japanese-jisx0213-2 . (nil . "JISX0213.2000-2"))
- ;; unicode
- ((,(decode-char 'ucs #x0900) . ,(decode-char 'ucs #x097F))
- . (nil . "ISO10646.indian-1"))
- ;; Indian CDAC
- (,(indian-font-char-range 'cdac:dv-ttsurekh)
- . (nil . "Devanagari-CDAC"))
- (,(indian-font-char-range 'cdac:sd-ttsurekh)
- . (nil . "Sanskrit-CDAC"))
- (,(indian-font-char-range 'cdac:bn-ttdurga)
- . (nil . "Bengali-CDAC"))
- (,(indian-font-char-range 'cdac:as-ttdurga)
- . (nil . "Assamese-CDAC"))
- (,(indian-font-char-range 'cdac:pn-ttamar)
- . (nil . "Punjabi-CDAC"))
- (,(indian-font-char-range 'cdac:gj-ttavantika)
- . (nil . "Gujarati-CDAC"))
- (,(indian-font-char-range 'cdac:or-ttsarala)
- . (nil . "Oriya-CDAC"))
- (,(indian-font-char-range 'cdac:tm-ttvalluvar)
- . (nil . "Tamil-CDAC"))
- (,(indian-font-char-range 'cdac:tl-tthemalatha)
- . (nil . "Telugu-CDAC"))
- (,(indian-font-char-range 'cdac:kn-ttuma)
- . (nil . "Kannada-CDAC"))
- (,(indian-font-char-range 'cdac:ml-ttkarthika)
- . (nil . "Malayalam-CDAC"))
- ;; Indian AKRUTI
- (,(indian-font-char-range 'akruti:dev)
- . (nil . "Devanagari-Akruti"))
- (,(indian-font-char-range 'akruti:bng)
- . (nil . "Bengali-Akruti"))
- (,(indian-font-char-range 'akruti:pnj)
- . (nil . "Punjabi-Akruti"))
- (,(indian-font-char-range 'akruti:guj)
- . (nil . "Gujarati-Akruti"))
- (,(indian-font-char-range 'akruti:ori)
- . (nil . "Oriya-Akruti"))
- (,(indian-font-char-range 'akruti:tml)
- . (nil . "Tamil-Akruti"))
- (,(indian-font-char-range 'akruti:tlg)
- . (nil . "Telugu-Akruti"))
- (,(indian-font-char-range 'akruti:knd)
- . (nil . "Kannada-Akruti"))
- (,(indian-font-char-range 'akruti:mal)
- . (nil . "Malayalam-Akruti"))
- ))
- (set-fontset-font "fontset-default" (car elt) (cdr elt))))
-
-;; Set arguments in `font-encoding-alist' (which see).
-(defun set-font-encoding (pattern charset encoding)
+ (new-fontset
+ "fontset-default"
+ `(;; for each script
+ (latin (nil . "ISO8859-1")
+ (nil . "ISO8859-2")
+ (nil . "ISO8859-3")
+ (nil . "ISO8859-4")
+ (nil . "ISO8859-9")
+ (nil . "ISO8859-10")
+ (nil . "ISO8859-13")
+ (nil . "ISO8859-14")
+ (nil . "ISO8859-15")
+ (nil . "VISCII1.1-1"))
+
+ (thai ,(font-spec :registry "iso10646-1" :otf '(thai nil nil (mark)))
+ (nil . "TIS620*")
+ (nil . "ISO8859-11"))
+
+ (devanagari ,(font-spec :registry "iso10646-1" :otf '(deva nil (rphf)))
+ (nil . "iso10646.indian-1"))
+ (bengali ,(font-spec :registry "iso10646-1" :otf '(beng nil (rphf))))
+ (gurmukhi ,(font-spec :registry "iso10646-1" :otf '(guru nil (blwf))))
+ (gujarati ,(font-spec :registry "iso10646-1" :otf '(gujr nil (rphf))))
+ (oriya ,(font-spec :registry "iso10646-1" :otf '(orya nil (rphf))))
+ (tamil ,(font-spec :registry "iso10646-1" :otf '(taml nil (akhn))))
+ (telugu ,(font-spec :registry "iso10646-1" :otf '(telu nil (blwf))))
+ (kannada ,(font-spec :registry "iso10646-1" :otf '(knda nil (rphf))))
+ (sinhala ,(font-spec :registry "iso10646-1" :otf '(sinh nil (akhn))))
+ (malayalam ,(font-spec :registry "iso10646-1" :otf '(mlym nil (akhn))))
+
+ (lao ,(font-spec :registry "iso10646-1" :otf '(lao\ nil nil (mark)))
+ (nil . "MuleLao-1"))
+
+ (tai-viet ("TaiViet" . "iso10646-1"))
+
+ ;; both for script and charset.
+ (tibetan ,(font-spec :registry "iso10646-1"
+ :otf '(tibt nil (ccmp blws abvs)))
+ ,(font-spec :family "mtib" :registry "iso10646-1")
+ (nil . "muletibetan-2"))
+
+ ;; both for script and charset.
+ (ethiopic ,(font-spec :registry "iso10646-1" :script 'ethiopic)
+ (nil . "ethiopic-unicode"))
+
+ (greek ,(font-spec :registry "iso10646-1" :script 'greek)
+ (nil . "ISO8859-7"))
+
+ (cyrillic ,(font-spec :registry "iso10646-1" :script 'cyrillic)
+ (nil . "ISO8859-5")
+ (nil . "microsoft-cp1251")
+ (nil . "koi8-r"))
+
+ (arabic ,(font-spec :registry "iso10646-1"
+ :otf '(arab (init medi fini liga)))
+ (nil . "MuleArabic-0")
+ (nil . "MuleArabic-1")
+ (nil . "MuleArabic-2")
+ (nil . "ISO8859-6"))
+
+ (hebrew ,(font-spec :registry "iso10646-1" :script 'hebrew)
+ (nil . "ISO8859-8"))
+
+ (syriac ,(font-spec :registry "iso10646-1" :script 'syriac))
+
+ (thaana ,(font-spec :registry "iso10646-1" :otf '(thaa nil nil)))
+
+ (myanmar ,(font-spec :registry "iso10646-1" :script 'myanmar))
+
+ (georgian ,(font-spec :registry "iso10646-1" :script 'georgian))
+
+ (cherokee ,(font-spec :registry "iso10646-1" :script 'cherokee))
+
+ (canadian-aboriginal ,(font-spec :registry "iso10646-1"
+ :script 'canadian-aboriginal))
+
+ (ogham ,(font-spec :registry "iso10646-1" :script 'ogham))
+
+ (runic ,(font-spec :registry "iso10646-1" :script 'runic))
+
+ (khmer ,(font-spec :registry "iso10646-1" :otf '(khmr nil (pres))))
+
+ (yi ,(font-spec :registry "iso10646-1" :script 'yi))
+
+ (kana ,(font-spec :registry "iso10646-1" :script 'kana)
+ (nil . "JISX0208*")
+ (nil . "GB2312.1980-0")
+ (nil . "KSC5601.1987*")
+ (nil . "JISX0201*")
+ (nil . "JISX0213.2000-1")
+ (nil . "JISX0213.2004-1"))
+
+ (bopomofo (nil . "sisheng_cwnn-0"))
+
+ (han ,(font-spec :registry "iso10646-1" :language 'ja)
+ ,(font-spec :registry "iso10646-1" :language 'zh)
+ (nil . "GB2312.1980-0")
+ (nil . "JISX0208*")
+ (nil . "JISX0212*")
+ (nil . "big5*")
+ (nil . "KSC5601.1987*")
+ (nil . "CNS11643.1992-1")
+ (nil . "CNS11643.1992-2")
+ (nil . "CNS11643.1992-3")
+ (nil . "CNS11643.1992-4")
+ (nil . "CNS11643.1992-5")
+ (nil . "CNS11643.1992-6")
+ (nil . "CNS11643.1992-7")
+ (nil . "gbk-0")
+ (nil . "gb18030")
+ (nil . "JISX0213.2000-1")
+ (nil . "JISX0213.2000-2")
+ (nil . "JISX0213.2004-1"))
+
+ (cjk-misc (nil . "GB2312.1980-0")
+ (nil . "JISX0208*")
+ (nil . "JISX0212*")
+ (nil . "big5*")
+ (nil . "KSC5601.1987*")
+ (nil . "CNS11643.1992-1")
+ (nil . "CNS11643.1992-2")
+ (nil . "CNS11643.1992-3")
+ (nil . "CNS11643.1992-4")
+ (nil . "CNS11643.1992-5")
+ (nil . "CNS11643.1992-6")
+ (nil . "CNS11643.1992-7")
+ (nil . "gbk-0")
+ (nil . "gb18030")
+ (nil . "JISX0213.2000-1")
+ (nil . "JISX0213.2000-2"))
+
+ (hangul ,(font-spec :registry "iso10646-1" :language 'ko)
+ (nil . "KSC5601.1987-0"))
+
+ ;; for each charset
+ (ascii (nil . "ISO8859-1"))
+ (arabic-digit ("*" . "MuleArabic-0"))
+ (arabic-1-column ("*" . "MuleArabic-1"))
+ (arabic-2-column ("*" . "MuleArabic-2"))
+ (indian-is13194 (nil . "is13194-devanagari"))
+ (indian-1-column ("*" . "muleindian-2"))
+ ;; Indian CDAC
+ (devanagari-cdac (nil . "Devanagari-CDAC"))
+ (sanskrit-cdac (nil . "Sanskrit-CDAC"))
+ (bengali-cdac (nil . "Bengali-CDAC"))
+ (assamese-cdac (nil . "Assamese-CDAC"))
+ (punjabi-cdac (nil . "Punjabi-CDAC"))
+ (gujarati-cdac (nil . "Gujarati-CDAC"))
+ (oriya-cdac (nil . "Oriya-CDAC"))
+ (tamil-cdac (nil . "Tamil-CDAC"))
+ (telugu-cdac (nil . "Telugu-CDAC"))
+ (kannada-cdac (nil . "Kannada-CDAC"))
+ (malayalam-cdac (nil . "Malayalam-CDAC"))
+ ;; Indian AKRUTI
+ (devanagari-akruti (nil . "Devanagari-Akruti"))
+ (bengali-akruti (nil . "Bengali-Akruti"))
+ (punjabi-akruti (nil . "Punjabi-Akruti"))
+ (gujarati-akruti (nil . "Gujarati-Akruti"))
+ (oriya-akruti (nil . "Oriya-Akruti"))
+ (tamil-akruti (nil . "Tamil-Akruti"))
+ (telugu-akruti (nil . "Telugu-Akruti"))
+ (kannada-akruti (nil . "Kannada-Akruti"))
+ (malayalam-akruti (nil . "Malayalam-Akruti"))
+ ;;(devanagari-glyph ("altsys-dv_ttsurekh" . "devanagari-cdac"))
+ ;;(malayalam-glyph ("altsys-ml_ttkarthika" . "malayalam-cdac"))
+ (ipa (nil . "MuleIPA-1"))
+
+ ;; Fallback fonts
+ (nil (nil . "gb2312.1980")
+ (nil . "gbk-0")
+ (nil . "gb18030")
+ (nil . "jisx0208")
+ (nil . "ksc5601.1987")
+ (nil . "CNS11643.1992-1")
+ (nil . "CNS11643.1992-2")
+ (nil . "CNS11643.1992-3")
+ (nil . "CNS11643.1992-4")
+ (nil . "CNS11643.1992-5")
+ (nil . "CNS11643.1992-6")
+ (nil . "CNS11643.1992-7")
+ (nil . "big5")
+ (nil . "jisx0213.2000-1")
+ (nil . "jisx0213.2004-1")
+ (nil . "jisx0212"))
+ ))
+
+ ;; Append Unicode fonts.
+ ;; This may find fonts with more variants (bold, italic) but which
+ ;; don't cover many characters.
+ (set-fontset-font "fontset-default" nil
+ '(nil . "iso10646-1") nil 'append)
+ ;; These may find fonts that cover many characters but with fewer
+ ;; variants.
+ (set-fontset-font "fontset-default" nil
+ '("gnu-unifont" . "iso10646-1") nil 'append)
+ (set-fontset-font "fontset-default" nil
+ '("mutt-clearlyu" . "iso10646-1") nil 'append))
+
+;; These are the registered registries/encodings from
+;; ftp://ftp.x.org/pub/DOCS/registry 2001/06/01
+
+;; Name Reference
+;; ---- ---------
+;; "DEC" [27]
+;; registry prefix
+;; "DEC.CNS11643.1986-2" [53]
+;; CNS11643 2-plane using the encoding
+;; suggested in that standard
+;; "DEC.DTSCS.1990-2" [54]
+;; DEC Taiwan Supplemental Character Set
+;; "fujitsu.u90x01.1991-0" [87]
+;; "fujitsu.u90x03.1991-0" [87]
+;; "GB2312.1980-0" [39],[12]
+;; China (PRC) Hanzi, GL encoding
+;; "GB2312.1980-1" [39]
+;; (deprecated)
+;; China (PRC) Hanzi, GR encoding
+;; "HP-Arabic8" [36]
+;; HPARABIC8 8-bit character set
+;; "HP-East8" [36]
+;; HPEAST8 8-bit character set
+;; "HP-Greek8" [36]
+;; HPGREEK8 8-bit character set
+;; "HP-Hebrew8" [36]
+;; HPHEBREW8 8-bit character set
+;; "HP-Japanese15" [36]
+;; HPJAPAN15 15-bit characer set,
+;; modified from industry defacto
+;; standard Shift-JIS
+;; "HP-Kana8" [36]
+;; HPKANA8 8-bit character set
+;; "HP-Korean15" [36]
+;; HPKOREAN15 15-bit character set
+;; "HP-Roman8" [36]
+;; HPROMAN8 8-bit character set
+;; "HP-SChinese15" [36]
+;; HPSCHINA15 15-bit character set for
+;; support of Simplified Chinese
+;; "HP-TChinese15" [36]
+;; HPTCHINA15 15-bit character set for
+;; support of Traditional Chinese
+;; "HP-Turkish8" [36]
+;; HPTURKISH8 8-bit character set
+;; "IPSYS" [59]
+;; registry prefix
+;; "IPSYS.IE-1" [59]
+;; "ISO2022"<REG>"-"<ENC> [44]
+;; "ISO646.1991-IRV" [107]
+;; ISO 646 International Reference Version
+;; "ISO8859-1" [15],[12]
+;; ISO Latin alphabet No. 1
+;; "ISO8859-2" [15],[12]
+;; ISO Latin alphabet No. 2
+;; "ISO8859-3" [15],[12]
+;; ISO Latin alphabet No. 3
+;; "ISO8859-4" [15],[12]
+;; ISO Latin alphabet No. 4
+;; "ISO8859-5" [15],[12]
+;; ISO Latin/Cyrillic alphabet
+;; "ISO8859-6" [15],[12]
+;; ISO Latin/Arabic alphabet
+;; "ISO8859-7" [15],[12]
+;; ISO Latin/Greek alphabet
+;; "ISO8859-8" [15],[12]
+;; ISO Latin/Hebrew alphabet
+;; "ISO8859-9" [15],[12]
+;; ISO Latin alphabet No. 5
+;; "ISO8859-10" [15],[12]
+;; ISO Latin alphabet No. 6
+;; "ISO8859-13" [15],[12]
+;; ISO Latin alphabet No. 7
+;; "ISO8859-14" [15],[12]
+;; ISO Latin alphabet No. 8
+;; "ISO8859-15" [15],[12]
+;; ISO Latin alphabet No. 9
+;; "FCD8859-15" [7]
+;; (deprecated)
+;; ISO Latin alphabet No. 9, Final Committee Draft
+;; "ISO10646-1" [133]
+;; Unicode Universal Multiple-Octet Coded Character Set
+;; "ISO10646-MES" [133]
+;; (deprecated)
+;; Unicode Minimum European Subset
+;; "JISX0201.1976-0" [38],[12]
+;; 8-Bit Alphanumeric-Katakana Code
+;; "JISX0208.1983-0" [40],[12]
+;; Japanese Graphic Character Set,
+;; GL encoding
+;; "JISX0208.1990-0" [71]
+;; Japanese Graphic Character Set,
+;; GL encoding
+;; "JISX0208.1983-1" [40]
+;; (deprecated)
+;; Japanese Graphic Character Set,
+;; GR encoding
+;; "JISX0212.1990-0" [72]
+;; Supplementary Japanese Graphic Character Set,
+;; GL encoding
+;; "KOI8-R" [119]
+;; Cyrillic alphabet
+;; "KSC5601.1987-0" [41],[12]
+;; Korean Graphic Character Set,
+;; GL encoding
+;; "KSC5601.1987-1" [41]
+;; (deprecated)
+;; Korean Graphic Character Set,
+;; GR encoding
+;; "omron_CNS11643-0" [45]
+;; "omron_CNS11643-1" [45]
+;; "omron_BIG5-0" [45]
+;; "omron_BIG5-1" [45]
+;; "wn.tamil.1993" [103]
+
+(defun set-font-encoding (pattern charset)
+ "Set arguments in `font-encoding-alist' (which see)."
(let ((slot (assoc pattern font-encoding-alist)))
(if slot
- (let ((place (assq charset (cdr slot))))
- (if place
- (setcdr place encoding)
- (setcdr slot (cons (cons charset encoding) (cdr slot)))))
+ (setcdr slot charset)
(setq font-encoding-alist
- (cons (list pattern (cons charset encoding)) font-encoding-alist)))
- ))
-
-;; Allow display of arbitrary characters with an iso-10646-encoded
-;; (`Unicode') font.
-(define-translation-table 'ucs-mule-to-mule-unicode
- ucs-mule-to-mule-unicode)
-(define-translation-hash-table 'ucs-mule-cjk-to-unicode
- ucs-mule-cjk-to-unicode)
-
-(define-ccl-program ccl-encode-unicode-font
- `(0
- ;; r0: charset-id
- ;; r1: 1st position code
- ;; r2: 2nd position code (if r0 is 2D charset)
- ((if (r0 == ,(charset-id 'ascii))
- ((r2 = r1)
- (r1 = 0))
- ;; At first, try to get a Unicode code point directly.
- ((if (r2 >= 0)
- ;; This is a 2D charset.
- (r1 = ((r1 << 7) | r2)))
- (lookup-character utf-subst-table-for-encode r0 r1)
- (if r7
- ;; We got it!
- ((r1 = (r0 >> 8))
- (r2 = (r0 & #xFF)))
- ;; Look for a translation for non-ASCII chars.
- ((translate-character ucs-mule-to-mule-unicode r0 r1)
- (if (r0 == ,(charset-id 'ascii))
- ((r2 = r1)
- (r1 = 0))
- ((if (r0 == ,(charset-id 'latin-iso8859-1))
- ((r2 = (r1 + 128))
- (r1 = 0))
- ((r2 = (r1 & #x7F))
- (r1 >>= 7)
- (if (r0 == ,(charset-id 'mule-unicode-0100-24ff))
- ((r1 *= 96)
- (r1 += r2)
- (r1 += ,(- #x100 (* 32 96) 32))
- (r1 >8= 0)
- (r2 = r7))
- (if (r0 == ,(charset-id 'mule-unicode-2500-33ff))
- ((r1 *= 96)
- (r1 += r2)
- (r1 += ,(- #x2500 (* 32 96) 32))
- (r1 >8= 0)
- (r2 = r7))
- (if (r0 == ,(charset-id 'mule-unicode-e000-ffff))
- ((r1 *= 96)
- (r1 += r2)
- (r1 += ,(- #xe000 (* 32 96) 32))
- (r1 >8= 0)
- (r2 = r7))
- ;; No way, use the glyph for U+FFFD.
- ((r1 = #xFF)
- (r2 = #xFD)))))))))))))))
- "Encode characters for display with iso10646 font.
-Translate through the translation-hash-table named
-`ucs-mule-cjk-to-unicode' and the translation-table named
-`ucs-mule-to-mule-unicode' initially.")
-
-;; Use the above CCL encoder for Unicode fonts. Please note that the
-;; regexp is not simply "ISO10646-1" because there exists, for
-;; instance, the following Devanagari Unicode fonts:
-;; -misc-fixed-medium-r-normal--24-240-72-72-c-120-iso10646.indian-1
-;; -sibal-devanagari-medium-r-normal--24-240-75-75-P--iso10646-dev
-(setq font-ccl-encoder-alist
- (cons '("ISO10646.*-*" . ccl-encode-unicode-font)
- font-ccl-encoder-alist))
+ (cons (cons pattern charset) font-encoding-alist)))))
;; Setting for suppressing XLoadQueryFont on big fonts.
(setq x-pixel-size-width-font-regexp
- "gb2312\\|jisx0208\\|ksc5601\\|cns11643\\|big5")
+ "gb2312\\|gbk\\|gb18030\\|jisx0208\\|ksc5601\\|cns11643\\|big5")
;; These fonts require vertical centering.
(setq vertical-centering-font-regexp
- "gb2312\\|jisx0208\\|jisx0212\\|ksc5601\\|cns11643\\|big5")
+ "gb2312\\|gbk\\|gb18030\\|jisx0208\\|jisx0212\\|ksc5601\\|cns11643\\|big5")
;; CDAC fonts are actually smaller than their design sizes.
(setq face-font-rescale-alist
'(("-cdac$" . 1.3)))
-(defvar x-font-name-charset-alist
- '(("iso8859-1" ascii latin-iso8859-1)
- ("iso8859-2" ascii latin-iso8859-2)
- ("iso8859-3" ascii latin-iso8859-3)
- ("iso8859-4" ascii latin-iso8859-4)
- ("iso8859-5" ascii cyrillic-iso8859-5)
- ("iso8859-6" ascii arabic-iso8859-6)
- ("iso8859-7" ascii greek-iso8859-7)
- ("iso8859-8" ascii hebrew-iso8859-8)
- ("iso8859-14" ascii latin-iso8859-14)
- ("iso8859-15" ascii latin-iso8859-15)
- ("tis620" ascii thai-tis620)
- ("koi8" ascii cyrillic-iso8859-5)
- ("viscii" ascii vietnamese-viscii-upper vietnamese-viscii-lower)
- ("vscii" ascii vietnamese-viscii-upper vietnamese-viscii-lower)
- ("mulelao-1" ascii lao)
- ("iso10646-1" ascii latin-iso8859-1 mule-unicode-0100-24ff
- mule-unicode-2500-33ff mule-unicode-e000-ffff))
- "Alist of font names vs list of charsets the font can display.
-
-When a font name which matches some element of this alist is given as
-`-fn' command line argument or is specified by X resource, a fontset
-which uses the specified font for the corresponding charsets are
-created and used for the initial frame.")
+(defvar x-font-name-charset-alist nil
+ "This variable has no meaning now. Just kept for backward compatibility.")
;;; XLFD (X Logical Font Description) format handler.
;; Define XLFD's field index numbers. ; field name
-(defconst xlfd-regexp-foundry-subnum 0) ; FOUNDRY
-(defconst xlfd-regexp-family-subnum 1) ; FAMILY_NAME
-(defconst xlfd-regexp-weight-subnum 2) ; WEIGHT_NAME
-(defconst xlfd-regexp-slant-subnum 3) ; SLANT
-(defconst xlfd-regexp-swidth-subnum 4) ; SETWIDTH_NAME
-(defconst xlfd-regexp-adstyle-subnum 5) ; ADD_STYLE_NAME
-(defconst xlfd-regexp-pixelsize-subnum 6) ; PIXEL_SIZE
-(defconst xlfd-regexp-pointsize-subnum 7) ; POINT_SIZE
-(defconst xlfd-regexp-resx-subnum 8) ; RESOLUTION_X
-(defconst xlfd-regexp-resy-subnum 9) ; RESOLUTION_Y
-(defconst xlfd-regexp-spacing-subnum 10) ; SPACING
-(defconst xlfd-regexp-avgwidth-subnum 11) ; AVERAGE_WIDTH
-(defconst xlfd-regexp-registry-subnum 12) ; CHARSET_REGISTRY
-(defconst xlfd-regexp-encoding-subnum 13) ; CHARSET_ENCODING
+(defconst xlfd-regexp-family-subnum 0) ; FOUNDRY and FAMILY
+(defconst xlfd-regexp-weight-subnum 1) ; WEIGHT_NAME
+(defconst xlfd-regexp-slant-subnum 2) ; SLANT
+(defconst xlfd-regexp-swidth-subnum 3) ; SETWIDTH_NAME
+(defconst xlfd-regexp-adstyle-subnum 4) ; ADD_STYLE_NAME
+(defconst xlfd-regexp-pixelsize-subnum 5) ; PIXEL_SIZE
+(defconst xlfd-regexp-pointsize-subnum 6) ; POINT_SIZE
+(defconst xlfd-regexp-resx-subnum 7) ; RESOLUTION_X
+(defconst xlfd-regexp-resy-subnum 8) ; RESOLUTION_Y
+(defconst xlfd-regexp-spacing-subnum 8) ; SPACING
+(defconst xlfd-regexp-avgwidth-subnum 10) ; AVERAGE_WIDTH
+(defconst xlfd-regexp-registry-subnum 11) ; REGISTRY and ENCODING
;; Regular expression matching against a fontname which conforms to
;; XLFD (X Logical Font Description). All fields in XLFD should be
;; not be omitted (but can be a wild card) to be matched.
(defconst xlfd-tight-regexp
"^\
+-\\([^-]*-[^-]*\\)-\\([^-]*\\)-\\([^-]*\\)-\\([^-]*\\)\
-\\([^-]*\\)-\\([^-]*\\)-\\([^-]*\\)-\\([^-]*\\)-\\([^-]*\\)\
--\\([^-]*\\)-\\([^-]*\\)-\\([^-]*\\)-\\([^-]*\\)-\\([^-]*\\)\
--\\([^-]*\\)-\\([^-]*\\)-\\([^-]*\\)-\\([^-]*\\)$")
+-\\([^-]*\\)-\\([^-]*\\)-\\([^-]*-[^-]*\\)$")
+
+;; Regular expression matching against a fontname which conforms to
+;; XLFD (X Logical Font Description). All fields in XLFD from FOUNDRY
+;; to ADSTYLE, REGISTRY, and ENCODING should be not be omitted (but
+;; can be a wild card) to be matched.
+(defconst xlfd-style-regexp
+ "^\
+-\\([^-]*-[^-]*\\)-\\([^-]*\\)-\\([^-]*\\)-\\([^-]*\\)-\\([^-]*\\)-.*\
+-\\([^-]*-[^-]*\\)$")
;; List of field numbers of XLFD whose values are numeric.
(defconst xlfd-regexp-numeric-subnums
- (list xlfd-regexp-pixelsize-subnum ;6
- xlfd-regexp-pointsize-subnum ;7
- xlfd-regexp-resx-subnum ;8
- xlfd-regexp-resy-subnum ;9
- xlfd-regexp-avgwidth-subnum ;11
+ (list xlfd-regexp-pixelsize-subnum ;5
+ xlfd-regexp-pointsize-subnum ;6
+ xlfd-regexp-resx-subnum ;7
+ xlfd-regexp-resy-subnum ;8
+ xlfd-regexp-avgwidth-subnum ;10
))
(defun x-decompose-font-name (pattern)
- "Decompose PATTERN into XLFD's fields and return vector of the fields.
-The length of the vector is 14.
-
-If PATTERN doesn't conform to XLFD, try to get a full XLFD name from
-X server and use the information of the full name to decompose
-PATTERN. If no full XLFD name is gotten, return nil."
- (let (xlfd-fields fontname)
- (if (string-match xlfd-tight-regexp pattern)
- (let ((i 0))
- (setq xlfd-fields (make-vector 14 nil))
- (while (< i 14)
- (aset xlfd-fields i (match-string (1+ i) pattern))
- (setq i (1+ i)))
- xlfd-fields)
- (setq fontname (condition-case nil
- (x-resolve-font-name pattern)
- (error)))
- (if (and fontname
- (string-match xlfd-tight-regexp fontname))
- ;; We get a full XLFD name.
- (let ((len (length pattern))
- (i 0)
- l)
- ;; Setup xlfd-fields by the full XLFD name. Each element
- ;; should be a cons of matched index and matched string.
- (setq xlfd-fields (make-vector 14 nil))
- (while (< i 14)
- (aset xlfd-fields i
- (cons (match-beginning (1+ i))
- (match-string (1+ i) fontname)))
- (setq i (1+ i)))
-
- ;; Replace wild cards in PATTERN by regexp codes.
- (setq i 0)
- (while (< i len)
- (let ((ch (aref pattern i)))
- (if (= ch ??)
- (setq pattern (concat (substring pattern 0 i)
- "\\(.\\)"
- (substring pattern (1+ i)))
- len (+ len 4)
- i (+ i 4))
- (if (= ch ?*)
- (setq pattern (concat (substring pattern 0 i)
- "\\(.*\\)"
- (substring pattern (1+ i)))
- len (+ len 5)
- i (+ i 5))
- (setq i (1+ i))))))
-
- ;; Set each element of xlfd-fields to proper strings.
- (if (string-match pattern fontname)
- ;; The regular expression PATTERN matchs the full XLFD
- ;; name. Set elements that correspond to a wild card
- ;; in PATTERN to "*", set the other elements to the
- ;; exact strings in PATTERN.
- (let ((l (cdr (cdr (match-data)))))
- (setq i 0)
- (while (< i 14)
- (if (or (null l) (< (car (aref xlfd-fields i)) (car l)))
- (progn
- (aset xlfd-fields i (cdr (aref xlfd-fields i)))
- (setq i (1+ i)))
- (if (< (car (aref xlfd-fields i)) (car (cdr l)))
- (progn
- (aset xlfd-fields i "*")
- (setq i (1+ i)))
- (setq l (cdr (cdr l)))))))
- ;; Set each element of xlfd-fields to the exact string
- ;; in the corresonding fields in full XLFD name.
- (setq i 0)
- (while (< i 14)
- (aset xlfd-fields i (cdr (aref xlfd-fields i)))
- (setq i (1+ i))))
- xlfd-fields)))))
-
-;; Replace consecutive wild-cards (`*') in NAME to one.
-;; Ex. (x-reduce-font-name "-*-*-*-iso8859-1") => "-*-iso8859-1"
-(defsubst x-reduce-font-name (name)
- (while (string-match "-\\*-\\(\\*-\\)+" name)
- (setq name (replace-match "-*-" t t name)))
- name)
+ "Decompose PATTERN into XLFD fields and return a vector of the fields.
+The length of the vector is 12.
+The FOUNDRY and FAMILY fields are concatinated and stored in the first
+element of the vector.
+The REGISTRY and ENCODING fields are concatinated and stored in the last
+element of the vector.
+
+Return nil if PATTERN doesn't conform to XLFD."
+ (if (string-match xlfd-tight-regexp pattern)
+ (let ((xlfd-fields (make-vector 12 nil)))
+ (dotimes (i 12)
+ (aset xlfd-fields i (match-string (1+ i) pattern)))
+ (dotimes (i 12)
+ (if (string-match "^[*-]+$" (aref xlfd-fields i))
+ (aset xlfd-fields i nil)))
+ xlfd-fields)))
(defun x-compose-font-name (fields &optional reduce)
- "Compose X's fontname from FIELDS.
-FIELDS is a vector of XLFD fields, of length 14.
+ "Compose X fontname from FIELDS.
+FIELDS is a vector of XLFD fields, of length 12.
If a field is nil, wild-card letter `*' is embedded.
Optional argument REDUCE exists just for backward compatibility,
and is always ignored."
parts of the font name pattern with \"*\" until some font is found.
Value is name of that font."
(let ((ascii-font nil) (index 0))
- (while (and (null ascii-font) (<= index xlfd-regexp-encoding-subnum))
+ (while (and (null ascii-font) (<= index xlfd-regexp-registry-subnum))
(let ((pattern (x-compose-font-name xlfd-fields)))
(condition-case nil
(setq ascii-font (x-resolve-font-name pattern))
ascii-font))
-(defun x-complement-fontset-spec (xlfd-fields fontlist)
- "Complement FONTLIST for charsets based on XLFD-FIELDS and return it.
-XLFD-FIELDS is a vector of XLFD (X Logical Font Description) fields.
-FONTLIST is an alist of charsets vs the corresponding font names.
-
-The fonts are complemented as below.
-
-If FONTLIST doesn't specify a font for ASCII charset, generate a font
-name for the charset from XLFD-FIELDS, and add that information to
-FONTLIST.
-
-If a font specifid for ASCII supports the other charsets (see the
-variable `x-font-name-charset-alist'), add that information to FONTLIST."
- (let* ((slot (assq 'ascii fontlist))
- (ascii-font (cdr slot))
- ascii-font-spec)
- (if ascii-font
- (setcdr slot (setq ascii-font (x-resolve-font-name ascii-font)))
- ;; If font for ASCII is not specified, add it.
- (aset xlfd-fields xlfd-regexp-registry-subnum "iso8859")
- (aset xlfd-fields xlfd-regexp-encoding-subnum "1")
- (setq ascii-font (x-must-resolve-font-name xlfd-fields))
- (setq fontlist (cons (cons 'ascii ascii-font) fontlist)))
-
- ;; If the font for ASCII also supports the other charsets, and
- ;; they are not specified in FONTLIST, add them.
- (setq xlfd-fields (x-decompose-font-name ascii-font))
- (if (not xlfd-fields)
- (setq ascii-font-spec ascii-font)
- (setq ascii-font-spec
- (cons (format "%s-%s"
- (aref xlfd-fields xlfd-regexp-foundry-subnum)
- (aref xlfd-fields xlfd-regexp-family-subnum))
- (format "%s-%s"
- (aref xlfd-fields xlfd-regexp-registry-subnum)
- (aref xlfd-fields xlfd-regexp-encoding-subnum)))))
- (let ((tail x-font-name-charset-alist)
- elt)
- (while tail
- (setq elt (car tail) tail (cdr tail))
- (if (string-match (car elt) ascii-font)
- (let ((charsets (cdr elt))
- charset)
- (while charsets
- (setq charset (car charsets) charsets (cdr charsets))
- (or (assq charset fontlist)
- (setq fontlist
- (cons (cons charset ascii-font-spec) fontlist))))))))
-
+(defun x-complement-fontset-spec (default-spec fontlist)
+ "Complement elements of FONTLIST based on DEFAULT-SPEC.
+DEFAULT-SPEC is a font-spec object providing default font properties.
+FONTLIST is an alist of script names vs the corresponding font names.
+
+The font names are parsed and unspecified font properties are
+given from DEFAULT-SPEC."
+ (let ((prop-list '(:foundry :family :weight :slant :width :adstyle :size)))
+ (dolist (elt fontlist)
+ (let ((spec (font-spec :name (cadr elt))))
+ (dolist (prop prop-list)
+ (let ((val (font-get spec prop)))
+ (or val
+ (font-put spec prop (font-get default-spec prop)))))
+ (setcar (cdr elt) spec)))
fontlist))
(defun fontset-name-p (fontset)
(string= (match-string (1+ xlfd-regexp-registry-subnum) fontset)
"fontset")))
-;; Return a list to be appended to `x-fixed-font-alist' when
-;; `mouse-set-font' is called.
(defun generate-fontset-menu ()
- (let ((fontsets (fontset-list))
- fontset-name
- l)
- (while fontsets
- (setq fontset-name (car fontsets) fontsets (cdr fontsets))
- (setq l (cons (list (fontset-plain-name fontset-name) fontset-name) l)))
+ "Return list to be appended to `x-fixed-font-alist'.
+Done when `mouse-set-font' is called."
+ (let (l)
+ (dolist (fontset (fontset-list))
+ (or (string-match "fontset-default$" fontset)
+ (push (list (fontset-plain-name fontset) fontset) l)))
(cons "Fontset"
- (sort l (function (lambda (x y) (string< (car x) (car y))))))))
+ (sort l #'(lambda (x y) (string< (car x) (car y)))))))
(defun fontset-plain-name (fontset)
"Return a plain and descriptive name of FONTSET."
(error "Invalid fontset: %s" fontset))
(let ((xlfd-fields (x-decompose-font-name fontset)))
(if xlfd-fields
- (let ((weight (aref xlfd-fields xlfd-regexp-weight-subnum))
+ (let ((family (aref xlfd-fields xlfd-regexp-family-subnum))
+ (weight (aref xlfd-fields xlfd-regexp-weight-subnum))
(slant (aref xlfd-fields xlfd-regexp-slant-subnum))
(swidth (aref xlfd-fields xlfd-regexp-swidth-subnum))
(size (aref xlfd-fields xlfd-regexp-pixelsize-subnum))
- (charset (aref xlfd-fields xlfd-regexp-registry-subnum))
- (nickname (aref xlfd-fields xlfd-regexp-encoding-subnum))
+ (nickname (aref xlfd-fields xlfd-regexp-registry-subnum))
name)
- (if (not (string= "fontset" charset))
- fontset
- (if (> (string-to-number size) 0)
- (setq name (format "%s: %s-dot" nickname size))
- (setq name nickname))
- (cond ((string-match "^medium$" weight)
- (setq name (concat name " " "medium")))
- ((string-match "^bold$\\|^demibold$" weight)
- (setq name (concat name " " weight))))
- (cond ((string-match "^i$" slant)
- (setq name (concat name " " "italic")))
- ((string-match "^o$" slant)
- (setq name (concat name " " "slant")))
- ((string-match "^ri$" slant)
- (setq name (concat name " " "reverse italic")))
- ((string-match "^ro$" slant)
- (setq name (concat name " " "reverse slant"))))
- name))
+ (if (not (string-match "^fontset-\\(.*\\)$" nickname))
+ (setq nickname family)
+ (setq nickname (match-string 1 nickname)))
+ (if (and size (> (string-to-number size) 0))
+ (setq name (format "%s: %s-dot" nickname size))
+ (setq name nickname))
+ (and weight
+ (cond ((string-match "^medium$" weight)
+ (setq name (concat name " " "medium")))
+ ((string-match "^bold$\\|^demibold$" weight)
+ (setq name (concat name " " weight)))))
+ (and slant
+ (cond ((string-match "^i$" slant)
+ (setq name (concat name " " "italic")))
+ ((string-match "^o$" slant)
+ (setq name (concat name " " "slant")))
+ ((string-match "^ri$" slant)
+ (setq name (concat name " " "reverse italic")))
+ ((string-match "^ro$" slant)
+ (setq name (concat name " " "reverse slant")))))
+ name)
fontset)))
+(defvar charset-script-alist
+ '((ascii . latin)
+ (latin-iso8859-1 . latin)
+ (latin-iso8859-2 . latin)
+ (latin-iso8859-3 . latin)
+ (latin-iso8859-4 . latin)
+ (latin-iso8859-9 . latin)
+ (latin-iso8859-10 . latin)
+ (latin-iso8859-13 . latin)
+ (latin-iso8859-14 . latin)
+ (latin-iso8859-15 . latin)
+ (latin-iso8859-16 . latin)
+ (latin-jisx0201 . latin)
+ (thai-tis620 . thai)
+ (cyrillic-iso8859-5 . cyrillic)
+ (arabic-iso8859-6 . arabic)
+ (greek-iso8859-7 . latin)
+ (hebrew-iso8859-8 . latin)
+ (katakana-jisx0201 . kana)
+ (chinese-gb2312 . han)
+ (chinese-gbk . han)
+ (gb18030-2-byte . han)
+ (gb18030-4-byte-bmp . han)
+ (gb18030-4-byte-ext-1 . han)
+ (gb18030-4-byte-ext-2 . han)
+ (gb18030-4-byte-smp . han)
+ (chinese-big5-1 . han)
+ (chinese-big5-2 . han)
+ (chinese-cns11643-1 . han)
+ (chinese-cns11643-2 . han)
+ (chinese-cns11643-3 . han)
+ (chinese-cns11643-4 . han)
+ (chinese-cns11643-5 . han)
+ (chinese-cns11643-6 . han)
+ (chinese-cns11643-7 . han)
+ (japanese-jisx0208 . han)
+ (japanese-jisx0208-1978 . han)
+ (japanese-jisx0212 . han)
+ (japanese-jisx0213-1 . han)
+ (japanese-jisx0213-2 . han)
+ (korean-ksc5601 . hangul)
+ (chinese-sisheng . bopomofo)
+ (vietnamese-viscii-lower . latin)
+ (vietnamese-viscii-upper . latin)
+ (arabic-digit . arabic)
+ (arabic-1-column . arabic)
+ (arabic-2-column . arabic)
+ (indian-is13194 . devanagari)
+ (indian-glyph . devanagari)
+ (indian-1-column . devanagari)
+ (indian-2-column . devanagari)
+ (tibetan-1-column . tibetan))
+ "Alist of charsets vs the corresponding most appropriate scripts.
+
+This alist is used by the function `create-fontset-from-fontset-spec'
+to map charsets to scripts.")
(defun create-fontset-from-fontset-spec (fontset-spec
&optional style-variant noerror)
"Create a fontset from fontset specification string FONTSET-SPEC.
FONTSET-SPEC is a string of the format:
- FONTSET-NAME,CHARSET0:FONT0,CHARSET1:FONT1, ...
+ FONTSET-NAME,SCRIPT0:FONT0,SCRIPT1:FONT1, ...
Any number of SPACE, TAB, and NEWLINE can be put before and after commas.
-Optional 2nd arg exists just for backward compatibility, and is ignored.
+When a frame uses the fontset as the `font' parameter, the frame's
+default font name is derived from FONTSET-NAME by substituting
+\"iso8859-1\" for the tail part \"fontset-XXX\". But, if SCRIPT-NAMEn
+is \"ascii\", use the corresponding FONT-NAMEn as the default font
+name.
-If this function attempts to create already existing fontset, an error is
-signaled unless the optional 3rd argument NOERROR is non-nil.
+Optional 2nd and 3rd arguments exist just for backward compatibility,
+and are ignored.
-It returns a name of the created fontset."
- (if (not (string-match "^[^,]+" fontset-spec))
+It returns a name of the created fontset.
+
+For backward compatibility, SCRIPT-NAME may be a charset name, in
+which case, the corresponding script is decided by the variable
+`charset-script-alist' (which see)."
+ (or (string-match "^[^,]+" fontset-spec)
(error "Invalid fontset spec: %s" fontset-spec))
- (setq fontset-spec (downcase fontset-spec))
(let ((idx (match-end 0))
(name (match-string 0 fontset-spec))
- xlfd-fields charset fontlist ascii-font)
- (if (query-fontset name)
- (or noerror
- (error "Fontset \"%s\" already exists" name))
- (setq xlfd-fields (x-decompose-font-name name))
- (or xlfd-fields
- (error "Fontset \"%s\" not conforming to XLFD" name))
-
- ;; At first, extract pairs of charset and fontname from FONTSET-SPEC.
- (while (string-match "[, \t\n]*\\([^:]+\\):[ \t]*\\([^,]+\\)"
- fontset-spec idx)
- (setq idx (match-end 0))
- (setq charset (intern (match-string 1 fontset-spec)))
- (if (charsetp charset)
- (setq fontlist (cons (cons charset (match-string 2 fontset-spec))
- fontlist))))
- (setq ascii-font (cdr (assq 'ascii fontlist)))
-
- ;; Complement FONTLIST.
- (setq fontlist (x-complement-fontset-spec xlfd-fields fontlist))
-
- (new-fontset name fontlist)
-
- ;; Define the short name alias.
- (if (and (string-match "fontset-.*$" name)
- (not (assoc name fontset-alias-alist)))
- (let ((alias (match-string 0 name)))
- (or (rassoc alias fontset-alias-alist)
- (setq fontset-alias-alist
- (cons (cons name alias) fontset-alias-alist)))))
-
- ;; Define the ASCII font name alias.
- (or ascii-font
- (setq ascii-font (cdr (assq 'ascii fontlist))))
- (or (rassoc ascii-font fontset-alias-alist)
- (setq fontset-alias-alist
- (cons (cons name ascii-font)
- fontset-alias-alist))))
-
- name))
+ default-spec target script fontlist)
+ (or (string-match xlfd-tight-regexp name)
+ (error "Fontset name \"%s\" not conforming to XLFD" name))
+ (setq default-spec (font-spec :name name))
+ ;; At first, extract pairs of charset and fontname from FONTSET-SPEC.
+ (while (string-match "[, \t\n]*\\([^:]+\\):[ \t]*\\([^,]+\\)"
+ fontset-spec idx)
+ (setq idx (match-end 0))
+ (setq target (intern (match-string 1 fontset-spec)))
+ (cond ((or (eq target 'ascii)
+ (memq target (char-table-extra-slot char-script-table 0)))
+ (push (list target (match-string 2 fontset-spec)) fontlist))
+ ((setq script (cdr (assq target charset-script-alist)))
+ (push (list script (match-string 2 fontset-spec)) fontlist))
+ ((charsetp target)
+ (push (list target (match-string 2 fontset-spec)) fontlist))))
+
+ ;; Complement FONTLIST.
+ (setq fontlist (x-complement-fontset-spec default-spec fontlist))
+
+ ;; Create a fontset.
+ (new-fontset name (nreverse fontlist))))
(defun create-fontset-from-ascii-font (font &optional resolved-font
fontset-name)
It returns a name of the created fontset."
(setq font (downcase font))
- (if resolved-font
- (setq resolved-font (downcase resolved-font))
- (setq resolved-font (downcase (x-resolve-font-name font))))
- (let ((xlfd (x-decompose-font-name font))
- (resolved-xlfd (x-decompose-font-name resolved-font))
- fontset fontset-spec)
- (aset xlfd xlfd-regexp-foundry-subnum nil)
- (aset xlfd xlfd-regexp-family-subnum nil)
- (aset xlfd xlfd-regexp-registry-subnum "fontset")
+ (setq resolved-font
+ (downcase (or resolved-font (x-resolve-font-name font))))
+ (let ((xlfd (x-decompose-font-name resolved-font))
+ fontset)
(if fontset-name
(setq fontset-name (downcase fontset-name))
- (setq fontset-name
- (format "%s_%s_%s"
- (aref resolved-xlfd xlfd-regexp-registry-subnum)
- (aref resolved-xlfd xlfd-regexp-encoding-subnum)
- (aref resolved-xlfd xlfd-regexp-pixelsize-subnum))))
- (aset xlfd xlfd-regexp-encoding-subnum fontset-name)
+ (if (query-fontset "fontset-startup")
+ (setq fontset-name
+ (subst-char-in-string
+ ?- ?_ (aref xlfd xlfd-regexp-registry-subnum) t))
+ (setq fontset-name "startup")))
+ (aset xlfd xlfd-regexp-registry-subnum
+ (format "fontset-%s" fontset-name))
(setq fontset (x-compose-font-name xlfd))
(or (query-fontset fontset)
(create-fontset-from-fontset-spec (concat fontset ", ascii:" font)))))
;; specified here because FAMILY of those fonts are not "fixed" in
;; many cases.
(defvar standard-fontset-spec
- (purecopy "-*-fixed-medium-r-normal-*-16-*-*-*-*-*-fontset-standard,
- chinese-gb2312:-*-medium-r-normal-*-16-*-gb2312*-*,
- korean-ksc5601:-*-medium-r-normal-*-16-*-ksc5601*-*,
- chinese-cns11643-1:-*-medium-r-normal-*-16-*-cns11643*-1,
- chinese-cns11643-2:-*-medium-r-normal-*-16-*-cns11643*-2,
- chinese-cns11643-3:-*-medium-r-normal-*-16-*-cns11643*-3,
- chinese-cns11643-4:-*-medium-r-normal-*-16-*-cns11643*-4,
- chinese-cns11643-5:-*-medium-r-normal-*-16-*-cns11643*-5,
- chinese-cns11643-6:-*-medium-r-normal-*-16-*-cns11643*-6,
- chinese-cns11643-7:-*-medium-r-normal-*-16-*-cns11643*-7")
+ (purecopy "-*-fixed-medium-r-normal-*-16-*-*-*-*-*-fontset-standard")
"String of fontset spec of the standard fontset.
You have the biggest chance to display international characters
with correct glyphs by using the standard fontset.
See the documentation of `create-fontset-from-fontset-spec' for the format.")
+
;; Create fontsets from X resources of the name `fontset-N (class
;; Fontset-N)' where N is integer 0, 1, ...
;; The values of the resources the string of the same format as
;;; ja-dic-cnv.el --- convert a Japanese dictionary (SKK-JISYO.L) to Emacs Lisp
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- ;; 2005, 2006, 2007
+ ;; 2005, 2006, 2007, 2008
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
(defvar ja-dic-filename "ja-dic.el")
;; To make a generated ja-dic.el smaller.
-(make-coding-system
- 'iso-2022-7bit-short
- 2 ?J
+(define-coding-system 'iso-2022-7bit-short
"Like `iso-2022-7bit' but no ASCII designation before SPC."
- '(ascii nil nil nil t t nil t)
- '((safe-charsets . t)))
+ :coding-type 'iso-2022
+ :mnemonic ?J
+ :charset-list 'iso-2022
+ :designation [(ascii t) nil nil nil]
+ :flags '(short 7-bit designation))
(defun skkdic-convert-okuri-ari (skkbuf buf)
(message "Processing OKURI-ARI entries ...")
(- ch) ; represented by a negative code.
(if (= ch ?\e$B!<\e(B) ; `\e$B!<\e(B' is represented by 0.
0
- (- (nth 2 (split-char ch)) 32))))
+ (- (logand (encode-char ch 'japanese-jisx0208) #xFF) 32))))
(setq i (1+ i)))
vec))
;;; ja-dic-utl.el --- utilities for handling Japanese dictionary (SKK-JISYO.L)
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- ;; 2005, 2006, 2007
+ ;; 2005, 2006, 2007, 2008
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
(setq heads (cdr heads)))
l))
-(defconst skkdic-jisx0208-hiragana-block (nth 1 (split-char ?\e$B$"\e(B)))
+(defconst skkdic-jisx0208-hiragana-block
+ (cons (decode-char 'japanese-jisx0208 #x2421)
+ (decode-char 'japanese-jisx0208 #x247E)))
(defun skkdic-lookup-key (seq len &optional postfix prefer-noun)
"Return a list of conversion string for sequence SEQ of length LEN.
;; else VEC[N] is 128.
(while (< i len)
(let ((ch (aref seq i))
- elts)
- (if (= ch ?\e$B!<\e(B)
- (aset vec i 0)
- (setq elts (split-char ch))
- (if (and (eq (car elts) 'japanese-jisx0208)
- (= (nth 1 elts) skkdic-jisx0208-hiragana-block))
- (aset vec i (- (nth 2 elts) 32))
- (aset vec i 128))))
+ code)
+ (cond ((= ch ?\e$B!<\e(B)
+ (aset vec i 0))
+ ((and (>= ch (car skkdic-jisx0208-hiragana-block))
+ (<= ch (cdr skkdic-jisx0208-hiragana-block)))
+ (setq code (encode-char ch 'japanese-jisx0208))
+ (if code
+ (aset vec i (- (logand code #xFF) 32))
+ (aset vec i 128)))
+ (t
+ (aset vec i 128))))
(setq i (1+ i)))
;; Search OKURI-NASI entries.
;;; mule-cmds.el --- commands for multilingual environment -*-coding: iso-2022-7bit -*-
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
- ;; 2006, 2007 Free Software Foundation, Inc.
+ ;; 2006, 2007, 2008 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- ;; 2005, 2006, 2007
+ ;; 2005, 2006, 2007, 2008
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
+;; Copyright (C) 2003
+;; National Institute of Advanced Industrial Science and Technology (AIST)
+;; Registration Number H13PRO009
-;; Keywords: mule, multilingual
+;; Keywords: mule, i18n
;; This file is part of GNU Emacs.
(interactive
(let ((default (and buffer-file-coding-system
(not (eq (coding-system-type buffer-file-coding-system)
- t))
+ 'undecided))
buffer-file-coding-system)))
(list (read-coding-system
(if default
(setq default-file-name-coding-system 'utf-8)
(if (and default-enable-multibyte-characters
(or (not coding-system)
- (not (coding-system-get coding-system 'ascii-incompatible))))
+ (coding-system-get coding-system 'ascii-compatible-p)))
(setq default-file-name-coding-system coding-system)))
;; If coding-system is nil, honor that on MS-DOS as well, so
;; that they could reset the terminal coding system.
(unless (and (eq window-system 'pc) coding-system)
(setq default-terminal-coding-system coding-system))
- (if (or (not coding-system)
- (not (coding-system-get coding-system 'ascii-incompatible)))
- (setq default-keyboard-coding-system coding-system))
+ (setq default-keyboard-coding-system coding-system)
;; Preserve eol-type from existing default-process-coding-systems.
;; On non-unix-like systems in particular, these may have been set
;; carefully by the user, or by the startup code, to deal with the
startup.
A coding system that requires automatic detection of text
-encoding (e.g. undecided, unix) can't be preferred.
-
-See also `coding-category-list' and `coding-system-category'."
++encoding (e.g. undecided, unix) can't be preferred.."
(interactive "zPrefer coding system: ")
(if (not (and coding-system (coding-system-p coding-system)))
(error "Invalid coding system `%s'" coding-system))
- (let ((coding-category (coding-system-category coding-system))
- (base (coding-system-base coding-system))
+ (if (memq (coding-system-type coding-system) '(raw-text undecided))
+ (error "Can't prefer the coding system `%s'" coding-system))
+ (let ((base (coding-system-base coding-system))
(eol-type (coding-system-eol-type coding-system)))
- (if (not coding-category)
- ;; CODING-SYSTEM is no-conversion or undecided.
- (error "Can't prefer the coding system `%s'" coding-system))
- (set coding-category (or base coding-system))
- ;; Changing the binding of a coding category requires this call.
- (update-coding-systems-internal)
- (or (eq coding-category (car coding-category-list))
- ;; We must change the order.
- (set-coding-priority (list coding-category)))
- (if (and base (interactive-p))
- (message "Highest priority is set to %s (base of %s)"
- base coding-system))
+ (set-coding-system-priority base)
+ (and (interactive-p)
+ (or (eq base coding-system)
+ (message "Highest priority is set to %s (base of %s)"
+ base coding-system)))
;; If they asked for specific EOL conversion, honor that.
(if (memq eol-type '(0 1 2))
- (setq coding-system
- (coding-system-change-eol-conversion base eol-type))
- (setq coding-system base))
- (set-default-coding-systems coding-system)))
+ (setq base
+ (coding-system-change-eol-conversion base eol-type)))
+ (set-default-coding-systems base)))
(defvar sort-coding-systems-predicate nil
"If non-nil, a predicate function to sort coding systems.
non-nil, it is used to sort CODINGS instead."
(if sort-coding-systems-predicate
(sort codings sort-coding-systems-predicate)
- (let* ((from-categories (mapcar #'(lambda (x) (symbol-value x))
- coding-category-list))
- (most-preferred (car from-categories))
+ (let* ((from-priority (coding-system-priority-list))
+ (most-preferred (car from-priority))
(lang-preferred (get-language-info current-language-environment
'coding-system))
(func (function
(logior
(lsh (if (eq base most-preferred) 1 0) 7)
(lsh
- (let ((mime (coding-system-get base 'mime-charset)))
+ (let ((mime (coding-system-get base :mime-charset)))
;; Prefer coding systems corresponding to a
;; MIME charset.
(if mime
0))
5)
(lsh (if (memq base lang-preferred) 1 0) 4)
- (lsh (if (memq base from-categories) 1 0) 3)
+ (lsh (if (memq base from-priority) 1 0) 3)
(lsh (if (string-match "-with-esc\\'"
(symbol-name base))
0 1) 2)
- (if (eq (coding-system-type base) 2)
- ;; For ISO based coding systems, prefer
- ;; one that doesn't use escape sequences.
- (let ((flags (coding-system-flags base)))
- (if (or (consp (aref flags 0))
- (consp (aref flags 1))
- (consp (aref flags 2))
- (consp (aref flags 3)))
- (if (or (aref flags 8) (aref flags 9))
- 0
- 1)
- 2))
- 1)))))))
+ (if (eq (coding-system-type base) 'iso-2022)
+ (let ((category (coding-system-category base)))
+ ;; For ISO based coding systems, prefer
+ ;; one that doesn't use designation nor
+ ;; locking/single shifting.
+ (cond
+ ((or (eq category 'coding-category-iso-8-1)
+ (eq category 'coding-category-iso-8-2))
+ 2)
+ ((or (eq category 'coding-category-iso-7-tight)
+ (eq category 'coding-category-iso-7))
+ 1)
+ (t
+ 0)))
+ 1)
+ ))))))
(sort codings (function (lambda (x y)
(> (funcall func x) (funcall func y))))))))
(defun find-coding-systems-region (from to)
"Return a list of proper coding systems to encode a text between FROM and TO.
+
If FROM is a string, find coding systems in that instead of the buffer.
All coding systems in the list can safely encode any multibyte characters
in the text.
(defun find-coding-systems-for-charsets (charsets)
"Return a list of proper coding systems to encode characters of CHARSETS.
CHARSETS is a list of character sets.
-It actually checks at most the first 96 characters of each charset.
-So, if a charset of dimension two is included in CHARSETS, the value may
-contain a coding system that can't encode all characters of the charset."
+
+This only finds coding systems of type `charset', whose
+`:charset-list' property includes all of CHARSETS (plus `ascii' for
+ascii-compatible coding systems). It was used in older versions of
+Emacs, but is unlikely to be what you really want now."
+ ;; Deal with aliases.
+ (setq charsets (mapcar (lambda (c)
+ (get-charset-property c :name))
+ charsets))
(cond ((or (null charsets)
(and (= (length charsets) 1)
(eq 'ascii (car charsets))))
'(undecided))
((or (memq 'eight-bit-control charsets)
(memq 'eight-bit-graphic charsets))
- '(raw-text emacs-mule))
+ '(raw-text utf-8-emacs))
(t
- (let ((codings t)
- charset l str)
- (while (and codings charsets)
- (setq charset (car charsets) charsets (cdr charsets))
- (unless (eq charset 'ascii)
- (setq str (make-string 96 32))
- (if (= (charset-dimension charset) 1)
- (if (= (charset-chars charset) 96)
- (dotimes (i 96)
- (aset str i (make-char charset (+ i 32))))
- (dotimes (i 94)
- (aset str i (make-char charset (+ i 33)))))
- (if (= (charset-chars charset) 96)
- (dotimes (i 96)
- (aset str i (make-char charset 32 (+ i 32))))
- (dotimes (i 94)
- (aset str i (make-char charset 33 (+ i 33))))))
- (setq l (find-coding-systems-string str))
- (if (eq codings t)
- (setq codings l)
- (let ((ll nil))
- (dolist (elt codings)
- (if (memq elt l)
- (setq ll (cons elt ll))))
- (setq codings ll)))))
- codings))))
+ (let (codings)
+ (dolist (cs (coding-system-list t))
+ (let ((cs-charsets (and (eq (coding-system-type cs) 'charset)
+ (coding-system-charset-list cs)))
+ (charsets charsets))
+ (if (coding-system-get cs :ascii-compatible-p)
+ (add-to-list 'cs-charsets 'ascii))
+ (if (catch 'ok
+ (when cs-charsets
+ (while charsets
+ (unless (memq (pop charsets) cs-charsets)
+ (throw 'ok nil)))
+ t))
+ (push cs codings))))
+ (nreverse codings)))))
(defun find-multibyte-characters (from to &optional maxcount excludes)
"Find multibyte characters in the region specified by FROM and TO.
COUNT is a number of characters,
CHARs are the characters found from the character set.
Optional 3rd arg MAXCOUNT limits how many CHARs are put in the above list.
-Optional 4th arg EXCLUDES is a list of character sets to be ignored.
-
-For invalid characters, CHARs are actually strings."
+Optional 4th arg EXCLUDES is a list of character sets to be ignored."
(let ((chars nil)
charset char)
(if (stringp from)
- (let ((idx 0))
- (while (setq idx (string-match "[^\000-\177]" from idx))
- (setq char (aref from idx)
- charset (char-charset char))
- (if (eq charset 'unknown)
- (setq char (match-string 0)))
- (if (or (memq charset '(unknown
- eight-bit-control eight-bit-graphic))
- (not (or (eq excludes t) (memq charset excludes))))
+ (if (multibyte-string-p from)
+ (let ((idx 0))
+ (while (setq idx (string-match "[^\000-\177]" from idx))
+ (setq char (aref from idx)
+ charset (char-charset char))
+ (unless (memq charset excludes)
+ (let ((slot (assq charset chars)))
+ (if slot
+ (if (not (memq char (nthcdr 2 slot)))
+ (let ((count (nth 1 slot)))
+ (setcar (cdr slot) (1+ count))
+ (if (or (not maxcount) (< count maxcount))
+ (nconc slot (list char)))))
+ (setq chars (cons (list charset 1 char) chars)))))
+ (setq idx (1+ idx)))))
+ (if enable-multibyte-characters
+ (save-excursion
+ (goto-char from)
+ (while (re-search-forward "[^\000-\177]" to t)
+ (setq char (preceding-char)
+ charset (char-charset char))
+ (unless (memq charset excludes)
(let ((slot (assq charset chars)))
(if slot
- (if (not (memq char (nthcdr 2 slot)))
+ (if (not (member char (nthcdr 2 slot)))
(let ((count (nth 1 slot)))
(setcar (cdr slot) (1+ count))
(if (or (not maxcount) (< count maxcount))
(nconc slot (list char)))))
- (setq chars (cons (list charset 1 char) chars)))))
- (setq idx (1+ idx))))
- (save-excursion
- (goto-char from)
- (while (re-search-forward "[^\000-\177]" to t)
- (setq char (preceding-char)
- charset (char-charset char))
- (if (eq charset 'unknown)
- (setq char (match-string 0)))
- (if (or (memq charset '(unknown eight-bit-control eight-bit-graphic))
- (not (or (eq excludes t) (memq charset excludes))))
- (let ((slot (assq charset chars)))
- (if slot
- (if (not (member char (nthcdr 2 slot)))
- (let ((count (nth 1 slot)))
- (setcar (cdr slot) (1+ count))
- (if (or (not maxcount) (< count maxcount))
- (nconc slot (list char)))))
- (setq chars (cons (list charset 1 char) chars))))))))
+ (setq chars (cons (list charset 1 char) chars)))))))))
(nreverse chars)))
-
(defun search-unencodable-char (coding-system)
"Search forward from point for a character that is not encodable.
It asks which coding system to check.
(message "All following characters are encodable by %s" coding-system))
pos))
-
(defvar last-coding-system-specified nil
"Most recent coding system explicitly specified by the user when asked.
This variable is set whenever Emacs asks the user which coding system
(let ((l codings)
mime-charset)
(while l
- (setq mime-charset (coding-system-get (car l) 'mime-charset))
- (if (and mime-charset (coding-system-p mime-charset))
+ (setq mime-charset (coding-system-get (car l) :mime-charset))
+ (if (and mime-charset (coding-system-p mime-charset)
+ (coding-system-equal (car l) mime-charset))
(setcar l mime-charset))
(setq l (cdr l))))
(let ((pos (point))
(fill-prefix " "))
(dolist (x (append rejected unsafe))
- (princ " ") (princ (car x)))
+ (princ " ") (princ x))
(insert "\n")
(fill-region-as-paragraph pos (point)))
(when rejected
;; If the most preferred coding system has the property mime-charset,
;; append it to the defaults.
- (let ((tail coding-category-list)
- preferred base)
- (while (and tail (not (setq preferred (symbol-value (car tail)))))
- (setq tail (cdr tail)))
+ (let ((preferred (coding-system-priority-list t))
+ base)
(and (coding-system-p preferred)
(setq base (coding-system-base preferred))
- (coding-system-get preferred 'mime-charset)
+ (coding-system-get preferred :mime-charset)
(not (rassq base default-coding-system))
(setq default-coding-system
(append default-coding-system
;; Classify the defaults into safe, rejected, and unsafe.
(dolist (elt default-coding-system)
- (if (memq (cdr elt) codings)
+ (if (or (eq (car codings) 'undecided)
+ (memq (cdr elt) codings))
(if (and (functionp accept-default-p)
(not (funcall accept-default-p (cdr elt))))
(push (car elt) rejected)
;; We should never use no-conversion for outgoing mail.
(setq coding nil))
(if (fboundp select-safe-coding-system-function)
- (setq coding
- (funcall select-safe-coding-system-function
- (point-min) (point-max) coding
- (function (lambda (x)
- (coding-system-get x 'mime-charset))))))
- (if coding
- ;; Be sure to use LF for end-of-line.
- (setq coding (coding-system-change-eol-conversion coding 'unix))
- ;; No coding system is decided. Usually this is the case that
- ;; the current buffer contains only ASCII. So, we hope
- ;; iso-8859-1 works.
- (setq coding 'iso-8859-1-unix))
- coding))
+ (funcall select-safe-coding-system-function
+ (point-min) (point-max) coding
+ (function (lambda (x) (coding-system-get x :mime-charset))))
+ coding)))
\f
;;; Language support stuff.
documentation value is documentation of what this language environment
is meant for, and how to use it.
- charset value is a list of the character sets used by this
- language environment.
+ charset value is a list of the character sets mainly used
+ by this language environment.
sample-text value is an expression which is evalled to generate
a line of text written using characters appropriate
for this language environment.
This is used to set up the coding system priority
list when you switch to this language environment.
nonascii-translation
- value is a translation table to be set in the
- variable `nonascii-translation-table' in this
- language environment, or a character set from
- which `nonascii-insert-offset' is calculated.
+ value is a charset of dimension one to use for
+ converting a unibyte character to multibyte
+ and vice versa.
input-method value is a default input method for this language
environment.
features value is a list of features requested in this
globally disabled, i.e. the value of `default-enable-multibyte-characters'
is nil.
- unibyte-syntax value is a library name to load to set
- unibyte 8-bit character syntaxes for this
- language environment.
-
unibyte-display value is a coding system to encode characters
for the terminal. Characters in the range
of 160 to 255 display not as octal escapes,
(set-language-info-internal lang-env key info)
(if (equal lang-env current-language-environment)
(cond ((eq key 'coding-priority)
- (set-language-environment-coding-systems lang-env))
+ (set-language-environment-coding-systems lang-env)
+ (set-language-environment-charset lang-env))
((eq key 'input-method)
(set-language-environment-input-method lang-env))
((eq key 'nonascii-translation)
(set-language-environment-nonascii-translation lang-env))
((eq key 'charset)
(set-language-environment-charset lang-env))
- ((eq key 'overriding-fontspec)
- (set-language-environment-fontset lang-env))
((and (not default-enable-multibyte-characters)
(or (eq key 'unibyte-syntax) (eq key 'unibyte-display)))
(set-language-environment-unibyte lang-env)))))
(put 'current-input-method-title 'permanent-local t)
(defcustom default-input-method nil
- "*Default input method for multilingual text (a string).
+ "Default input method for multilingual text (a string).
This is the input method activated automatically by the command
`toggle-input-method' (\\[toggle-input-method])."
:link '(custom-manual "(emacs)Input Methods")
(delete current-input-method input-method-history))))
(setq input-method-history (list current-input-method)))
(unwind-protect
- (funcall inactivate-current-input-method-function)
+ (progn
+ (setq input-method-function nil
+ current-input-method-title nil)
+ (funcall inactivate-current-input-method-function))
(unwind-protect
(run-hooks 'input-method-inactivate-hook)
- (setq current-input-method nil
- input-method-function nil
- current-input-method-title nil)
+ (setq current-input-method nil)
(force-mode-line-update)))))
(defun set-input-method (input-method &optional interactive)
(when interactive
(customize-mark-as-set 'default-input-method)))))))
+(eval-when-compile (autoload 'help-buffer "help-mode"))
+
(defun describe-input-method (input-method)
"Describe input method INPUT-METHOD."
(interactive
;; should react to these variables.
(defcustom input-method-verbose-flag 'default
- "*A flag to control extra guidance given by input methods.
+ "A flag to control extra guidance given by input methods.
The value should be nil, t, `complex-only', or `default'.
The extra guidance is done by showing list of available keys in echo
:group 'mule)
(defcustom input-method-highlight-flag t
- "*If this flag is non-nil, input methods highlight partially-entered text.
+ "If this flag is non-nil, input methods highlight partially-entered text.
For instance, while you are in the middle of a Quail input method sequence,
the text inserted so far is temporarily underlined.
The underlining goes away when you finish or abort the input method sequence.
:type 'boolean
:group 'mule)
-(defvar input-method-activate-hook nil
+(defcustom input-method-activate-hook nil
"Normal hook run just after an input method is activated.
The variable `current-input-method' keeps the input method name
-just activated.")
+just activated."
+ :type 'hook
+ :group 'mule)
-(defvar input-method-inactivate-hook nil
+(defcustom input-method-inactivate-hook nil
"Normal hook run just after an input method is inactivated.
The variable `current-input-method' still keeps the input method name
-just inactivated.")
+just inactivated."
+ :type 'hook
+ :group 'mule)
-(defvar input-method-after-insert-chunk-hook nil
- "Normal hook run just after an input method insert some chunk of text.")
+(defcustom input-method-after-insert-chunk-hook nil
+ "Normal hook run just after an input method insert some chunk of text."
+ :type 'hook
+ :group 'mule)
(defvar input-method-exit-on-first-char nil
"This flag controls when an input method returns.
But, if this flag is non-nil, the input method returns as soon as
the current key sequence gets long enough to have some valid translation.")
-(defvar input-method-use-echo-area nil
+(defcustom input-method-use-echo-area nil
"This flag controls how an input method shows an intermediate key sequence.
Usually, the input method inserts the intermediate key sequence,
or candidate translations corresponding to the sequence,
at point in the current buffer.
-But, if this flag is non-nil, it displays them in echo area instead.")
+But, if this flag is non-nil, it displays them in echo area instead."
+ :type 'hook
+ :group 'mule)
(defvar input-method-exit-on-invalid-key nil
"This flag controls the behavior of an input method on invalid key input.
But, if this flag is non-nil, the input method is never back on.")
\f
-(defvar set-language-environment-hook nil
+(defcustom set-language-environment-hook nil
"Normal hook run after some language environment is set.
When you set some hook function here, that effect usually should not
be inherited to another language environment. So, you had better set
another function in `exit-language-environment-hook' (which see) to
-cancel the effect.")
+cancel the effect."
+ :type 'hook
+ :group 'mule)
-(defvar exit-language-environment-hook nil
+(defcustom exit-language-environment-hook nil
"Normal hook run after exiting from some language environment.
When this hook is run, the variable `current-language-environment'
is still bound to the language environment being exited.
This hook is mainly used for canceling the effect of
-`set-language-environment-hook' (which see).")
+`set-language-environment-hook' (which see)."
+ :type 'hook
+ :group 'mule)
(put 'setup-specified-language-environment 'apropos-inhibit t)
The default value for the command `set-terminal-coding-system' is nil.
The default value for the command `set-keyboard-coding-system' 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-8-1 iso-latin-1
- coding-category-iso-8-2 iso-latin-1
- coding-category-utf-8 mule-utf-8
- coding-category-utf-16-be mule-utf-16be-with-signature
- coding-category-utf-16-le mule-utf-16le-with-signature
- coding-category-iso-7-tight iso-2022-jp
- coding-category-iso-7 iso-2022-7bit
- coding-category-iso-7-else iso-2022-7bit-lock
- coding-category-iso-8-else iso-2022-8bit-ss2
- coding-category-emacs-mule emacs-mule
- coding-category-raw-text raw-text
- coding-category-sjis japanese-shift-jis
- coding-category-big5 chinese-big5
- coding-category-ccl nil
- coding-category-binary no-conversion"
+ The order of priorities of coding systems are as follows:
+ utf-8
+ iso-2022-7bit
+ iso-latin-1
+ iso-2022-7bit-lock
+ iso-2022-8bit-ss2
+ emacs-mule
+ raw-text"
(interactive)
;; This function formerly set default-enable-multibyte-characters to t,
;; but that is incorrect. It should not alter the unibyte/multibyte choice.
- (setq coding-category-iso-7-tight 'iso-2022-jp
- coding-category-iso-7 'iso-2022-7bit
- coding-category-iso-8-1 'iso-latin-1
- coding-category-iso-8-2 'iso-latin-1
- coding-category-iso-7-else 'iso-2022-7bit-lock
- coding-category-iso-8-else 'iso-2022-8bit-ss2
- coding-category-emacs-mule 'emacs-mule
- coding-category-raw-text 'raw-text
- coding-category-sjis 'japanese-shift-jis
- coding-category-big5 'chinese-big5
- coding-category-utf-16-be 'mule-utf-16be-with-signature
- coding-category-utf-16-le 'mule-utf-16le-with-signature
- coding-category-utf-8 'mule-utf-8
- coding-category-ccl nil
- coding-category-binary 'no-conversion)
-
- (set-coding-priority
- '(coding-category-iso-8-1
- coding-category-iso-8-2
- coding-category-utf-8
- coding-category-utf-16-be
- coding-category-utf-16-le
- coding-category-iso-7-tight
- coding-category-iso-7
- 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-ccl
- coding-category-binary))
-
- ;; Changing the binding of a coding category requires this call.
- (update-coding-systems-internal)
+ (set-coding-system-priority
+ 'utf-8
+ 'iso-2022-7bit
+ 'iso-latin-1
+ 'iso-2022-7bit-lock
+ 'iso-2022-8bit-ss2
+ 'emacs-mule
+ 'raw-text)
(set-default-coding-systems nil)
(setq default-sendmail-coding-system 'iso-latin-1)
;; (set-terminal-coding-system-internal nil)
;; (set-keyboard-coding-system-internal nil)
- (setq nonascii-translation-table nil
- nonascii-insert-offset 0)
-
- ;; Don't invoke fontset-related functions if fontsets aren't
- ;; supported in this build of Emacs.
- (and (fboundp 'fontset-list)
- (set-overriding-fontspec-internal nil)))
+ (set-unibyte-charset 'iso-8859-1))
(reset-language-environment)
(set-language-environment-input-method language-name)
(set-language-environment-nonascii-translation language-name)
(set-language-environment-charset language-name)
- (set-language-environment-fontset language-name)
;; Unibyte setups if necessary.
(unless default-enable-multibyte-characters
(set-language-environment-unibyte language-name))
(run-hooks 'set-language-environment-hook)
(force-mode-line-update t))
+(define-widget 'charset 'symbol
+ "An Emacs charset."
+ :tag "Charset"
+ :complete-function (lambda ()
+ (interactive)
+ (lisp-complete-symbol 'charsetp))
+ :completion-ignore-case t
+ :value 'ascii
+ :validate (lambda (widget)
+ (unless (charsetp (widget-value widget))
+ (widget-put widget :error (format "Invalid charset: %S"
+ (widget-value widget)))
+ widget))
+ :prompt-history 'charset-history)
+
+(defcustom language-info-custom-alist nil
+ "Customizations of language environment parameters.
+Value is an alist with elements like those of `language-info-alist'.
+These are used to set values in `language-info-alist' which replace
+the defaults. A typical use is replacing the default input method for
+the environment. Use \\[describe-language-environment] to find the environment's settings.
+
+This option is intended for use at startup. Removing items doesn't
+remove them from the language info until you next restart Emacs.
+
+Setting this variable directly does not take effect. See
+`set-language-info-alist' for use in programs."
+ :group 'mule
+ :version "23.1"
+ :set (lambda (s v)
+ (custom-set-default s v)
+ ;; Can't do this before language environments are set up.
+ (when v
+ ;; modify language-info-alist
+ (dolist (elt v)
+ (set-language-info-alist (car elt) (cdr elt)))
+ ;; re-set the environment in case its parameters changed
+ (set-language-environment current-language-environment)))
+ :type `(alist
+ :key-type (string :tag "Language environment"
+ :completion-ignore-case t
+ :complete-function widget-string-complete
+ :completion-alist language-info-alist)
+ :value-type
+ (alist :key-type symbol
+ :options ((documentation string)
+ (charset (repeat charset))
+ (sample-text string)
+ (setup-function function)
+ (exit-function function)
+ (coding-system (repeat coding-system))
+ (coding-priority (repeat coding-system))
+ (nonascii-translation charset)
+ (input-method
+ (string
+ :completion-ignore-case t
+ :complete-function widget-string-complete
+ :completion-alist input-method-alist
+ :prompt-history input-method-history))
+ (features (repeat symbol))
+ (unibyte-display coding-system)))))
+
(defun standard-display-european-internal ()
;; Actually set up direct output of non-ASCII characters.
(standard-display-8bit (if (eq window-system 'pc) 128 160) 255)
(let* ((priority (get-language-info language-name 'coding-priority))
(default-coding (car priority))
(eol-type (coding-system-eol-type default-buffer-file-coding-system)))
- (if priority
- (let ((categories (mapcar 'coding-system-category priority)))
- (set-default-coding-systems
- (if (memq eol-type '(0 1 2 unix dos mac))
- (coding-system-change-eol-conversion default-coding eol-type)
- default-coding))
- (setq default-sendmail-coding-system default-coding)
- (set-coding-priority categories)
- (while priority
- (set (car categories) (car priority))
- (setq priority (cdr priority) categories (cdr categories)))
- ;; Changing the binding of a coding category requires this call.
- (update-coding-systems-internal)))))
+ (when priority
+ (set-default-coding-systems
+ (if (memq eol-type '(0 1 2 unix dos mac))
+ (coding-system-change-eol-conversion default-coding eol-type)
+ default-coding))
+ (setq default-sendmail-coding-system default-coding)
+ (apply 'set-coding-system-priority priority))))
(defun set-language-environment-input-method (language-name)
"Do various input method setups for language environment LANGUAGE-NAME."
(defun set-language-environment-nonascii-translation (language-name)
"Do unibyte/multibyte translation setup for language environment LANGUAGE-NAME."
- (let ((nonascii (get-language-info language-name 'nonascii-translation))
- (dos-table
- (if (eq window-system 'pc)
- (intern
- (format "cp%d-nonascii-translation-table" dos-codepage)))))
- (cond
- ((char-table-p nonascii)
- (setq nonascii-translation-table nonascii))
- ((and (eq window-system 'pc) (boundp dos-table))
- ;; DOS terminals' default is to use a special non-ASCII translation
- ;; table as appropriate for the installed codepage.
- (setq nonascii-translation-table (symbol-value dos-table)))
- ((charsetp nonascii)
- (setq nonascii-insert-offset (- (make-char nonascii) 128))))))
+ ;; Note: For DOS, we assumed that the charset cpXXX is already
+ ;; defined.
+ (let ((nonascii (get-language-info language-name 'nonascii-translation)))
+ (if (eq window-system 'pc)
+ (setq nonascii (intern "cp%d" dos-codepage)))
+ (or (and (charsetp nonascii)
+ (get-charset-property nonascii :ascii-compatible-p))
+ (setq nonascii 'iso-8859-1))
+ (set-unibyte-charset nonascii)))
(defun set-language-environment-charset (language-name)
"Do various charset setups for language environment LANGUAGE-NAME."
- (if (and utf-translate-cjk-mode
- (not (eq utf-translate-cjk-lang-env language-name))
- (catch 'tag
- (dolist (charset (get-language-info language-name 'charset))
- (if (memq charset utf-translate-cjk-charsets)
- (throw 'tag t)))
- nil))
- (utf-translate-cjk-load-tables)))
-
-(defun set-language-environment-fontset (language-name)
- "Do various fontset setups for language environment LANGUAGE-NAME."
- ;; Don't invoke fontset-related functions if fontsets aren't
- ;; supported in this build of Emacs.
- (if (fboundp 'fontset-list)
- (set-overriding-fontspec-internal
- (get-language-info language-name 'overriding-fontspec))))
+ ;; Put higher priorities to such charsets that are supported by the
+ ;; coding systems of higher priorities in this environment.
+ (let ((charsets (get-language-info language-name 'charset)))
+ (dolist (coding (get-language-info language-name 'coding-priority))
+ (setq charsets (append charsets (coding-system-charset-list coding))))
+ (if charsets
+ (apply 'set-charset-priority charsets))))
(defun set-language-environment-unibyte (language-name)
"Do various unibyte-mode setups for language environment LANGUAGE-NAME."
- ;; Syntax and case table.
- (let ((syntax (get-language-info language-name 'unibyte-syntax)))
- (if syntax
- (let ((set-case-syntax-set-multibyte nil))
- (load syntax nil t))
- ;; No information for syntax and case. Reset to the defaults.
- (let ((syntax-table (standard-syntax-table))
- (standard-table (standard-case-table))
- (case-table (make-char-table 'case-table))
- (ch (if (eq window-system 'pc) 128 160)))
- (while (< ch 256)
- (modify-syntax-entry ch " " syntax-table)
- (setq ch (1+ ch)))
- (dotimes (i 128)
- (aset case-table i (aref standard-table i)))
- (set-char-table-extra-slot case-table 0 nil)
- (set-char-table-extra-slot case-table 1 nil)
- (set-char-table-extra-slot case-table 2 nil)
- (set-standard-case-table case-table))
- (let ((list (buffer-list)))
- (while list
- (with-current-buffer (car list)
- (set-case-table (standard-case-table)))
- (setq list (cdr list))))))
(set-display-table-and-terminal-coding-system language-name))
(defsubst princ-list (&rest args)
(insert "Sample text:\n " str "\n\n")))
(error nil))
(let ((input-method (get-language-info language-name 'input-method))
- (l (copy-sequence input-method-alist)))
- (insert "Input methods")
- (when input-method
- (insert " (default " input-method ")")
- (setq input-method (assoc input-method input-method-alist))
- (setq l (cons input-method (delete input-method l))))
- (insert ":\n")
- (while l
- (when (string= language-name (nth 1 (car l)))
- (insert " " (car (car l)))
- (search-backward (car (car l)))
- (help-xref-button 0 'help-input-method (car (car l)))
+ (l (copy-sequence input-method-alist))
+ (first t))
+ (when (and input-method
+ (setq input-method (assoc input-method l)))
+ (insert "Input methods (default " (car input-method) ")\n")
+ (setq l (cons input-method (delete input-method l))
+ first nil))
+ (dolist (elt l)
+ (when (or (eq input-method elt)
+ (eq t (compare-strings language-name nil nil
+ (nth 1 elt) nil nil t)))
+ (when first
+ (insert "Input methods:\n")
+ (setq first nil))
+ (insert " " (car elt))
+ (search-backward (car elt))
+ (help-xref-button 0 'help-input-method (car elt))
(goto-char (point-max))
(insert " (\""
- (if (stringp (nth 3 (car l)))
- (nth 3 (car l))
- (car (nth 3 (car l))))
- "\" in mode line)\n"))
- (setq l (cdr l)))
- (insert "\n"))
+ (if (stringp (nth 3 elt)) (nth 3 elt) (car (nth 3 elt)))
+ "\" in mode line)\n")))
+ (or first
+ (insert "\n")))
(insert "Character sets:\n")
(let ((l (get-language-info language-name 'charset)))
(if (null l)
"' in mode line):\n\t"
(coding-system-doc-string (car l))
"\n")
- (let ((aliases (coding-system-get (car l)
- 'alias-coding-systems)))
+ (let ((aliases (coding-system-aliases (car l))))
(when aliases
(insert "\t(alias:")
(while aliases
("so_ET" "UTF-8") ; Somali
("so" "Latin-1") ; Somali
("sq" . "Latin-1") ; Albanian
- ("sr_YU@cyrillic" . "Cyrillic-ISO") ; Serbian (Cyrillic alphabet)
("sr" . "Latin-2") ; Serbian (Latin alphabet)
; ss Siswati
("st" . "Latin-1") ; Sesotho
; yo Yoruba
; za Zhuang
("zh_HK" . "Chinese-Big5")
+ ; zh_HK/BIG5-HKSCS \
("zh_TW" . "Chinese-Big5")
+ ("zh_CN.GB2312" "Chinese-GB")
+ ("zh_CN.GBK" "Chinese-GBK")
+ ("zh_CN.GB18030" "Chinese-GB18030")
+ ("zh_CN.UTF-8" . "Chinese-GBK")
("zh_CN" . "Chinese-GB")
("zh" . "Chinese-GB")
- ; zh_CN.GB18030/GB18030 \
- ; zh_CN.GBK/GBK \
- ; zh_HK/BIG5-HKSCS \
("zu" . "Latin-1") ; Zulu
;; ISO standard locales
("sp" . "Cyrillic-ISO") ; Serbian (Cyrillic alphabet), e.g. X11R6.4
("su" . "Latin-1") ; Finnish, e.g. Solaris 2.6
("jp" . "Japanese") ; e.g. MS Windows
- ("chs" . "Chinese-GB") ; MS Windows Chinese Simplified
+ ("chs" . "Chinese-GBK") ; MS Windows Chinese Simplified
("cht" . "Chinese-BIG5") ; MS Windows Chinese Traditional
("gbz" . "UTF-8") ; MS Windows Dari Persian
("div" . "UTF-8") ; MS Windows Divehi (Maldives)
("koi8-?r" . koi8-r)
("koi8-?u" . koi8-u)
("tcvn" . tcvn)
+ ("big5[-_]?hkscs" . big5-hkscs)
("big5" . big5)
("euc-?tw" . euc-tw)
- ;; We don't support GBK, but as it is upper compatible with
- ;; GB-2312, we setup the default coding system to gb2312.
- ("gbk" . gb2312)
- ;; We don't support BIG5-HKSCS, but as it is upper compatible with
- ;; BIG5, we setup the default coding system to big5.
- ("big5hkscs" . big5)
+ ("euc-?cn" .euc-cn)
+ ("gb2312" . gb2312)
+ ("gbk" . gbk)
+ ("gb18030" . gb18030)
("ja.*[._]euc" . japanese-iso-8bit)
("ja.*[._]jis7" . iso-2022-jp)
("ja.*[._]pck" . japanese-shift-jis)
;; using the translation file that many systems have.
(when locale-translation-file-name
(with-temp-buffer
+ (set-buffer-multibyte nil)
(insert-file-contents locale-translation-file-name)
(when (re-search-forward
(concat "^" (regexp-quote locale) ":?[ \t]+") nil t)
;; Fixme: perhaps prefer-coding-system should set this too.
;; But it's not the time to do such a fundamental change.
(setq default-sendmail-coding-system coding-system)
- (setq locale-coding-system coding-system))))
+ (setq locale-coding-system coding-system))
+
+ (when (get-language-info current-language-environment 'coding-priority)
+ (let ((codeset (locale-info 'codeset))
+ (coding-system (car (coding-system-priority-list))))
+ (when codeset
+ (let ((cs (coding-system-aliases coding-system))
+ result)
+ (while (and cs (not result))
+ (setq result
+ (locale-charset-match-p (symbol-name (pop cs))
+ (locale-info 'codeset))))
+ (unless result
+ (message "Warning: Default coding system `%s' disagrees with
+system codeset `%s' for this locale." coding-system codeset))))))))
;; On Windows, override locale-coding-system,
;; default-file-name-coding-system, keyboard-coding-system,
'a4)))))))
nil)
\f
-;;; Charset property
-
-(defun get-charset-property (charset propname)
- "Return the value of CHARSET's PROPNAME property.
-This is the last value stored with
- (put-charset-property CHARSET PROPNAME VALUE)."
- (and (not (eq charset 'composition))
- (plist-get (charset-plist charset) propname)))
-
-(defun put-charset-property (charset propname value)
- "Store CHARSETS's PROPNAME property with value VALUE.
-It can be retrieved with `(get-charset-property CHARSET PROPNAME)'."
- (or (eq charset 'composition)
- (set-charset-plist charset
- (plist-put (charset-plist charset) propname value))))
+;;; Character property
+
+;; Each element has the form (PROP . TABLE).
+;; PROP is a symbol representing a character property.
+;; TABLE is a char-table containing the property value for each character.
+;; TABLE may be a name of file to load to build a char-table.
+;; Don't modify this variable directly but use `define-char-code-property'.
+
+(defvar char-code-property-alist nil
+ "Alist of character property name vs char-table containing property values.
+Internal use only.")
+
+(put 'char-code-property-table 'char-table-extra-slots 5)
+
+(defun define-char-code-property (name table &optional docstring)
+ "Define NAME as a character code property given by TABLE.
+TABLE is a char-table of purpose `char-code-property-table' with
+these extra slots:
+ 1st: NAME.
+ 2nd: Function to call to get a property value of a character.
+ It is called with three arguments CHAR, VAL, and TABLE, where
+ CHAR is a character, VAL is the value of (aref TABLE CHAR).
+ 3rd: Function to call to put a property value of a character.
+ It is called with the same arguments as above.
+ 4th: Function to call to get a description string of a property value.
+ It is called with one argument VALUE, a property value.
+ 5th: Data used by the above functions.
+
+TABLE may be a name of file to load to build a char-table. The
+file should contain a call of `define-char-code-property' with a
+char-table of the above format as the argument TABLE.
+
+TABLE may also be nil, in which case no property value is pre-assigned.
+
+Optional 3rd argment DOCSTRING is a documentation string of the property.
-;;; Character code property
-(put 'char-code-property-table 'char-table-extra-slots 0)
+See also the documentation of `get-char-code-property' and
+`put-char-code-property'."
+ (or (symbolp name)
+ (error "Not a symbol: %s" name))
+ (if (char-table-p table)
+ (or (and (eq (char-table-subtype table) 'char-code-property-table)
+ (eq (char-table-extra-slot table 0) name))
+ (error "Invalid char-table: %s" table))
+ (or (stringp table)
+ (error "Not a char-table nor a file name: %s" table)))
+ (let ((slot (assq name char-code-property-alist)))
+ (if slot
+ (setcdr slot table)
+ (setq char-code-property-alist
+ (cons (cons name table) char-code-property-alist))))
+ (put name 'char-code-property-documentation docstring))
(defvar char-code-property-table
(make-char-table 'char-code-property-table)
"Char-table containing a property list of each character code.
-
+This table is used for properties not listed in `char-code-property-alist'.
See also the documentation of `get-char-code-property' and
`put-char-code-property'.")
(defun get-char-code-property (char propname)
- "Return the value of CHAR's PROPNAME property in `char-code-property-table'."
- (let ((plist (aref char-code-property-table char)))
- (if (listp plist)
- (car (cdr (memq propname plist))))))
+ "Return the value of CHAR's PROPNAME property."
+ (let ((slot (assq propname char-code-property-alist)))
+ (if slot
+ (let (table value func)
+ (if (stringp (cdr slot))
+ (load (cdr slot)))
+ (setq table (cdr slot)
+ value (aref table char)
+ func (char-table-extra-slot table 1))
+ (if (functionp func)
+ (setq value (funcall func char value table)))
+ value)
+ (plist-get (aref char-code-property-table char) propname))))
(defun put-char-code-property (char propname value)
- "Store CHAR's PROPNAME property with VALUE in `char-code-property-table'.
+ "Store CHAR's PROPNAME property with VALUE.
It can be retrieved with `(get-char-code-property CHAR PROPNAME)'."
- (let ((plist (aref char-code-property-table char)))
- (if plist
- (let ((slot (memq propname plist)))
- (if slot
- (setcar (cdr slot) value)
- (nconc plist (list propname value))))
- (aset char-code-property-table char (list propname value)))))
+ (let ((slot (assq propname char-code-property-alist)))
+ (if slot
+ (let (table func)
+ (if (stringp (cdr slot))
+ (load (cdr slot)))
+ (setq table (cdr slot)
+ func (char-table-extra-slot table 2))
+ (if (functionp func)
+ (funcall func char value table)
+ (aset table char value)))
+ (let* ((plist (aref char-code-property-table char))
+ (x (plist-put plist propname value)))
+ (or (eq x plist)
+ (aset char-code-property-table char x))))
+ value))
+
+(defun char-code-property-description (prop value)
+ "Return a description string of character property PROP's value VALUE.
+If there's no description string for VALUE, return nil."
+ (let ((slot (assq prop char-code-property-alist)))
+ (if slot
+ (let (table func)
+ (if (stringp (cdr slot))
+ (load (cdr slot)))
+ (setq table (cdr slot)
+ func (char-table-extra-slot table 3))
+ (if (functionp func)
+ (funcall func value))))))
\f
;; Pretty description of encoded string
"Return a pretty description of STR that is encoded by CODING-SYSTEM."
(setq str (string-as-unibyte str))
(mapconcat
- (if (and coding-system (eq (coding-system-type coding-system) 2))
+ (if (and coding-system (eq (coding-system-type coding-system) 'iso-2022))
;; Try to get a pretty description for ISO 2022 escape sequences.
(function (lambda (x) (or (cdr (assq x iso-2022-control-alist))
(format "#x%02X" x))))
(defun encode-coding-char (char coding-system)
"Encode CHAR by CODING-SYSTEM and return the resulting string.
If CODING-SYSTEM can't safely encode CHAR, return nil."
- (let ((str1 (string-as-multibyte (char-to-string char)))
- (str2 (string-as-multibyte (make-string 2 char)))
- (safe-chars (and coding-system
- (coding-system-get coding-system 'safe-chars)))
- (charset (char-charset char))
+ (let ((str1 (string-as-multibyte (string char)))
+ (str2 (string-as-multibyte (string char char)))
enc1 enc2 i1 i2)
- (when (or (eq safe-chars t)
- (eq charset 'ascii)
- (and safe-chars (aref safe-chars char)))
+ (when (memq (coding-system-base coding-system)
+ (find-coding-systems-string str1))
;; We must find the encoded string of CHAR. But, just encoding
;; CHAR will put extra control sequences (usually to designate
;; ASCII charset) at the tail if type of CODING is ISO 2022.
;; exclude.
(substring enc2 0 i2))))
+;; Backwards compatibility. These might be better with :init-value t,
+;; but that breaks loadup.
+(define-minor-mode unify-8859-on-encoding-mode
+ "Obsolete."
+ :group 'mule
+ :global t)
+(define-minor-mode unify-8859-on-decoding-mode
+ "Obsolete."
+ :group 'mule
+ :global t)
+
+(defvar nonascii-insert-offset 0 "This variable is obsolete.")
+(defvar nonascii-translation-table nil "This variable is obsolete.")
+
+(defun ucs-insert (arg)
+ "Insert a character of the given Unicode code point.
+Interactively, prompts for a hex string giving the code."
+ (interactive "sUnicode (hex): ")
+ (or (integerp arg)
+ (setq arg (string-to-number arg 16)))
+ (if (or (< arg 0) (> arg #x10FFFF))
+ (error "Not a Unicode character code: 0x%X" arg))
+ (insert arg))
+
;; arch-tag: b382c432-4b36-460e-bf4c-05efd0bb18dc
;;; mule-cmds.el ends here
-;;; mule-conf.el --- configure multilingual environment -*- no-byte-compile: t -*-
+;;; mule-conf.el --- configure multilingual environment
;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003,
- ;; 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
- ;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ ;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+ ;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
+;; Copyright (C) 2003
+;; National Institute of Advanced Industrial Science and Technology (AIST)
+;; Registration Number H13PRO009
-;; Keywords: mule, multilingual, character set, coding system
+;; Keywords: i18n, mule, multilingual, character set, coding system
;; This file is part of GNU Emacs.
;;; Commentary:
-;; Don't byte-compile this file.
+;; This file defines the Emacs charsets and some basic coding systems.
+;; Other coding systems are defined in the files in directory
+;; lisp/language.
;;; Code:
+;;; Remarks
+
+;; The ISO-IR registry is at http://www.itscj.ipsj.or.jp/ISO-IR/.
+;; Standards docs equivalent to iso-2022 and iso-8859 are at
+;; http://www.ecma.ch/.
+
+;; FWIW, http://www.microsoft.com/globaldev/ lists the following for
+;; MS Windows, which are presumably the only charsets we really need
+;; to worry about on such systems:
+;; `OEM codepages': 437, 720, 737, 775, 850, 852, 855, 857, 858, 862, 866
+;; `Windows codepages': 1250, 1251, 1252, 1253, 1254, 1255, 1256, 1257,
+;; 1258, 874, 932, 936, 949, 950
+
;;; Definitions of character sets.
-;; Basic (official) character sets. These character sets are treated
-;; efficiently with respect to buffer memory.
-
-;; Syntax:
-;; (define-charset CHARSET-ID CHARSET
-;; [ DIMENSION CHARS WIDTH DIRECTION ISO-FINAL-CHAR ISO-GRAPHIC-PLANE
-;; SHORT-NAME LONG-NAME DESCRIPTION ])
-;; ASCII charset is defined in src/charset.c as below.
-;; (define-charset 0 ascii
-;; [1 94 1 0 ?B 0 "ASCII" "ASCII" "ASCII (ISO646 IRV)"])
-
-;; 1-byte charsets. Valid range of CHARSET-ID is 128..143.
-
-;; CHARSET-ID 128 is not used.
-
-(define-charset 129 'latin-iso8859-1
- [1 96 1 0 ?A 1 "RHP of Latin-1" "RHP of Latin-1 (ISO 8859-1): ISO-IR-100"
- "Right-Hand Part of Latin Alphabet 1 (ISO/IEC 8859-1): ISO-IR-100."])
-(define-charset 130 'latin-iso8859-2
- [1 96 1 0 ?B 1 "RHP of Latin-2" "RHP of Latin-2 (ISO 8859-2): ISO-IR-101"
- "Right-Hand Part of Latin Alphabet 2 (ISO/IEC 8859-2): ISO-IR-101."])
-(define-charset 131 'latin-iso8859-3
- [1 96 1 0 ?C 1 "RHP of Latin-3" "RHP of Latin-3 (ISO 8859-3): ISO-IR-109"
- "Right-Hand Part of Latin Alphabet 3 (ISO/IEC 8859-3): ISO-IR-109."])
-(define-charset 132 'latin-iso8859-4
- [1 96 1 0 ?D 1 "RHP of Latin-4" "RHP of Latin-4 (ISO 8859-4): ISO-IR-110"
- "Right-Hand Part of Latin Alphabet 4 (ISO/IEC 8859-4): ISO-IR-110."])
-(define-charset 133 'thai-tis620
- [1 96 1 0 ?T 1 "RHP of TIS620" "RHP of Thai (TIS620): ISO-IR-166"
- "Right-Hand Part of TIS620.2533 (Thai): ISO-IR-166."])
-(define-charset 134 'greek-iso8859-7
- [1 96 1 0 ?F 1 "RHP of ISO8859/7" "RHP of Greek (ISO 8859-7): ISO-IR-126"
- "Right-Hand Part of Latin/Greek Alphabet (ISO/IEC 8859-7): ISO-IR-126."])
-(define-charset 135 'arabic-iso8859-6
- [1 96 1 1 ?G 1 "RHP of ISO8859/6" "RHP of Arabic (ISO 8859-6): ISO-IR-127"
- "Right-Hand Part of Latin/Arabic Alphabet (ISO/IEC 8859-6): ISO-IR-127."])
-(define-charset 136 'hebrew-iso8859-8
- [1 96 1 1 ?H 1 "RHP of ISO8859/8" "RHP of Hebrew (ISO 8859-8): ISO-IR-138"
- "Right-Hand Part of Latin/Hebrew Alphabet (ISO/IEC 8859-8): ISO-IR-138."])
-(define-charset 137 'katakana-jisx0201
- [1 94 1 0 ?I 1 "JISX0201 Katakana" "Japanese Katakana (JISX0201.1976)"
- "Katakana Part of JISX0201.1976."])
-(define-charset 138 'latin-jisx0201
- [1 94 1 0 ?J 0 "JISX0201 Roman" "Japanese Roman (JISX0201.1976)"
- "Roman Part of JISX0201.1976."])
-
-;; CHARSET-ID is not used 139.
-
-(define-charset 140 'cyrillic-iso8859-5
- [1 96 1 0 ?L 1 "RHP of ISO8859/5" "RHP of Cyrillic (ISO 8859-5): ISO-IR-144"
- "Right-Hand Part of Latin/Cyrillic Alphabet (ISO/IEC 8859-5): ISO-IR-144."])
-(define-charset 141 'latin-iso8859-9
- [1 96 1 0 ?M 1 "RHP of Latin-5" "RHP of Latin-5 (ISO 8859-9): ISO-IR-148"
- "Right-Hand Part of Latin Alphabet 5 (ISO/IEC 8859-9): ISO-IR-148."])
-(define-charset 142 'latin-iso8859-15
- [1 96 1 0 ?b 1 "RHP of Latin-9" "RHP of Latin-9 (ISO 8859-15): ISO-IR-203"
- "Right-Hand Part of Latin Alphabet 9 (ISO/IEC 8859-15): ISO-IR-203."])
-(define-charset 143 'latin-iso8859-14
- [1 96 1 0 ?_ 1 "RHP of Latin-8" "RHP of Latin-8 (ISO 8859-14): ISO-IR-199"
- "Right-Hand Part of Latin Alphabet 8 (ISO/IEC 8859-14): ISO-IR-199."])
-
-;; 2-byte charsets. Valid range of CHARSET-ID is 144..153.
-
-(define-charset 144 'japanese-jisx0208-1978
- [2 94 2 0 ?@ 0 "JISX0208.1978" "JISX0208.1978 (Japanese): ISO-IR-42"
- "JISX0208.1978 Japanese Kanji (so called \"old JIS\"): ISO-IR-42."])
-(define-charset 145 'chinese-gb2312
- [2 94 2 0 ?A 0 "GB2312" "GB2312: ISO-IR-58"
- "GB2312 Chinese simplified: ISO-IR-58."])
-(define-charset 146 'japanese-jisx0208
- [2 94 2 0 ?B 0 "JISX0208" "JISX0208.1983/1990 (Japanese): ISO-IR-87"
- "JISX0208.1983/1990 Japanese Kanji: ISO-IR-87."])
-(define-charset 147 'korean-ksc5601
- [2 94 2 0 ?C 0 "KSC5601" "KSC5601 (Korean): ISO-IR-149"
- "KSC5601 Korean Hangul and Hanja: ISO-IR-149."])
-(define-charset 148 'japanese-jisx0212
- [2 94 2 0 ?D 0 "JISX0212" "JISX0212 (Japanese): ISO-IR-159"
- "JISX0212 Japanese supplement: ISO-IR-159."])
-(define-charset 149 'chinese-cns11643-1
- [2 94 2 0 ?G 0 "CNS11643-1" "CNS11643-1 (Chinese traditional): ISO-IR-171"
- "CNS11643 Plane 1 Chinese traditional: ISO-IR-171."])
-(define-charset 150 'chinese-cns11643-2
- [2 94 2 0 ?H 0 "CNS11643-2" "CNS11643-2 (Chinese traditional): ISO-IR-172"
- "CNS11643 Plane 2 Chinese traditional: ISO-IR-172."])
-(define-charset 151 'japanese-jisx0213-1
- [2 94 2 0 ?O 0 "JISX0213-1" "JISX0213-1" "JISX0213 Plane 1 (Japanese)"])
-(define-charset 152 'chinese-big5-1
- [2 94 2 0 ?0 0 "Big5 (Level-1)" "Big5 (Level-1) A141-C67F"
- "Frequently used part (A141-C67F) of Big5 (Chinese traditional)."])
-(define-charset 153 'chinese-big5-2
- [2 94 2 0 ?1 0 "Big5 (Level-2)" "Big5 (Level-2) C940-FEFE"
- "Less frequently used part (C940-FEFE) of Big5 (Chinese traditional)."])
-
-;; Additional (private) character sets. These character sets are
-;; treated less space-efficiently in the buffer.
-
-;; Syntax:
-;; (define-charset CHARSET-ID CHARSET
-;; [ DIMENSION CHARS WIDTH DIRECTION ISO-FINAL-CHAR ISO-GRAPHIC-PLANE
-;; SHORT-NAME LONG-NAME DESCRIPTION ])
-
-;; ISO-2022 allows a use of character sets not registered in ISO with
-;; final characters `0' (0x30) through `?' (0x3F). Among them, Emacs
-;; reserves `0' through `9' to support several private character sets.
-;; The remaining final characters `:' through `?' are for users.
-
-;; 1-byte 1-column charsets. Valid range of CHARSET-ID is 160..223.
-
-(define-charset 160 'chinese-sisheng
- [1 94 1 0 ?0 0 "SiSheng" "SiSheng (PinYin/ZhuYin)"
- "Sisheng characters (vowels with tone marks) for Pinyin/Zhuyin."])
-
-;; IPA characters for phonetic symbols.
-(define-charset 161 'ipa
- [1 96 1 0 ?0 1 "IPA" "IPA"
- "IPA (International Phonetic Association) characters."])
-
-;; Vietnamese VISCII. VISCII is 1-byte character set which contains
-;; more than 96 characters. Since Emacs can't handle it as one
-;; character set, it is divided into two: lower case letters and upper
-;; case letters.
-(define-charset 162 'vietnamese-viscii-lower
- [1 96 1 0 ?1 1 "VISCII lower" "VISCII lower-case"
- "Vietnamese VISCII1.1 lower-case characters."])
-(define-charset 163 'vietnamese-viscii-upper
- [1 96 1 0 ?2 1 "VISCII upper" "VISCII upper-case"
- "Vietnamese VISCII1.1 upper-case characters."])
+;; The charsets `ascii', `unicode' and `eight-bit' are already defined
+;; in charset.c as below:
+;;
+;; (define-charset 'ascii
+;; ""
+;; :dimension 1
+;; :code-space [0 127]
+;; :iso-final-char ?B
+;; :ascii-compatible-p t
+;; :emacs-mule-id 0
+;; :code-offset 0)
+;;
+;; (define-charset 'unicode
+;; ""
+;; :dimension 3
+;; :code-space [0 255 0 255 0 16]
+;; :ascii-compatible-p t
+;; :code-offset 0)
+;;
+;; (define-charset 'eight-bit
+;; ""
+;; :dimension 1
+;; :code-space [128 255]
+;; :code-offset #x3FFF80)
+;;
+;; We now set :docstring, :short-name, and :long-name properties.
+
+(put-charset-property
+ 'ascii :docstring "ASCII (ISO646 IRV)")
+(put-charset-property
+ 'ascii :short-name "ASCII")
+(put-charset-property
+ 'ascii :long-name "ASCII (ISO646 IRV)")
+(put-charset-property
+ 'iso-8859-1 :docstring "Latin-1 (ISO/IEC 8859-1)")
+(put-charset-property
+ 'iso-8859-1 :short-name "Latin-1")
+(put-charset-property
+ 'iso-8859-1 :long-name "Latin-1")
+(put-charset-property
+ 'unicode :docstring "Unicode (ISO10646)")
+(put-charset-property
+ 'unicode :short-name "Unicode")
+(put-charset-property
+ 'unicode :long-name "Unicode (ISO10646)")
+(put-charset-property 'eight-bit :docstring "Raw bytes 0-255")
+(put-charset-property 'eight-bit :short-name "Raw bytes")
+
+(define-charset-alias 'ucs 'unicode)
+
+(define-charset 'emacs
+ "Full Emacs characters"
+ :ascii-compatible-p t
+ :code-space [ 0 255 0 255 0 63 ]
+ :code-offset 0
+ :supplementary-p t)
+
+(define-charset 'latin-iso8859-1
+ "Right-Hand Part of ISO/IEC 8859/1 (Latin-1): ISO-IR-100"
+ :short-name "RHP of Latin-1"
+ :long-name "RHP of ISO/IEC 8859/1 (Latin-1): ISO-IR-100"
+ :iso-final-char ?A
+ :emacs-mule-id 129
+ :code-space [32 127]
+ :code-offset 160)
+
+;; Name perhaps not ideal, but is XEmacs-compatible.
+(define-charset 'control-1
+ "8-bit control code (0x80..0x9F)"
+ :short-name "8-bit control code"
+ :code-space [128 159]
+ :code-offset 128)
+
+(define-charset 'eight-bit-control
+ "Raw bytes in the range 0x80..0x9F (usually produced from invalid encodings)"
+ :short-name "Raw bytes 0x80..0x9F"
+ :supplementary-p t
+ :code-space [128 159]
+ :code-offset #x3FFF80) ; see character.h
+
+(define-charset 'eight-bit-graphic
+ "Raw bytes in the range 0xA0..0xFF (usually produced from invalid encodings)"
+ :short-name "Raw bytes 0xA0..0xFF"
+ :supplementary-p t
+ :code-space [160 255]
+ :code-offset #x3FFFA0) ; see character.h
+
+(defmacro define-iso-single-byte-charset (symbol iso-symbol name nickname
+ iso-ir iso-final
+ emacs-mule-id map)
+ `(progn
+ (define-charset ,symbol
+ ,name
+ :short-name ,nickname
+ :long-name ,name
+ :ascii-compatible-p t
+ :code-space [0 255]
+ :map ,map)
+ (if ,iso-symbol
+ (define-charset ,iso-symbol
+ (if ,iso-ir
+ (format "Right-Hand Part of %s (%s): ISO-IR-%d"
+ ,name ,nickname ,iso-ir)
+ (format "Right-Hand Part of %s (%s)" ,name ,nickname))
+ :short-name (format "RHP of %s" ,name)
+ :long-name (format "RHP of %s (%s)" ,name ,nickname)
+ :iso-final-char ,iso-final
+ :emacs-mule-id ,emacs-mule-id
+ :supplementary-p t
+ :code-space [32 127]
+ :subset (list ,symbol 160 255 -128)))))
+
+(define-iso-single-byte-charset 'iso-8859-2 'latin-iso8859-2
+ "ISO/IEC 8859/2" "Latin-2" 101 ?B 130 "8859-2")
+
+(define-iso-single-byte-charset 'iso-8859-3 'latin-iso8859-3
+ "ISO/IEC 8859/3" "Latin-3" 109 ?C 131 "8859-3")
+
+(define-iso-single-byte-charset 'iso-8859-4 'latin-iso8859-4
+ "ISO/IEC 8859/4" "Latin-4" 110 ?D 132 "8859-4")
+
+(define-iso-single-byte-charset 'iso-8859-5 'cyrillic-iso8859-5
+ "ISO/IEC 8859/5" "Latin/Cyrillic" 144 ?L 140 "8859-5")
+
+(define-iso-single-byte-charset 'iso-8859-6 'arabic-iso8859-6
+ "ISO/IEC 8859/6" "Latin/Arabic" 127 ?G 135 "8859-6")
+
+(define-iso-single-byte-charset 'iso-8859-7 'greek-iso8859-7
+ "ISO/IEC 8859/7" "Latin/Greek" 126 ?F 134 "8859-7")
+
+(define-iso-single-byte-charset 'iso-8859-8 'hebrew-iso8859-8
+ "ISO/IEC 8859/8" "Latin/Hebrew" 138 ?H 136 "8859-8")
+
+(define-iso-single-byte-charset 'iso-8859-9 'latin-iso8859-9
+ "ISO/IEC 8859/9" "Latin-5" 148 ?M 141 "8859-9")
+
+(define-iso-single-byte-charset 'iso-8859-10 'latin-iso8859-10
+ "ISO/IEC 8859/10" "Latin-6" 157 ?V nil "8859-10")
+
+;; http://www.nectec.or.th/it-standards/iso8859-11/
+;; http://www.cwi.nl/~dik/english/codes/8859.html says this is tis-620
+;; plus nbsp
+(define-iso-single-byte-charset 'iso-8859-11 'thai-iso8859-11
+ "ISO/IEC 8859/11" "Latin/Thai" 166 ?T nil "8859-11")
+
+;; 8859-12 doesn't (yet?) exist.
+
+(define-iso-single-byte-charset 'iso-8859-13 'latin-iso8859-13
+ "ISO/IEC 8859/13" "Latin-7" 179 ?Y nil "8859-13")
+
+(define-iso-single-byte-charset 'iso-8859-14 'latin-iso8859-14
+ "ISO/IEC 8859/14" "Latin-8" 199 ?_ 143 "8859-14")
+
+(define-iso-single-byte-charset 'iso-8859-15 'latin-iso8859-15
+ "ISO/IEC 8859/15" "Latin-9" 203 ?b 142 "8859-15")
+
+(define-iso-single-byte-charset 'iso-8859-16 'latin-iso8859-16
+ "ISO/IEC 8859/16" "Latin-10" 226 ?f nil "8859-16")
+
+;; No point in keeping it around.
+(fmakunbound 'define-iso-single-byte-charset)
+
+;; Can this be shared with 8859-11?
+;; N.b. not all of these are defined unicodes.
+(define-charset 'thai-tis620
+ "TIS620.2533"
+ :short-name "TIS620.2533"
+ :iso-final-char ?T
+ :emacs-mule-id 133
+ :code-space [32 127]
+ :code-offset #x0E00)
+
+;; Fixme: doc for this, c.f. above
+(define-charset 'tis620-2533
+ "TIS620.2533"
+ :short-name "TIS620.2533"
+ :ascii-compatible-p t
+ :code-space [0 255]
+ :superset '(ascii eight-bit-control (thai-tis620 . 128)))
+
+(define-charset 'jisx0201
+ "JISX0201"
+ :short-name "JISX0201"
+ :code-space [0 #xDF]
+ :map "JISX0201")
+
+(define-charset 'latin-jisx0201
+ "Roman Part of JISX0201.1976"
+ :short-name "JISX0201 Roman"
+ :long-name "Japanese Roman (JISX0201.1976)"
+ :iso-final-char ?J
+ :emacs-mule-id 138
+ :supplementary-p t
+ :code-space [33 126]
+ :subset '(jisx0201 33 126 0))
+
+(define-charset 'katakana-jisx0201
+ "Katakana Part of JISX0201.1976"
+ :short-name "JISX0201 Katakana"
+ :long-name "Japanese Katakana (JISX0201.1976)"
+ :iso-final-char ?I
+ :emacs-mule-id 137
+ :supplementary-p t
+ :code-space [33 126]
+ :subset '(jisx0201 161 254 -128))
+
+(define-charset 'chinese-gb2312
+ "GB2312 Chinese simplified: ISO-IR-58"
+ :short-name "GB2312"
+ :long-name "GB2312: ISO-IR-58"
+ :iso-final-char ?A
+ :emacs-mule-id 145
+ :code-space [33 126 33 126]
+ :code-offset #x110000
+ :unify-map "GB2312")
+
+(define-charset 'chinese-gbk
+ "GBK Chinese simplified."
+ :short-name "GBK"
+ :code-space [#x40 #xFE #x81 #xFE]
+ :code-offset #x160000
+ :unify-map "GBK")
+(define-charset-alias 'cp936 'chinese-gbk)
+(define-charset-alias 'windows-936 'chinese-gbk)
+
+(define-charset 'chinese-cns11643-1
+ "CNS11643 Plane 1 Chinese traditional: ISO-IR-171"
+ :short-name "CNS11643-1"
+ :long-name "CNS11643-1 (Chinese traditional): ISO-IR-171"
+ :iso-final-char ?G
+ :emacs-mule-id 149
+ :code-space [33 126 33 126]
+ :code-offset #x114000
+ :unify-map "CNS-1")
+
+(define-charset 'chinese-cns11643-2
+ "CNS11643 Plane 2 Chinese traditional: ISO-IR-172"
+ :short-name "CNS11643-2"
+ :long-name "CNS11643-2 (Chinese traditional): ISO-IR-172"
+ :iso-final-char ?H
+ :emacs-mule-id 150
+ :code-space [33 126 33 126]
+ :code-offset #x118000
+ :unify-map "CNS-2")
+
+(define-charset 'chinese-cns11643-3
+ "CNS11643 Plane 3 Chinese Traditional: ISO-IR-183"
+ :short-name "CNS11643-3"
+ :long-name "CNS11643-3 (Chinese traditional): ISO-IR-183"
+ :iso-final-char ?I
+ :code-space [33 126 33 126]
+ :emacs-mule-id 246
+ :code-offset #x11C000
+ :unify-map "CNS-3")
+
+(define-charset 'chinese-cns11643-4
+ "CNS11643 Plane 4 Chinese Traditional: ISO-IR-184"
+ :short-name "CNS11643-4"
+ :long-name "CNS11643-4 (Chinese traditional): ISO-IR-184"
+ :iso-final-char ?J
+ :emacs-mule-id 247
+ :code-space [33 126 33 126]
+ :code-offset #x120000
+ :unify-map "CNS-4")
+
+(define-charset 'chinese-cns11643-5
+ "CNS11643 Plane 5 Chinese Traditional: ISO-IR-185"
+ :short-name "CNS11643-5"
+ :long-name "CNS11643-5 (Chinese traditional): ISO-IR-185"
+ :iso-final-char ?K
+ :emacs-mule-id 248
+ :code-space [33 126 33 126]
+ :code-offset #x124000
+ :unify-map "CNS-5")
+
+(define-charset 'chinese-cns11643-6
+ "CNS11643 Plane 6 Chinese Traditional: ISO-IR-186"
+ :short-name "CNS11643-6"
+ :long-name "CNS11643-6 (Chinese traditional): ISO-IR-186"
+ :iso-final-char ?L
+ :emacs-mule-id 249
+ :code-space [33 126 33 126]
+ :code-offset #x128000
+ :unify-map "CNS-6")
+
+(define-charset 'chinese-cns11643-7
+ "CNS11643 Plane 7 Chinese Traditional: ISO-IR-187"
+ :short-name "CNS11643-7"
+ :long-name "CNS11643-7 (Chinese traditional): ISO-IR-187"
+ :iso-final-char ?M
+ :emacs-mule-id 250
+ :code-space [33 126 33 126]
+ :code-offset #x12C000
+ :unify-map "CNS-7")
+
+(define-charset 'big5
+ "Big5 (Chinese traditional)"
+ :short-name "Big5"
+ :code-space [#x40 #xFE #xA1 #xFE]
+ :code-offset #x130000
+ :unify-map "BIG5")
+;; Fixme: AKA cp950 according to
+;; <URL:http://www.microsoft.com/globaldev/reference/WinCP.asp>. Is
+;; that correct?
+
+(define-charset 'chinese-big5-1
+ "Frequently used part (A141-C67E) of Big5 (Chinese traditional)"
+ :short-name "Big5 (Level-1)"
+ :long-name "Big5 (Level-1) A141-C67F"
+ :iso-final-char ?0
+ :emacs-mule-id 152
+ :supplementary-p t
+ :code-space [#x21 #x7E #x21 #x7E]
+ :code-offset #x135000
+ :unify-map "BIG5-1")
+
+(define-charset 'chinese-big5-2
+ "Less frequently used part (C940-FEFE) of Big5 (Chinese traditional)"
+ :short-name "Big5 (Level-2)"
+ :long-name "Big5 (Level-2) C940-FEFE"
+ :iso-final-char ?1
+ :emacs-mule-id 153
+ :supplementary-p t
+ :code-space [#x21 #x7E #x21 #x7E]
+ :code-offset #x137800
+ :unify-map "BIG5-2")
+
+(define-charset 'japanese-jisx0208
+ "JISX0208.1983/1990 Japanese Kanji: ISO-IR-87"
+ :short-name "JISX0208"
+ :long-name "JISX0208.1983/1990 (Japanese): ISO-IR-87"
+ :iso-final-char ?B
+ :emacs-mule-id 146
+ :code-space [33 126 33 126]
+ :code-offset #x140000
+ :unify-map "JISX0208")
+
+(define-charset 'japanese-jisx0208-1978
+ "JISX0208.1978 Japanese Kanji (so called \"old JIS\"): ISO-IR-42"
+ :short-name "JISX0208.1978"
+ :long-name "JISX0208.1978 (JISC6226.1978): ISO-IR-42"
+ :iso-final-char ?@
+ :emacs-mule-id 144
+ :code-space [33 126 33 126]
+ :code-offset #x144000
+ :unify-map "JISC6226")
+
+(define-charset 'japanese-jisx0212
+ "JISX0212 Japanese supplement: ISO-IR-159"
+ :short-name "JISX0212"
+ :long-name "JISX0212 (Japanese): ISO-IR-159"
+ :iso-final-char ?D
+ :emacs-mule-id 148
+ :code-space [33 126 33 126]
+ :code-offset #x148000
+ :unify-map "JISX0212")
+
+;; Note that jisx0213 contains characters not in Unicode (3.2?). It's
+;; arguable whether it should have a unify-map.
+(define-charset 'japanese-jisx0213-1
+ "JISX0213.2000 Plane 1 (Japanese)"
+ :short-name "JISX0213-1"
+ :iso-final-char ?O
+ :emacs-mule-id 151
+ :unify-map "JISX2131"
+ :code-space [33 126 33 126]
+ :code-offset #x14C000)
+
+(define-charset 'japanese-jisx0213-2
+ "JISX0213.2000 Plane 2 (Japanese)"
+ :short-name "JISX0213-2"
+ :iso-final-char ?P
+ :emacs-mule-id 254
+ :unify-map "JISX2132"
+ :code-space [33 126 33 126]
+ :code-offset #x150000)
+
+(define-charset 'japanese-jisx0213-a
+ "JISX0213.2004 adds these characters to JISX0213.2000."
+ :short-name "JISX0213A"
+ :dimension 2
+ :code-space [33 126 33 126]
+ :supplementary-p t
+ :map "JISX213A")
+
+(define-charset 'japanese-jisx0213.2004-1
+ "JISX0213.2004 Plane1 (Japanese)"
+ :short-name "JISX0213.2004-1"
+ :dimension 2
+ :code-space [33 126 33 126]
+ :iso-final-char ?Q
+ :superset '(japanese-jisx0213-a japanese-jisx0213-1))
+
+(define-charset 'katakana-sjis
+ "Katakana part of Shift-JIS"
+ :dimension 1
+ :code-space [#xA1 #xDF]
+ :subset '(jisx0201 #xA1 #xDF 0)
+ :supplementary-p t)
+
+(define-charset 'cp932-2-byte
+ "2-byte part of CP932"
+ :dimension 2
+ :map "CP932-2BYTE"
+ :code-space [#x40 #xFC #x81 #xFC]
+ :supplementary-p t)
+
+(define-charset 'cp932
+ "CP932 (Microsoft shift-jis)"
+ :code-space [#x00 #xFF #x00 #xFE]
+ :short-name "CP932"
+ :superset '(ascii katakana-sjis cp932-2-byte))
+
+(define-charset 'korean-ksc5601
+ "KSC5601 Korean Hangul and Hanja: ISO-IR-149"
+ :short-name "KSC5601"
+ :long-name "KSC5601 (Korean): ISO-IR-149"
+ :iso-final-char ?C
+ :emacs-mule-id 147
+ :code-space [33 126 33 126]
+ :code-offset #x279f94 ; ... #x27c217
+ :unify-map "KSC5601")
+
+(define-charset 'big5-hkscs
+ "Big5-HKSCS (Chinese traditional, Hong Kong supplement)"
+ :short-name "Big5"
+ :code-space [#x40 #xFE #xA1 #xFE]
+ :code-offset #x27c218 ; ... #x280839
+ :unify-map "BIG5-HKSCS")
+
+;; Fixme: Korean cp949/UHC
+
+(define-charset 'chinese-sisheng
+ "SiSheng characters for PinYin/ZhuYin"
+ :short-name "SiSheng"
+ :long-name "SiSheng (PinYin/ZhuYin)"
+ :iso-final-char ?0
+ :emacs-mule-id 160
+ :code-space [33 126]
+ :unify-map "MULE-sisheng"
+ :supplementary-p t
+ :code-offset #x200000)
+
+;; A subset of the 1989 version of IPA. It consists of the consonant
+;; signs used in English, French, German and Italian, and all vowels
+;; signs in the table. [says old MULE doc]
+(define-charset 'ipa
+ "IPA (International Phonetic Association)"
+ :short-name "IPA"
+ :iso-final-char ?0
+ :emacs-mule-id 161
+ :unify-map "MULE-ipa"
+ :code-space [32 127]
+ :supplementary-p t
+ :code-offset #x200080)
+
+(define-charset 'viscii
+ "VISCII1.1"
+ :short-name "VISCII"
+ :long-name "VISCII 1.1"
+ :code-space [0 255]
+ :map "VISCII")
+
+(define-charset 'vietnamese-viscii-lower
+ "VISCII1.1 lower-case"
+ :short-name "VISCII lower"
+ :long-name "VISCII lower-case"
+ :iso-final-char ?1
+ :emacs-mule-id 162
+ :code-space [32 127]
+ :code-offset #x200200
+ :supplementary-p t
+ :unify-map "MULE-lviscii")
+
+(define-charset 'vietnamese-viscii-upper
+ "VISCII1.1 upper-case"
+ :short-name "VISCII upper"
+ :long-name "VISCII upper-case"
+ :iso-final-char ?2
+ :emacs-mule-id 163
+ :code-space [32 127]
+ :code-offset #x200280
+ :supplementary-p t
+ :unify-map "MULE-uviscii")
+
+(define-charset 'vscii
+ "VSCII1.1 (TCVN-5712 VN1)"
+ :short-name "VSCII"
+ :code-space [0 255]
+ :map "VSCII")
+
+(define-charset-alias 'tcvn-5712 'vscii)
+
+;; Fixme: see note in tcvn.map about combining characters
+(define-charset 'vscii-2
+ "VSCII-2 (TCVN-5712 VN2)"
+ :code-space [0 255]
+ :map "VSCII-2")
+
+(define-charset 'koi8-r
+ "KOI8-R"
+ :short-name "KOI8-R"
+ :ascii-compatible-p t
+ :code-space [0 255]
+ :map "KOI8-R")
+
+(define-charset-alias 'koi8 'koi8-r)
+
+(define-charset 'alternativnyj
+ "ALTERNATIVNYJ"
+ :short-name "alternativnyj"
+ :ascii-compatible-p t
+ :code-space [0 255]
+ :map "ALTERNATIVNYJ")
+
+(define-charset 'cp866
+ "CP866"
+ :short-name "cp866"
+ :ascii-compatible-p t
+ :code-space [0 255]
+ :map "IBM866")
+(define-charset-alias 'ibm866 'cp866)
+
+(define-charset 'koi8-u
+ "KOI8-U"
+ :short-name "KOI8-U"
+ :ascii-compatible-p t
+ :code-space [0 255]
+ :map "KOI8-U")
+
+(define-charset 'koi8-t
+ "KOI8-T"
+ :short-name "KOI8-T"
+ :ascii-compatible-p t
+ :code-space [0 255]
+ :map "KOI8-T")
+
+(define-charset 'georgian-ps
+ "GEORGIAN-PS"
+ :short-name "GEORGIAN-PS"
+ :ascii-compatible-p t
+ :code-space [0 255]
+ :map "KA-PS")
+
+(define-charset 'georgian-academy
+ "GEORGIAN-ACADEMY"
+ :short-name "GEORGIAN-ACADEMY"
+ :ascii-compatible-p t
+ :code-space [0 255]
+ :map "KA-ACADEMY")
+
+(define-charset 'windows-1250
+ "WINDOWS-1250 (Central Europe)"
+ :short-name "WINDOWS-1250"
+ :ascii-compatible-p t
+ :code-space [0 255]
+ :map "CP1250")
+(define-charset-alias 'cp1250 'windows-1250)
+
+(define-charset 'windows-1251
+ "WINDOWS-1251 (Cyrillic)"
+ :short-name "WINDOWS-1251"
+ :ascii-compatible-p t
+ :code-space [0 255]
+ :map "CP1251")
+(define-charset-alias 'cp1251 'windows-1251)
+
+(define-charset 'windows-1252
+ "WINDOWS-1252 (Latin I)"
+ :short-name "WINDOWS-1252"
+ :ascii-compatible-p t
+ :code-space [0 255]
+ :map "CP1252")
+(define-charset-alias 'cp1252 'windows-1252)
+
+(define-charset 'windows-1253
+ "WINDOWS-1253 (Greek)"
+ :short-name "WINDOWS-1253"
+ :ascii-compatible-p t
+ :code-space [0 255]
+ :map "CP1253")
+(define-charset-alias 'cp1253 'windows-1253)
+
+(define-charset 'windows-1254
+ "WINDOWS-1254 (Turkish)"
+ :short-name "WINDOWS-1254"
+ :ascii-compatible-p t
+ :code-space [0 255]
+ :map "CP1254")
+(define-charset-alias 'cp1254 'windows-1254)
+
+(define-charset 'windows-1255
+ "WINDOWS-1255 (Hebrew)"
+ :short-name "WINDOWS-1255"
+ :ascii-compatible-p t
+ :code-space [0 255]
+ :map "CP1255")
+(define-charset-alias 'cp1255 'windows-1255)
+
+(define-charset 'windows-1256
+ "WINDOWS-1256 (Arabic)"
+ :short-name "WINDOWS-1256"
+ :ascii-compatible-p t
+ :code-space [0 255]
+ :map "CP1256")
+(define-charset-alias 'cp1256 'windows-1256)
+
+(define-charset 'windows-1257
+ "WINDOWS-1257 (Baltic)"
+ :short-name "WINDOWS-1257"
+ :ascii-compatible-p t
+ :code-space [0 255]
+ :map "CP1257")
+(define-charset-alias 'cp1257 'windows-1257)
+
+(define-charset 'windows-1258
+ "WINDOWS-1258 (Viet Nam)"
+ :short-name "WINDOWS-1258"
+ :ascii-compatible-p t
+ :code-space [0 255]
+ :map "CP1258")
+(define-charset-alias 'cp1258 'windows-1258)
+
+(define-charset 'next
+ "NEXT"
+ :short-name "NEXT"
+ :ascii-compatible-p t
+ :code-space [0 255]
+ :map "NEXTSTEP")
+
+(define-charset 'cp1125
+ "CP1125"
+ :short-name "CP1125"
+ :code-space [0 255]
+ :ascii-compatible-p t
+ :map "CP1125")
+(define-charset-alias 'ruscii 'cp1125)
+;; Original name for cp1125, says Serhii Hlodin <hlodin@lutsk.bank.gov.ua>
+(define-charset-alias 'cp866u 'cp1125)
+
+;; Fixme: C.f. iconv, http://czyborra.com/charsets/codepages.html
+;; shows this as not ASCII comptaible, with various graphics in
+;; 0x01-0x1F.
+(define-charset 'cp437
+ "CP437 (MS-DOS United States, Australia, New Zealand, South Africa)"
+ :short-name "CP437"
+ :code-space [0 255]
+ :ascii-compatible-p t
+ :map "IBM437")
+
+(define-charset 'cp720
+ "CP720 (Arabic)"
+ :short-name "CP720"
+ :code-space [0 255]
+ :ascii-compatible-p t
+ :map "CP720")
+
+(define-charset 'cp737
+ "CP737 (PC Greek)"
+ :short-name "CP737"
+ :code-space [0 255]
+ :ascii-compatible-p t
+ :map "CP737")
+
+(define-charset 'cp775
+ "CP775 (PC Baltic)"
+ :short-name "CP775"
+ :code-space [0 255]
+ :ascii-compatible-p t
+ :map "CP775")
+
+(define-charset 'cp851
+ "CP851 (Greek)"
+ :short-name "CP851"
+ :code-space [0 255]
+ :ascii-compatible-p t
+ :map "IBM851")
+
+(define-charset 'cp852
+ "CP852 (MS-DOS Latin-2)"
+ :short-name "CP852"
+ :code-space [0 255]
+ :ascii-compatible-p t
+ :map "IBM852")
+
+(define-charset 'cp855
+ "CP855 (IBM Cyrillic)"
+ :short-name "CP855"
+ :code-space [0 255]
+ :ascii-compatible-p t
+ :map "IBM855")
+
+(define-charset 'cp857
+ "CP857 (IBM Turkish)"
+ :short-name "CP857"
+ :code-space [0 255]
+ :ascii-compatible-p t
+ :map "IBM857")
+
+(define-charset 'cp858
+ "CP858 (Multilingual Latin I + Euro)"
+ :short-name "CP858"
+ :code-space [0 255]
+ :ascii-compatible-p t
+ :map "CP858")
+(define-charset-alias 'cp00858 'cp858) ; IANA has IBM00858/CP00858
+
+(define-charset 'cp860
+ "CP860 (MS-DOS Portuguese)"
+ :short-name "CP860"
+ :code-space [0 255]
+ :ascii-compatible-p t
+ :map "IBM860")
+
+(define-charset 'cp861
+ "CP861 (MS-DOS Icelandic)"
+ :short-name "CP861"
+ :code-space [0 255]
+ :ascii-compatible-p t
+ :map "IBM861")
+
+(define-charset 'cp862
+ "CP862 (PC Hebrew)"
+ :short-name "CP862"
+ :code-space [0 255]
+ :ascii-compatible-p t
+ :map "IBM862")
+
+(define-charset 'cp863
+ "CP863 (MS-DOS Canadian French)"
+ :short-name "CP863"
+ :code-space [0 255]
+ :ascii-compatible-p t
+ :map "IBM863")
+
+(define-charset 'cp864
+ "CP864 (PC Arabic)"
+ :short-name "CP864"
+ :code-space [0 255]
+ :ascii-compatible-p t
+ :map "IBM864")
+
+(define-charset 'cp865
+ "CP865 (MS-DOS Nordic)"
+ :short-name "CP865"
+ :code-space [0 255]
+ :ascii-compatible-p t
+ :map "IBM865")
+
+(define-charset 'cp869
+ "CP869 (IBM Modern Greek)"
+ :short-name "CP869"
+ :code-space [0 255]
+ :ascii-compatible-p t
+ :map "IBM869")
+
+(define-charset 'cp874
+ "CP874 (IBM Thai)"
+ :short-name "CP874"
+ :code-space [0 255]
+ :ascii-compatible-p t
+ :map "IBM874")
;; For Arabic, we need three different types of character sets.
;; Digits are of direction left-to-right and of width 1-column.
;; Others are of direction right-to-left and of width 1-column or
;; 2-column.
-(define-charset 164 'arabic-digit
- [1 94 1 0 ?2 0 "Arabic digit" "Arabic digit"
- "Arabic digits."])
-(define-charset 165 'arabic-1-column
- [1 94 1 1 ?3 0 "Arabic 1-col" "Arabic 1-column"
- "Arabic 1-column width glyphs."])
-
-;; ASCII with right-to-left direction.
-(define-charset 166 'ascii-right-to-left
- [1 94 1 1 ?B 0 "rev ASCII" "ASCII with right-to-left direction"
- "ASCII (left half of ISO 8859-1) with right-to-left direction."])
+(define-charset 'arabic-digit
+ "Arabic digit"
+ :short-name "Arabic digit"
+ :iso-final-char ?2
+ :emacs-mule-id 164
+ :supplementary-p t
+ :code-space [34 42]
+ :code-offset #x0600)
+
+(define-charset 'arabic-1-column
+ "Arabic 1-column"
+ :short-name "Arabic 1-col"
+ :long-name "Arabic 1-column"
+ :iso-final-char ?3
+ :emacs-mule-id 165
+ :supplementary-p t
+ :code-space [33 126]
+ :code-offset #x200100)
+
+(define-charset 'arabic-2-column
+ "Arabic 2-column"
+ :short-name "Arabic 2-col"
+ :long-name "Arabic 2-column"
+ :iso-final-char ?4
+ :emacs-mule-id 224
+ :supplementary-p t
+ :code-space [33 126]
+ :code-offset #x200180)
;; Lao script.
-;; ISO10646's 0x0E80..0x0EDF are mapped to 0x20..0x7F.
-(define-charset 167 'lao
- [1 94 1 0 ?1 0 "Lao" "Lao"
- "Lao characters (U+0E80..U+0EDF)."])
-
-;; CHARSET-IDs 168..223 are not used.
-
-;; 1-byte 2-column charsets. Valid range of CHARSET-ID is 224..239.
+;; Codes 0x21..0x7E are mapped to Unicode U+0E81..U+0EDF.
+;; Not all of them are defined unicodes.
+(define-charset 'lao
+ "Lao characters (ISO10646 0E81..0EDF)"
+ :short-name "Lao"
+ :iso-final-char ?1
+ :emacs-mule-id 167
+ :supplementary-p t
+ :code-space [33 126]
+ :code-offset #x0E81)
+
+(define-charset 'mule-lao
+ "Lao characters (ISO10646 0E81..0EDF)"
+ :short-name "Lao"
+ :code-space [0 255]
+ :supplementary-p t
+ :superset '(ascii eight-bit-control (lao . 128)))
-(define-charset 224 'arabic-2-column
- [1 94 2 1 ?4 0 "Arabic 2-col" "Arabic 2-column"
- "Arabic 2-column glyphs."])
;; Indian scripts. Symbolic charset for data exchange. Glyphs are
;; not assigned. They are automatically converted to each Indian
;; script which IS-13194 supports.
-(define-charset 225 'indian-is13194
- [1 94 2 0 ?5 1 "IS 13194" "Indian IS 13194"
- "Generic Indian character set for data exchange with IS 13194."])
-
-;; CHARSET-IDs 226..239 are not used.
-
-(define-charset 240 'indian-glyph
- [2 96 1 0 ?4 0 "Indian glyph" "Indian glyph"
- "Glyphs for Indian characters."])
-;; 240 used to be [2 94 1 0 ?6 0 "Indian 1-col" "Indian 1 Column"]
-
-;; 2-byte 1-column charsets. Valid range of CHARSET-ID is 240..244.
+(define-charset 'indian-is13194
+ "Generic Indian charset for data exchange with IS 13194"
+ :short-name "IS 13194"
+ :long-name "Indian IS 13194"
+ :iso-final-char ?5
+ :emacs-mule-id 225
+ :supplementary-p t
+ :code-space [33 126]
+ :code-offset #x180000)
+
+(let ((code-offset #x180100))
+ (dolist (script '(devanagari sanskrit bengali tamil telugu assamese
+ oriya kannada malayalam gujarati punjabi))
+ (define-charset (intern (format "%s-cdac" script))
+ (format "Glyphs of %s script for CDAC font. Subset of `indian-glyph'."
+ (capitalize (symbol-name script)))
+ :short-name (format "CDAC %s glyphs" (capitalize (symbol-name script)))
+ :supplementary-p t
+ :code-space [0 255]
+ :code-offset code-offset)
+ (setq code-offset (+ code-offset #x100)))
+
+ (dolist (script '(devanagari bengali punjabi gujarati
+ oriya tamil telugu kannada malayalam))
+ (define-charset (intern (format "%s-akruti" script))
+ (format "Glyphs of %s script for AKRUTI font. Subset of `indian-glyph'."
+ (capitalize (symbol-name script)))
+ :short-name (format "AKRUTI %s glyphs" (capitalize (symbol-name script)))
+ :supplementary-p t
+ :code-space [0 255]
+ :code-offset code-offset)
+ (setq code-offset (+ code-offset #x100))))
+
+(define-charset 'indian-glyph
+ "Glyphs for Indian characters."
+ :short-name "Indian glyph"
+ :iso-final-char ?4
+ :emacs-mule-id 240
+ :supplementary-p t
+ :code-space [32 127 32 127]
+ :code-offset #x180100)
;; Actual Glyph for 1-column width.
-(define-charset 241 'tibetan-1-column
- [2 94 1 0 ?8 0 "Tibetan 1-col" "Tibetan 1 column"
- "Tibetan 1-column glyphs."])
-
-;; Subsets of Unicode.
-
-(define-charset 242 'mule-unicode-2500-33ff
- [2 96 1 0 ?2 0 "Unicode subset 2" "Unicode subset (U+2500..U+33FF)"
- "Unicode characters of the range U+2500..U+33FF."])
-
-(define-charset 243 'mule-unicode-e000-ffff
- [2 96 1 0 ?3 0 "Unicode subset 3" "Unicode subset (U+E000+FFFF)"
- "Unicode characters of the range U+E000..U+FFFF."])
-
-(define-charset 244 'mule-unicode-0100-24ff
- [2 96 1 0 ?1 0 "Unicode subset" "Unicode subset (U+0100..U+24FF)"
- "Unicode characters of the range U+0100..U+24FF."])
-
-;; 2-byte 2-column charsets. Valid range of CHARSET-ID is 245..254.
-
-;; Ethiopic characters (Amharic and Tigrigna).
-(define-charset 245 'ethiopic
- [2 94 2 0 ?3 0 "Ethiopic" "Ethiopic characters"
- "Ethiopic characters."])
-
-;; Chinese CNS11643 Plane3 thru Plane7. Although these are official
-;; character sets, the use is rare and don't have to be treated
-;; space-efficiently in the buffer.
-(define-charset 246 'chinese-cns11643-3
- [2 94 2 0 ?I 0 "CNS11643-3" "CNS11643-3 (Chinese traditional): ISO-IR-183"
- "CNS11643 Plane 3 Chinese Traditional: ISO-IR-183."])
-(define-charset 247 'chinese-cns11643-4
- [2 94 2 0 ?J 0 "CNS11643-4" "CNS11643-4 (Chinese traditional): ISO-IR-184"
- "CNS11643 Plane 4 Chinese Traditional: ISO-IR-184."])
-(define-charset 248 'chinese-cns11643-5
- [2 94 2 0 ?K 0 "CNS11643-5" "CNS11643-5 (Chinese traditional): ISO-IR-185"
- "CNS11643 Plane 5 Chinese Traditional: ISO-IR-185."])
-(define-charset 249 'chinese-cns11643-6
- [2 94 2 0 ?L 0 "CNS11643-6" "CNS11643-6 (Chinese traditional): ISO-IR-186"
- "CNS11643 Plane 6 Chinese Traditional: ISO-IR-186."])
-(define-charset 250 'chinese-cns11643-7
- [2 94 2 0 ?M 0 "CNS11643-7" "CNS11643-7 (Chinese traditional): ISO-IR-187"
- "CNS11643 Plane 7 Chinese Traditional: ISO-IR-187."])
+(define-charset 'indian-1-column
+ "Indian charset for 1-column width glyphs."
+ :short-name "Indian 1-col"
+ :long-name "Indian 1 Column"
+ :iso-final-char ?6
+ :emacs-mule-id 251
+ :supplementary-p t
+ :code-space [33 126 33 126]
+ :code-offset #x184000)
;; Actual Glyph for 2-column width.
-(define-charset 251 'indian-2-column
- [2 94 2 0 ?5 0 "Indian 2-col" "Indian 2 Column"
- "Indian character set for 2-column width glyphs."])
- ;; old indian-1-column characters will be translated to indian-2-column.
-(declare-equiv-charset 2 94 ?6 'indian-2-column)
+(define-charset 'indian-2-column
+ "Indian charset for 2-column width glyphs."
+ :short-name "Indian 2-col"
+ :long-name "Indian 2 Column"
+ :iso-final-char ?5
+ :emacs-mule-id 251
+ :supplementary-p t
+ :code-space [33 126 33 126]
+ :code-offset #x184000)
+
+(define-charset 'tibetan
+ "Tibetan characters"
+ :iso-final-char ?7
+ :short-name "Tibetan 2-col"
+ :long-name "Tibetan 2 column"
+ :iso-final-char ?7
+ :emacs-mule-id 252
+ :unify-map "MULE-tibetan"
+ :supplementary-p t
+ :code-space [33 126 33 37]
+ :code-offset #x190000)
+
+(define-charset 'tibetan-1-column
+ "Tibetan 1 column glyph"
+ :short-name "Tibetan 1-col"
+ :long-name "Tibetan 1 column"
+ :iso-final-char ?8
+ :emacs-mule-id 241
+ :supplementary-p t
+ :code-space [33 126 33 37]
+ :code-offset #x190000)
-;; Tibetan script.
-(define-charset 252 'tibetan
- [2 94 2 0 ?7 0 "Tibetan 2-col" "Tibetan 2 column"
- "Tibetan 2-column width glyphs."])
-
-;; CHARSET-ID 253 is not used.
-
-;; JISX0213 Plane 2
-(define-charset 254 'japanese-jisx0213-2
- [2 94 2 0 ?P 0 "JISX0213-2" "JISX0213-2"
- "JISX0213 Plane 2 (Japanese)."])
-
-;; Tell C code charset ID's of several charsets.
-(setup-special-charsets)
+;; Subsets of Unicode.
+(define-charset 'mule-unicode-2500-33ff
+ "Unicode characters of the range U+2500..U+33FF."
+ :short-name "Unicode subset 2"
+ :long-name "Unicode subset (U+2500..U+33FF)"
+ :iso-final-char ?2
+ :emacs-mule-id 242
+ :supplementary-p t
+ :code-space [#x20 #x7f #x20 #x47]
+ :code-offset #x2500)
+
+(define-charset 'mule-unicode-e000-ffff
+ "Unicode characters of the range U+E000..U+FFFF."
+ :short-name "Unicode subset 3"
+ :long-name "Unicode subset (U+E000+FFFF)"
+ :iso-final-char ?3
+ :emacs-mule-id 243
+ :supplementary-p t
+ :code-space [#x20 #x7F #x20 #x75]
+ :code-offset #xE000
+ :max-code 30015) ; U+FFFF
+
+(define-charset 'mule-unicode-0100-24ff
+ "Unicode characters of the range U+0100..U+24FF."
+ :short-name "Unicode subset"
+ :long-name "Unicode subset (U+0100..U+24FF)"
+ :iso-final-char ?1
+ :emacs-mule-id 244
+ :supplementary-p t
+ :code-space [#x20 #x7F #x20 #x7F]
+ :code-offset #x100)
+
+(define-charset 'unicode-bmp
+ "Unicode Basic Multilingual Plane (U+0000..U+FFFF)"
+ :short-name "Unicode BMP"
+ :code-space [0 255 0 255]
+ :code-offset 0)
+
+(define-charset 'unicode-smp
+ "Unicode Supplementary Multilingual Plane (U+10000..U+1FFFF)"
+ :short-name "Unicode SMP "
+ :code-space [0 255 0 255]
+ :code-offset #x10000)
+
+(define-charset 'unicode-sip
+ "Unicode Supplementary Ideographic Plane (U+20000..U+2FFFF)"
+ :short-name "Unicode SIP"
+ :code-space [0 255 0 255]
+ :code-offset #x20000)
+
+(define-charset 'unicode-ssp
+ "Unicode Supplementary Special-purpose Plane (U+E0000..U+EFFFF)"
+ :short-name "Unicode SSP"
+ :code-space [0 255 0 255]
+ :code-offset #xE0000)
+
+(define-charset 'ethiopic
+ "Ethiopic characters for Amharic and Tigrigna."
+ :short-name "Ethiopic"
+ :long-name "Ethiopic characters"
+ :iso-final-char ?3
+ :emacs-mule-id 245
+ :supplementary-p t
+ :unify-map "MULE-ethiopic"
+ :code-space [33 126 33 126]
+ :code-offset #x1A0000)
+
+(define-charset 'mac-roman
+ "Mac Roman charset"
+ :short-name "Mac Roman"
+ :ascii-compatible-p t
+ :code-space [0 255]
+ :map "MACINTOSH")
+
+;; Fixme: modern EBCDIC variants, e.g. IBM00924?
+(define-charset 'ebcdic-us
+ "US version of EBCDIC"
+ :short-name "EBCDIC-US"
+ :code-space [0 255]
+ :mime-charset 'ebcdic-us
+ :map "EBCDICUS")
+
+(define-charset 'ebcdic-uk
+ "UK version of EBCDIC"
+ :short-name "EBCDIC-UK"
+ :code-space [0 255]
+ :mime-charset 'ebcdic-uk
+ :map "EBCDICUK")
+
+(define-charset 'ibm1047
+ ;; Says groff:
+ "IBM1047, `EBCDIC Latin 1/Open Systems' used by OS/390 Unix."
+ :short-name "IBM1047"
+ :code-space [0 255]
+ :mime-charset 'ibm1047
+ :map "IBM1047")
+(define-charset-alias 'cp1047 'ibm1047)
+
+(define-charset 'hp-roman8
+ "Encoding used by Hewlet-Packard printer software"
+ :short-name "HP-ROMAN8"
+ :ascii-compatible-p t
+ :code-space [0 255]
+ :map "HP-ROMAN8")
+
+;; To make a coding system with this, a pre-write-conversion should
+;; account for the commented-out multi-valued code points in
+;; stdenc.map.
+(define-charset 'adobe-standard-encoding
+ "Adobe `standard encoding' used in PostScript"
+ :short-name "ADOBE-STANDARD-ENCODING"
+ :code-space [#x20 255]
+ :map "stdenc")
+
+(define-charset 'symbol
+ "Adobe symbol encoding used in PostScript"
+ :short-name "ADOBE-SYMBOL"
+ :code-space [#x20 255]
+ :map "symbol")
+
+(define-charset 'ibm850
+ "DOS codepage 850 (Latin-1)"
+ :short-name "IBM850"
+ :ascii-compatible-p t
+ :code-space [0 255]
+ :map "IBM850")
+(define-charset-alias 'cp850 'ibm850)
+
+(define-charset 'mik
+ "Bulgarian DOS codepage"
+ :short-name "MIK"
+ :ascii-compatible-p t
+ :code-space [0 255]
+ :map "MIK")
+
+(define-charset 'ptcp154
+ "`Paratype' codepage (Asian Cyrillic)"
+ :short-name "PT154"
+ :ascii-compatible-p t
+ :code-space [0 255]
+ :mime-charset 'pt154
+ :map "PTCP154")
+(define-charset-alias 'pt154 'ptcp154)
+(define-charset-alias 'cp154 'ptcp154)
+
+(define-charset 'gb18030-2-byte
+ "GB18030 2-byte (0x814E..0xFEFE)"
+ :code-space [#x40 #xFE #x81 #xFE]
+ :supplementary-p t
+ :map "GB180302")
+
+(define-charset 'gb18030-4-byte-bmp
+ "GB18030 4-byte for BMP (0x81308130-0x8431A439)"
+ :code-space [#x30 #x39 #x81 #xFE #x30 #x39 #x81 #x84]
+ :supplementary-p t
+ :map "GB180304")
+
+(define-charset 'gb18030-4-byte-smp
+ "GB18030 4-byte for SMP (0x90308130-0xE3329A35)"
+ :code-space [#x30 #x39 #x81 #xFE #x30 #x39 #x90 #xE3]
+ :min-code '(#x9030 . #x8130)
+ :max-code '(#xE332 . #x9A35)
+ :supplementary-p t
+ :code-offset #x10000)
+
+(define-charset 'gb18030-4-byte-ext-1
+ "GB18030 4-byte (0x8431A530-0x8F39FE39)"
+ :code-space [#x30 #x39 #x81 #xFE #x30 #x39 #x84 #x8F]
+ :min-code '(#x8431 . #xA530)
+ :max-code '(#x8F39 . #xFE39)
+ :supplementary-p t
+ :code-offset #x200000 ; ... #x22484B
+ )
+
+(define-charset 'gb18030-4-byte-ext-2
+ "GB18030 4-byte (0xE3329A36-0xFE39FE39)"
+ :code-space [#x30 #x39 #x81 #xFE #x30 #x39 #xE3 #xFE]
+ :min-code '(#xE332 . #x9A36)
+ :max-code '(#xFE39 . #xFE39)
+ :supplementary-p t
+ :code-offset #x22484C ; ... #x279f93
+ )
+
+(define-charset 'gb18030
+ "GB18030"
+ :code-space [#x00 #xFF #x00 #xFE #x00 #xFE #x00 #xFE]
+ :min-code 0
+ :max-code '(#xFE39 . #xFE39)
+ :superset '(ascii gb18030-2-byte
+ gb18030-4-byte-bmp gb18030-4-byte-smp
+ gb18030-4-byte-ext-1 gb18030-4-byte-ext-2))
+
+(define-charset 'chinese-cns11643-15
+ "CNS11643 Plane 15 Chinese Traditional"
+ :short-name "CNS11643-15"
+ :long-name "CNS11643-15 (Chinese traditional)"
+ :code-space [33 126 33 126]
+ :code-offset #x27A000)
+
+(unify-charset 'chinese-gb2312)
+(unify-charset 'chinese-gbk)
+(unify-charset 'chinese-cns11643-1)
+(unify-charset 'chinese-cns11643-2)
+(unify-charset 'chinese-cns11643-3)
+(unify-charset 'chinese-cns11643-4)
+(unify-charset 'chinese-cns11643-5)
+(unify-charset 'chinese-cns11643-6)
+(unify-charset 'chinese-cns11643-7)
+(unify-charset 'big5)
+(unify-charset 'chinese-big5-1)
+(unify-charset 'chinese-big5-2)
+(unify-charset 'big5-hkscs)
+(unify-charset 'korean-ksc5601)
+(unify-charset 'vietnamese-viscii-lower)
+(unify-charset 'vietnamese-viscii-upper)
+(unify-charset 'chinese-sisheng)
+(unify-charset 'ipa)
+(unify-charset 'tibetan)
+(unify-charset 'ethiopic)
+(unify-charset 'japanese-jisx0208-1978)
+(unify-charset 'japanese-jisx0208)
+(unify-charset 'japanese-jisx0212)
+(unify-charset 'japanese-jisx0213-1)
+(unify-charset 'japanese-jisx0213-2)
\f
;; These are tables for translating characters on decoding and
;; encoding.
-(define-translation-table
- 'oldjis-newjis-jisroman-ascii
- (list (cons (make-char 'japanese-jisx0208-1978)
- (make-char 'japanese-jisx0208))
- (cons (make-char 'latin-jisx0201) (make-char 'ascii))))
-(aset (get 'oldjis-newjis-jisroman-ascii 'translation-table)
- (make-char 'latin-jisx0201 92) (make-char 'latin-jisx0201 92))
-(aset (get 'oldjis-newjis-jisroman-ascii 'translation-table)
- (make-char 'latin-jisx0201 126) (make-char 'latin-jisx0201 126))
-
-(setq standard-translation-table-for-decode
- (get 'oldjis-newjis-jisroman-ascii 'translation-table))
+;; Fixme: these aren't used now -- should they be?
+(setq standard-translation-table-for-decode nil)
(setq standard-translation-table-for-encode nil)
\f
;;; Make fundamental coding systems.
-;; Miscellaneous coding systems which can't be made by
-;; `make-coding-system'.
-
-(put 'no-conversion 'coding-system
- (vector nil ?= "Do no conversion.
-
-When you visit a file with this coding, the file is read into a
-unibyte buffer as is, thus each byte of a file is treated as a
-character."
- (list 'coding-category 'coding-category-binary
- 'alias-coding-systems '(no-conversion)
- 'safe-charsets t 'safe-chars t)
- nil))
-(put 'no-conversion 'eol-type 0)
-(put 'coding-category-binary 'coding-systems '(no-conversion))
-(setq coding-system-list '(no-conversion))
-(setq coding-system-alist '(("no-conversion")))
-(define-coding-system-internal 'no-conversion)
+;; The coding system `no-conversion' and `undecided' are already
+;; defined in coding.c as below:
+;;
+;; (define-coding-system 'no-conversion
+;; "..."
+;; :coding-type 'raw-text
+;; ...)
+;; (define-coding-system 'undecided
+;; "..."
+;; :coding-type 'undecided
+;; ...)
(define-coding-system-alias 'binary 'no-conversion)
-
-(put 'undecided 'coding-system
- (vector t ?- "No conversion on encoding, automatic conversion on decoding"
- (list 'alias-coding-systems '(undecided)
- 'safe-charsets '(ascii))
- nil))
-(setq coding-system-list (cons 'undecided coding-system-list))
-(setq coding-system-alist (cons '("undecided") coding-system-alist))
-(put 'undecided 'eol-type
- (make-subsidiary-coding-system 'undecided))
-
(define-coding-system-alias 'unix 'undecided-unix)
(define-coding-system-alias 'dos 'undecided-dos)
(define-coding-system-alias 'mac 'undecided-mac)
-;; Coding systems not specific to each language environment.
-
-(make-coding-system
- 'emacs-mule 0 ?=
- "Emacs internal format used in buffer and string.
-
-Encoding text with this coding system produces the actual byte
-sequence of the text in buffers and strings. An exception is made for
-eight-bit-control characters. Each of them is encoded into a single
-byte."
- nil
- '((safe-charsets . t)
- (composition . t)))
-
-(make-coding-system
- 'raw-text 5 ?t
- "Raw text, which means text contains random 8-bit codes.
+(define-coding-system 'raw-text
+ "Raw text, which means text contains random 8-bit codes.
Encoding text with this coding system produces the actual byte
sequence of the text in buffers and strings. An exception is made for
eight-bit-control characters. Each of them is encoded into a single
When you visit a file with this coding, the file is read into a
unibyte buffer as is (except for EOL format), thus each byte of a file
is treated as a character."
- nil
- '((safe-charsets . t)))
-
-(make-coding-system
- 'iso-2022-7bit 2 ?J
- "ISO 2022 based 7-bit encoding using only G0"
- '((ascii t) nil nil nil
- short ascii-eol ascii-cntl seven)
- '((safe-charsets . t)
- (composition . t)))
-
-(make-coding-system
- 'iso-2022-7bit-ss2 2 ?$
- "ISO 2022 based 7-bit encoding using SS2 for 96-charset"
- '((ascii t) nil t nil
- short ascii-eol ascii-cntl seven nil single-shift)
- '((safe-charsets . t)
- (composition . t)))
-
-(make-coding-system
- 'iso-2022-7bit-lock 2 ?&
- "ISO-2022 coding system using Locking-Shift for 96-charset"
- '((ascii t) t nil nil
- nil ascii-eol ascii-cntl seven locking-shift)
- '((safe-charsets . t)
- (composition . t)))
+ :coding-type 'raw-text
+ :for-unibyte t
+ :mnemonic ?t)
+
+(define-coding-system 'no-conversion-multibyte
+ "Like `no-conversion' but don't read a file into a unibyte buffer."
+ :coding-type 'raw-text
+ :eol-type 'unix
+ :mnemonic ?=)
+
+(define-coding-system 'iso-latin-1
+ "ISO 2022 based 8-bit encoding for Latin-1 (MIME:ISO-8859-1)."
+ :coding-type 'charset
+ :mnemonic ?1
+ :charset-list '(iso-8859-1)
+ :mime-charset 'iso-8859-1)
-(define-coding-system-alias 'iso-2022-int-1 'iso-2022-7bit-lock)
+(define-coding-system-alias 'iso-8859-1 'iso-latin-1)
+(define-coding-system-alias 'latin-1 'iso-latin-1)
-(make-coding-system
- 'iso-2022-7bit-lock-ss2 2 ?i
- "Mixture of ISO-2022-JP, ISO-2022-KR, and ISO-2022-CN"
- '((ascii t)
- (nil korean-ksc5601 chinese-gb2312 chinese-cns11643-1 t)
- (nil chinese-cns11643-2)
- (nil chinese-cns11643-3 chinese-cns11643-4 chinese-cns11643-5
- chinese-cns11643-6 chinese-cns11643-7)
- short ascii-eol ascii-cntl seven locking-shift single-shift nil nil nil
- init-bol)
- '((safe-charsets ascii japanese-jisx0208 japanese-jisx0208-1978 latin-jisx0201
- korean-ksc5601 chinese-gb2312 chinese-cns11643-1
- chinese-cns11643-2 chinese-cns11643-3 chinese-cns11643-4
- chinese-cns11643-5 chinese-cns11643-6 chinese-cns11643-7)
- (composition . t)))
+;; Coding systems not specific to each language environment.
-(define-coding-system-alias 'iso-2022-cjk 'iso-2022-7bit-lock-ss2)
+(define-coding-system 'emacs-mule
+ "Emacs 21 internal format used in buffer and string."
+ :coding-type 'emacs-mule
+ :charset-list 'emacs-mule
+ :mnemonic ?M)
+
+(define-coding-system 'utf-8
+ "UTF-8."
+ :coding-type 'utf-8
+ :mnemonic ?U
+ :charset-list '(unicode)
+ :mime-charset 'utf-8)
+
+(define-coding-system-alias 'mule-utf-8 'utf-8)
+
+(define-coding-system 'utf-8-emacs
+ "Support for all Emacs characters (including non-Unicode characters)."
+ :coding-type 'utf-8
+ :mnemonic ?U
+ :charset-list '(emacs))
+
+(define-coding-system 'utf-16le
+ "UTF-16LE (little endian, no signature (BOM))."
+ :coding-type 'utf-16
+ :mnemonic ?U
+ :charset-list '(unicode)
+ :endian 'little
+ :mime-text-unsuitable t
+ :mime-charset 'utf-16le)
+
+(define-coding-system 'utf-16be
+ "UTF-16BE (big endian, no signature (BOM))."
+ :coding-type 'utf-16
+ :mnemonic ?U
+ :charset-list '(unicode)
+ :endian 'big
+ :mime-text-unsuitable t
+ :mime-charset 'utf-16be)
+
+(define-coding-system 'utf-16le-with-signature
+ "UTF-16 (little endian, with signature (BOM))."
+ :coding-type 'utf-16
+ :mnemonic ?U
+ :charset-list '(unicode)
+ :bom t
+ :endian 'little
+ :mime-text-unsuitable t
+ :mime-charset 'utf-16)
+
+(define-coding-system 'utf-16be-with-signature
+ "UTF-16 (big endian, with signature)."
+ :coding-type 'utf-16
+ :mnemonic ?U
+ :charset-list '(unicode)
+ :bom t
+ :endian 'big
+ :mime-text-unsuitable t
+ :mime-charset 'utf-16)
+
+(define-coding-system 'utf-16
+ "UTF-16 (detect endian on decoding, use big endian on encoding with BOM)."
+ :coding-type 'utf-16
+ :mnemonic ?U
+ :charset-list '(unicode)
+ :bom '(utf-16le-with-signature . utf-16be-with-signature)
+ :endian 'big
+ :mime-text-unsuitable t
+ :mime-charset 'utf-16)
+
+;; Backwards compatibility (old names, also used by Mule-UCS). We
+;; prefer the MIME names.
+(define-coding-system-alias 'utf-16-le 'utf-16le-with-signature)
+(define-coding-system-alias 'utf-16-be 'utf-16be-with-signature)
+
+
+(define-coding-system 'iso-2022-7bit
+ "ISO 2022 based 7-bit encoding using only G0."
+ :coding-type 'iso-2022
+ :mnemonic ?J
+ :charset-list 'iso-2022
+ :designation [(ascii t) nil nil nil]
+ :flags '(short ascii-at-eol ascii-at-cntl 7-bit designation composition))
+
+(define-coding-system 'iso-2022-7bit-ss2
+ "ISO 2022 based 7-bit encoding using SS2 for 96-charset."
+ :coding-type 'iso-2022
+ :mnemonic ?$
+ :charset-list 'iso-2022
+ :designation [(ascii 94) nil (nil 96) nil]
+ :flags '(short ascii-at-eol ascii-at-cntl 7-bit
+ designation single-shift composition))
+
+(define-coding-system 'iso-2022-7bit-lock
+ "ISO-2022 coding system using Locking-Shift for 96-charset."
+ :coding-type 'iso-2022
+ :mnemonic ?&
+ :charset-list 'iso-2022
+ :designation [(ascii 94) (nil 96) nil nil]
+ :flags '(ascii-at-eol ascii-at-cntl 7-bit
+ designation locking-shift composition))
+
+(define-coding-system-alias 'iso-2022-int-1 'iso-2022-7bit-lock)
-(make-coding-system
- 'iso-2022-8bit-ss2 2 ?@
- "ISO 2022 based 8-bit encoding using SS2 for 96-charset"
- '((ascii t) nil t nil
- nil ascii-eol ascii-cntl nil nil single-shift)
- '((safe-charsets . t)
- (composition . t)))
+(define-coding-system 'iso-2022-7bit-lock-ss2
+ "Mixture of ISO-2022-JP, ISO-2022-KR, and ISO-2022-CN."
+ :coding-type 'iso-2022
+ :mnemonic ?i
+ :charset-list '(ascii
+ japanese-jisx0208 japanese-jisx0208-1978 latin-jisx0201
+ korean-ksc5601
+ chinese-gb2312
+ chinese-cns11643-1 chinese-cns11643-2 chinese-cns11643-3
+ chinese-cns11643-4 chinese-cns11643-5 chinese-cns11643-6
+ chinese-cns11643-7)
+ :designation [(ascii 94)
+ (nil korean-ksc5601 chinese-gb2312 chinese-cns11643-1 96)
+ (nil chinese-cns11643-2)
+ (nil chinese-cns11643-3 chinese-cns11643-4 chinese-cns11643-5
+ chinese-cns11643-6 chinese-cns11643-7)]
+ :flags '(short ascii-at-eol ascii-at-cntl 7-bit locking-shift
+ single-shift init-bol))
-(make-coding-system
- 'compound-text 2 ?x
- "Compound text based generic encoding for decoding unknown messages.
+(define-coding-system-alias 'iso-2022-cjk 'iso-2022-7bit-lock-ss2)
-This coding system does not support extended segments."
- '((ascii t) (latin-iso8859-1 katakana-jisx0201 t) t t
- nil ascii-eol ascii-cntl nil locking-shift single-shift nil nil nil
- init-bol nil nil)
- '((safe-charsets . t)
- (mime-charset . x-ctext)
- (composition . t)))
+(define-coding-system 'iso-2022-8bit-ss2
+ "ISO 2022 based 8-bit encoding using SS2 for 96-charset."
+ :coding-type 'iso-2022
+ :mnemonic ?@
+ :charset-list 'iso-2022
+ :designation [(ascii 94) nil (nil 96) nil]
+ :flags '(ascii-at-eol ascii-at-cntl designation single-shift composition))
+
+(define-coding-system 'compound-text
+ "Compound text based generic encoding for decoding unknown messages.
+
+This coding system does not support extended segments of CTEXT."
+ :coding-type 'iso-2022
+ :mnemonic ?x
+ :charset-list 'iso-2022
+ :designation [(ascii 94) (latin-iso8859-1 katakana-jisx0201 96) nil nil]
+ :flags '(ascii-at-eol ascii-at-cntl long-form
+ designation locking-shift single-shift composition)
+ ;; Fixme: this isn't a valid MIME charset and has to be
+ ;; special-cased elsewhere -- fx
+ :mime-charset 'x-ctext)
(define-coding-system-alias 'x-ctext 'compound-text)
(define-coding-system-alias 'ctext 'compound-text)
;; compound-text-with-extensions, see mule.el. Note that this should
;; not have a mime-charset property, to prevent it from showing up
;; close to the beginning of coding systems ordered by priority.
-(make-coding-system
- 'ctext-no-compositions 2 ?x
+(define-coding-system 'ctext-no-compositions
"Compound text based generic encoding for decoding unknown messages.
Like `compound-text', but does not produce escape sequences for compositions."
- '((ascii t) (latin-iso8859-1 katakana-jisx0201 t) t t
- nil ascii-eol ascii-cntl nil locking-shift single-shift nil nil nil
- init-bol nil nil)
- '((safe-charsets . t)))
+ :coding-type 'iso-2022
+ :mnemonic ?x
+ :charset-list 'iso-2022
+ :designation [(ascii 94) (latin-iso8859-1 katakana-jisx0201 96) nil nil]
+ :flags '(ascii-at-eol ascii-at-cntl
+ designation locking-shift single-shift))
-(make-coding-system
- 'compound-text-with-extensions 2 ?x
- "Compound text encoding with extended segments.
+(define-coding-system 'compound-text-with-extensions
+ "Compound text encoding with ICCCM Extended Segment extensions.
See the variable `ctext-non-standard-encodings-alist' for the
detail about how extended segments are handled.
This coding system should be used only for X selections. It is inappropriate
for decoding and encoding files, process I/O, etc."
- '((ascii t) (latin-iso8859-1 katakana-jisx0201 t) t t
- nil ascii-eol ascii-cntl)
- '((post-read-conversion . ctext-post-read-conversion)
- (pre-write-conversion . ctext-pre-write-conversion)))
+ :coding-type 'iso-2022
+ :mnemonic ?x
+ :charset-list 'iso-2022
+ :designation [(ascii 94) (latin-iso8859-1 katakana-jisx0201 96) nil nil]
+ :flags '(ascii-at-eol ascii-at-cntl long-form
+ designation locking-shift single-shift)
+ :post-read-conversion 'ctext-post-read-conversion
+ :pre-write-conversion 'ctext-pre-write-conversion)
(define-coding-system-alias
'x-ctext-with-extensions 'compound-text-with-extensions)
(define-coding-system-alias
'ctext-with-extensions 'compound-text-with-extensions)
-(make-coding-system
- 'iso-safe 2 ?-
- "Encode ASCII asis and encode non-ASCII characters to `?'."
- '(ascii nil nil nil
- nil ascii-eol ascii-cntl nil nil nil nil nil nil nil nil t)
- '((safe-charsets ascii)))
-
-(define-coding-system-alias
- 'us-ascii 'iso-safe)
-
-(make-coding-system
- 'iso-latin-1 2 ?1
- "ISO 2022 based 8-bit encoding for Latin-1 (MIME:ISO-8859-1)."
- '(ascii latin-iso8859-1 nil nil
- nil nil nil nil nil nil nil nil nil nil nil t t)
- '((safe-charsets ascii latin-iso8859-1)
- (mime-charset . iso-8859-1)))
-
-(define-coding-system-alias 'iso-8859-1 'iso-latin-1)
-(define-coding-system-alias 'latin-1 'iso-latin-1)
-
-;; Use iso-safe for terminal output if some other coding system is not
+(define-coding-system 'us-ascii
+ "Encode ASCII as-is and encode non-ASCII characters to `?'."
+ :coding-type 'charset
+ :mnemonic ?-
+ :charset-list '(ascii)
+ :default-char ??
+ :mime-charset 'us-ascii)
+
+(define-coding-system-alias 'iso-safe 'us-ascii)
+
+(define-coding-system 'utf-7
+ "UTF-7 encoding of Unicode (RFC 2152)."
+ :coding-type 'utf-8
+ :mnemonic ?U
+ :mime-charset 'utf-7
+ :charset-list '(unicode)
+ :pre-write-conversion 'utf-7-pre-write-conversion
+ :post-read-conversion 'utf-7-post-read-conversion)
+
+(define-coding-system 'utf-7-imap
+ "UTF-7 encoding of Unicode, IMAP version (RFC 2060)"
+ :coding-type 'utf-8
+ :mnemonic ?u
+ :charset-list '(unicode)
+ :pre-write-conversion 'utf-7-imap-pre-write-conversion
+ :post-read-conversion 'utf-7-imap-post-read-conversion)
+
+;; Use us-ascii for terminal output if some other coding system is not
;; specified explicitly.
-(set-safe-terminal-coding-system-internal 'iso-safe)
+(set-safe-terminal-coding-system-internal 'us-ascii)
;; The other coding-systems are defined in each language specific
-;; section of languages.el.
+;; files under lisp/language.
;; Normally, set coding system to `undecided' before reading a file.
;; Compiled Emacs Lisp files (*.elc) are not decoded at all,
;; Tar files are not decoded at all, but we treat them as raw bytes.
(setq file-coding-system-alist
- '(("\\.elc\\'" . (emacs-mule . emacs-mule))
+ '(("\\.elc\\'" . utf-8-emacs)
("\\.utf\\(-8\\)?\\'" . utf-8)
+ ;; This is the defined default for XML documents. It may be
+ ;; overridden by a charset specification in the header. That
+ ;; should be grokked by the auto-coding mechanism, but rms
+ ;; vetoed that. -- fx
+ ("\\.xml\\'" . utf-8)
;; We use raw-text for reading loaddefs.el so that if it
;; happens to have DOS or Mac EOLs, they are converted to
;; newlines. This is required to make the special treatment
;; values are set by the command `set-language-environment' for each
;; language environment.
-(setq coding-category-emacs-mule 'emacs-mule
- coding-category-sjis 'japanese-shift-jis
- coding-category-iso-7 'iso-2022-7bit
- coding-category-iso-7-tight 'iso-2022-jp
- coding-category-iso-8-1 'iso-latin-1
- coding-category-iso-8-2 'iso-latin-1
- coding-category-iso-7-else 'iso-2022-7bit-lock
- coding-category-iso-8-else 'iso-2022-8bit-ss2
- coding-category-ccl nil
- coding-category-utf-8 'mule-utf-8
- coding-category-utf-16-be 'mule-utf-16be-with-signature
- coding-category-utf-16-le 'mule-utf-16le-with-signature
- coding-category-big5 'chinese-big5
- coding-category-raw-text 'raw-text
- coding-category-binary 'no-conversion)
-
-(set-coding-priority
- '(coding-category-iso-8-1
- coding-category-iso-8-2
- coding-category-utf-8
- coding-category-utf-16-be
- coding-category-utf-16-le
- coding-category-iso-7-tight
- coding-category-iso-7
- 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-ccl
- coding-category-binary
- ))
+(set-coding-system-priority
+ 'iso-latin-1
+ 'utf-8
+ 'iso-2022-7bit
+ )
\f
;;; Miscellaneous settings.
+
+;; Make all multibyte characters self-insert.
+(set-char-table-range (nth 1 global-map)
+ (cons 128 (max-char))
+ 'self-insert-command)
+
(aset latin-extra-code-table ?\221 t)
(aset latin-extra-code-table ?\222 t)
(aset latin-extra-code-table ?\223 t)
(aset latin-extra-code-table ?\225 t)
(aset latin-extra-code-table ?\226 t)
-(update-coding-systems-internal)
+;; Move least specific charsets to end of priority list
+
+(apply #'set-charset-priority
+ (delq 'unicode (delq 'emacs (charset-priority-list))))
+
+;; The old code-pages library is obsoleted by coding systems based on
+;; the charsets defined in this file but might be required by user
+;; code.
+(provide 'code-pages)
+
+;; Local variables:
+;; no-byte-compile: t
+;; End:
;; arch-tag: 7d5fed55-b6df-42f6-8d3d-0011190551f5
;;; mule-conf.el ends here
;;; mule-diag.el --- show diagnosis of multilingual environment (Mule)
;; Copyright (C) 1997, 1998, 2000, 2001, 2002, 2003, 2004,
- ;; 2005, 2006, 2007 Free Software Foundation, Inc.
+ ;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- ;; 2005, 2006, 2007
+ ;; 2005, 2006, 2007, 2008
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
+;; Copyright (C) 2003
+;; National Institute of Advanced Industrial Science and Technology (AIST)
+;; Registration Number H13PRO009
;; Keywords: multilingual, charset, coding system, fontset, diagnosis, i18n
;;; General utility function
-;; Print all arguments with single space separator in one line.
(defun print-list (&rest args)
+ "Print all arguments with single space separator in one line."
(while (cdr args)
(when (car args)
(princ (car args))
(princ (car args))
(princ "\n"))
-;; Re-order the elements of charset-list.
-(defun sort-charset-list ()
- (setq charset-list
- (sort charset-list
- (lambda (x y) (< (charset-id x) (charset-id y))))))
-
;;; CHARSET
(define-button-type 'sort-listed-character-sets
'help-function #'list-charset-chars
'help-echo "mouse-2, RET: show table of characters for this character set")
-;;;###autoload
-(defvar non-iso-charset-alist
- `((mac-roman
- (ascii latin-iso8859-1 mule-unicode-2500-33ff
- mule-unicode-0100-24ff mule-unicode-e000-ffff)
- mac-roman-decoder
- ((0 255)))
- (viscii
- (ascii vietnamese-viscii-lower vietnamese-viscii-upper)
- viet-viscii-nonascii-translation-table
- ((0 255)))
- (vietnamese-tcvn
- (ascii vietnamese-viscii-lower vietnamese-viscii-upper)
- viet-tcvn-nonascii-translation-table
- ((0 255)))
- (koi8-r
- (ascii cyrillic-iso8859-5)
- cyrillic-koi8-r-nonascii-translation-table
- ((32 255)))
- (alternativnyj
- (ascii cyrillic-iso8859-5)
- cyrillic-alternativnyj-nonascii-translation-table
- ((32 255)))
- (koi8-u
- (ascii cyrillic-iso8859-5 mule-unicode-0100-24ff)
- cyrillic-koi8-u-nonascii-translation-table
- ((32 255)))
- (big5
- (ascii chinese-big5-1 chinese-big5-2)
- decode-big5-char
- ((32 127)
- ((?\xA1 ?\xFE) . (?\x40 ?\x7E ?\xA1 ?\xFE))))
- (sjis
- (ascii katakana-jisx0201 japanese-jisx0208)
- decode-sjis-char
- ((32 127 ?\xA1 ?\xDF)
- ((?\x81 ?\x9F ?\xE0 ?\xEF) . (?\x40 ?\x7E ?\x80 ?\xFC)))))
- "Alist of charset names vs the corresponding information.
-This is mis-named for historical reasons. The charsets are actually
-non-built-in ones. They correspond to Emacs coding systems, not Emacs
-charsets, i.e. what Emacs can read (or write) by mapping to (or
-from) Emacs internal charsets that typically correspond to a limited
-set of ISO charsets.
-
-Each element has the following format:
- (CHARSET CHARSET-LIST TRANSLATION-METHOD [ CODE-RANGE ])
-
-CHARSET is the name (symbol) of the charset.
-
-CHARSET-LIST is a list of Emacs charsets into which characters of
-CHARSET are mapped.
-
-TRANSLATION-METHOD is a translation table (symbol) to translate a
-character code of CHARSET to the corresponding Emacs character
-code. It can also be a function to call with one argument, a
-character code in CHARSET.
-
-CODE-RANGE specifies the valid code ranges of CHARSET.
-It is a list of RANGEs, where each RANGE is of the form:
- (FROM1 TO1 FROM2 TO2 ...)
-or
- ((FROM1-1 TO1-1 FROM1-2 TO1-2 ...) . (FROM2-1 TO2-1 FROM2-2 TO2-2 ...))
-In the first form, valid codes are between FROM1 and TO1, or FROM2 and
-TO2, or...
-The second form is used for 2-byte codes. The car part is the ranges
-of the first byte, and the cdr part is the ranges of the second byte.")
-
;;;###autoload
(defun list-character-sets (arg)
"Display a list of all character sets.
-The ID-NUM column contains a charset identification number for
-internal Emacs use.
-
-The MULTIBYTE-FORM column contains the format of the buffer and string
-multibyte sequence of characters in the charset using one to four
-hexadecimal digits.
- `xx' stands for any byte in the range 0..127.
- `XX' stands for any byte in the range 160..255.
-
The D column contains the dimension of this character set. The CH
column contains the number of characters in a block of this character
set. The FINAL-CHAR column contains an ISO-2022 <final-char> to use
(if arg
(list-character-sets-2)
;; Insert header.
- (insert "Indirectly supported character sets are shown below.\n")
+ (insert "Supplementary character sets are shown below.\n")
(insert
(substitute-command-keys
(concat "Use "
(if (display-mouse-p) "\\[help-follow-mouse] or ")
"\\[help-follow]:\n")))
(insert " on a column title to sort by that title,")
- (indent-to 56)
+ (indent-to 48)
(insert "+----DIMENSION\n")
(insert " on a charset name to list characters.")
- (indent-to 56)
+ (indent-to 48)
(insert "| +--CHARS\n")
- (let ((columns '(("ID-NUM" . id) "\t"
- ("CHARSET-NAME" . name) "\t\t\t"
- ("MULTIBYTE-FORM" . id) "\t"
- ("D CH FINAL-CHAR" . iso-spec)))
+ (let ((columns '(("CHARSET-NAME" . name) "\t\t\t\t\t"
+ ("D CH FINAL-CHAR" . iso-spec)))
pos)
(while columns
(if (stringp (car columns))
(goto-char (point-max)))
(setq columns (cdr columns)))
(insert "\n"))
- (insert "------\t------------\t\t\t--------------\t- -- ----------\n")
+ (insert "------------\t\t\t\t\t- --- ----------\n")
;; Insert body sorted by charset IDs.
- (list-character-sets-1 'id)
-
- ;; Insert non-directly-supported charsets.
- (insert-char ?- 72)
- (insert "\n\nINDIRECTLY SUPPORTED CHARSETS SETS:\n\n"
- (propertize "CHARSET NAME\tMAPPED TO" 'face 'bold)
- "\n------------\t---------\n")
- (dolist (elt non-iso-charset-alist)
- (insert-text-button (symbol-name (car elt))
- :type 'list-charset-chars
- 'help-args (list (car elt)))
- (indent-to 16)
- (dolist (e (nth 1 elt))
- (when (>= (+ (current-column) 1 (string-width (symbol-name e)))
- ;; This is an approximate value. We don't know
- ;; the correct window width of this buffer yet.
- 78)
- (insert "\n")
- (indent-to 16))
-
- (insert (format "%s " e)))
- (insert "\n"))))))
+ (list-character-sets-1 'name)))))
(defun sort-listed-character-sets (sort-key)
(if sort-key
(save-excursion
- (help-setup-xref (list #'list-character-sets nil) t)
(let ((buffer-read-only nil))
(goto-char (point-min))
- (re-search-forward "[0-9][0-9][0-9]")
- (beginning-of-line)
- (let ((pos (point)))
- (search-forward "----------")
- (beginning-of-line)
- (save-restriction
- (narrow-to-region pos (point))
- (delete-region (point-min) (point-max))
- (list-character-sets-1 sort-key)))))))
-
-(defun charset-multibyte-form-string (charset)
- (let ((info (charset-info charset)))
- (cond ((eq charset 'ascii)
- "xx")
- ((eq charset 'eight-bit-control)
- (format "%2X Xx" (aref info 6)))
- ((eq charset 'eight-bit-graphic)
- "XX")
- (t
- (let ((str (format "%2X" (aref info 6))))
- (if (> (aref info 7) 0)
- (setq str (format "%s %2X"
- str (aref info 7))))
- (setq str (concat str " XX"))
- (if (> (aref info 2) 1)
- (setq str (concat str " XX")))
- str)))))
-
-;; Insert a list of character sets sorted by SORT-KEY. SORT-KEY
-;; should be one of `id', `name', and `iso-spec'. If SORT-KEY is nil,
-;; it defaults to `id'.
+ (search-forward "\n-")
+ (forward-line 1)
+ (delete-region (point) (point-max))
+ (list-character-sets-1 sort-key)))))
(defun list-character-sets-1 (sort-key)
+ "Insert a list of character sets sorted by SORT-KEY.
+SORT-KEY should be `name' or `iso-spec' (default `name')."
(or sort-key
- (setq sort-key 'id))
- (let ((tail (charset-list))
- charset-info-list elt charset info sort-func)
- (while tail
- (setq charset (car tail) tail (cdr tail)
- info (charset-info charset))
-
+ (setq sort-key 'name))
+ (let ((tail charset-list)
+ charset-info-list supplementary-list charset sort-func)
+ (dolist (charset charset-list)
;; Generate a list that contains all information to display.
- (setq charset-info-list
- (cons (list (charset-id charset) ; ID-NUM
- charset ; CHARSET-NAME
- (charset-multibyte-form-string charset); MULTIBYTE-FORM
- (aref info 2) ; DIMENSION
- (aref info 3) ; CHARS
- (aref info 8) ; FINAL-CHAR
- )
- charset-info-list)))
+ (let ((elt (list charset
+ (charset-dimension charset)
+ (charset-chars charset)
+ (charset-iso-final-char charset))))
+ (if (plist-get (charset-plist charset) :supplementary-p)
+ (push elt supplementary-list)
+ (push elt charset-info-list))))
;; Determine a predicate for `sort' by SORT-KEY.
(setq sort-func
- (cond ((eq sort-key 'id)
- (lambda (x y) (< (car x) (car y))))
-
- ((eq sort-key 'name)
- (lambda (x y) (string< (nth 1 x) (nth 1 y))))
+ (cond ((eq sort-key 'name)
+ (lambda (x y) (string< (car x) (car y))))
((eq sort-key 'iso-spec)
;; Sort by DIMENSION CHARS FINAL-CHAR
- (lambda (x y)
- (or (< (nth 3 x) (nth 3 y))
- (and (= (nth 3 x) (nth 3 y))
- (or (< (nth 4 x) (nth 4 y))
- (and (= (nth 4 x) (nth 4 y))
- (< (nth 5 x) (nth 5 y))))))))
+ (function
+ (lambda (x y)
+ (or (< (nth 1 x) (nth 1 y))
+ (and (= (nth 1 x) (nth 1 y))
+ (or (< (nth 2 x) (nth 2 y))
+ (and (= (nth 2 x) (nth 2 y))
+ (< (nth 3 x) (nth 3 y)))))))))
(t
(error "Invalid charset sort key: %s" sort-key))))
(setq charset-info-list (sort charset-info-list sort-func))
+ (setq supplementary-list (sort supplementary-list sort-func))
;; Insert information of character sets.
- (while charset-info-list
- (setq elt (car charset-info-list)
- charset-info-list (cdr charset-info-list))
- (insert (format "%03d(%02X)" (car elt) (car elt))) ; ID-NUM
- (indent-to 8)
- (insert-text-button (symbol-name (nth 1 elt))
- :type 'list-charset-chars
- 'help-args (list (nth 1 elt)))
- (goto-char (point-max))
- (insert "\t")
- (indent-to 40)
- (insert (nth 2 elt)) ; MULTIBYTE-FORM
- (indent-to 56)
- (insert (format "%d %2d " (nth 3 elt) (nth 4 elt)) ; DIMENSION and CHARS
- (if (< (nth 5 elt) 0) "none" (nth 5 elt))) ; FINAL-CHAR
+ (dolist (elt (append charset-info-list (list t) supplementary-list))
+ (if (eq elt t)
+ (insert "-------------- Supplementary Character Sets --------------")
+ (insert-text-button (symbol-name (car elt)) ; NAME
+ :type 'list-charset-chars
+ 'help-args (list (car elt)))
+ (goto-char (point-max))
+ (insert "\t")
+ (indent-to 48)
+ (insert (format "%d %3d "
+ (nth 1 elt) (nth 2 elt)) ; DIMENSION and CHARS
+ (if (< (nth 3 elt) 0)
+ "none"
+ (nth 3 elt)))) ; FINAL-CHAR
(insert "\n"))))
## Each line corresponds to one charset.
## The following attributes are listed in this order
## separated by a colon `:' in one line.
-## CHARSET-ID,
## CHARSET-SYMBOL-NAME,
## DIMENSION (1 or 2)
## CHARS (94 or 96)
-## BYTES (of multibyte form: 1, 2, 3, or 4),
-## WIDTH (occupied column numbers: 1 or 2),
-## DIRECTION (0:left-to-right, 1:right-to-left),
## ISO-FINAL-CHAR (character code of ISO-2022's final character)
-## ISO-GRAPHIC-PLANE (ISO-2022's graphic plane, 0:GL, 1:GR)
+## -1 means that no final character is assigned.
## DESCRIPTION (describing string of the charset)
")
(let ((l charset-list)
charset)
(while l
(setq charset (car l) l (cdr l))
- (princ (format "%03d:%s:%d:%d:%d:%d:%d:%d:%d:%s\n"
- (charset-id charset)
+ (princ (format "%s:%d:%d:%d:%s\n"
charset
(charset-dimension charset)
(charset-chars charset)
- (charset-bytes charset)
- (charset-width charset)
- (charset-direction charset)
+;;; (char-width (make-char charset))
+;;; (charset-direction charset)
(charset-iso-final-char charset)
- (charset-iso-graphic-plane charset)
+;;; (charset-iso-graphic-plane charset)
(charset-description charset))))))
+(defvar non-iso-charset-alist nil
+ "Obsolete.")
+(make-obsolete-variable 'non-iso-charset-alist "no longer relevant" "23.1")
+
(defun decode-codepage-char (codepage code)
"Decode a character that has code CODE in CODEPAGE.
Return a decoded character string. Each CODEPAGE corresponds to a
-coding system cpCODEPAGE."
- (let ((coding-system (intern (format "cp%d" codepage))))
- (or (coding-system-p coding-system)
- (codepage-setup codepage))
- (string-to-char
- (decode-coding-string (char-to-string code) coding-system))))
+coding system cpCODEPAGE. This function is obsolete."
+ (decode-char (intern (format "cp%d" codepage)) code))
+(make-obsolete 'decode-codepage-char 'decode-char "23.1")
;; A variable to hold charset input history.
(defvar charset-history nil)
;;;###autoload
(defun read-charset (prompt &optional default-value initial-input)
"Read a character set from the minibuffer, prompting with string PROMPT.
-It must be an Emacs character set listed in the variable `charset-list'
-or a non-ISO character set listed in the variable
-`non-iso-charset-alist'.
+It must be an Emacs character set listed in the variable `charset-list'.
Optional arguments are DEFAULT-VALUE and INITIAL-INPUT.
DEFAULT-VALUE, if non-nil, is the default value.
INITIAL-INPUT, if non-nil, is a string inserted in the minibuffer initially.
See the documentation of the function `completing-read' for the
detailed meanings of these arguments."
- (let* ((table (append (mapcar (lambda (x) (list (symbol-name x)))
- charset-list)
- (mapcar (lambda (x) (list (symbol-name (car x))))
- non-iso-charset-alist)))
+ (let* ((table (mapcar (lambda (x) (list (symbol-name x))) charset-list))
(charset (completing-read prompt table
nil t initial-input 'charset-history
default-value)))
(if (> (length charset) 0)
(intern charset))))
-
;; List characters of the range MIN and MAX of CHARSET. If dimension
;; of CHARSET is two (i.e. 2-byte charset), ROW is the first byte
;; (block index) of the characters, and MIN and MAX are the second
;; bytes of the characters. If the dimension is one, ROW should be 0.
-;; For a non-ISO charset, CHARSET is a translation table (symbol) or a
-;; function to get Emacs' character codes that corresponds to the
-;; characters to list.
(defun list-block-of-chars (charset row min max)
(let (i ch)
- (insert-char ?- (+ 4 (* 3 16)))
- (insert "\n ")
+ (insert-char ?- (+ 7 (* 4 16)))
+ (insert "\n ")
(setq i 0)
(while (< i 16)
- (insert (format "%3X" i))
+ (insert (format "%4X" i))
(setq i (1+ i)))
(setq i (* (/ min 16) 16))
(while (<= i max)
(if (= (% i 16) 0)
- (insert (format "\n%3Xx" (/ (+ (* row 256) i) 16))))
- (setq ch (cond ((< i min)
- 32)
- ((charsetp charset)
- (if (= row 0)
- (make-char charset i)
- (make-char charset row i)))
- ((and (symbolp charset) (get charset 'translation-table))
- (aref (get charset 'translation-table) i))
- (t (funcall charset (+ (* row 256) i)))))
- (if (and (char-table-p charset)
- (or (< ch 32) (and (>= ch 127) (<= ch 255))))
- ;; Don't insert a control code.
- (setq ch 32))
- (unless ch (setq ch 32))
- (if (eq ch ?\t)
- ;; Make it visible.
- (setq ch (propertize "\t" 'display "^I")))
- ;; This doesn't DTRT. Maybe it's better to insert "^J" and not
- ;; worry about the buffer contents not being correct.
-;;; (if (eq ch ?\n)
-;;; (setq ch (propertize "\n" 'display "^J")))
- (indent-to (+ (* (% i 16) 3) 6))
- (insert ch)
+ (insert (format "\n%6Xx" (/ (+ (* row 256) i) 16))))
+ (setq ch (if (< i min)
+ 32
+ (or (decode-char charset (+ (* row 256) i))
+ 32))) ; gap in mapping
+ ;; Don't insert control codes, non-Unicode characters.
+ (if (or (< ch 32) (= ch 127))
+ (setq ch (single-key-description ch))
+ (if (and (>= ch 128) (< ch 160))
+ (setq ch (format "%02Xh" ch))
+ (if (> ch #x10FFFF)
+ (setq ch 32))))
+ (insert "\t" ch)
(setq i (1+ i))))
(insert "\n"))
-(defun list-iso-charset-chars (charset)
- (let ((dim (charset-dimension charset))
- (chars (charset-chars charset))
- (plane (charset-iso-graphic-plane charset))
- min max)
- (insert (format "Characters in the coded character set %s.\n" charset))
-
- (cond ((eq charset 'eight-bit-control)
- (setq min 128 max 159))
- ((eq charset 'eight-bit-graphic)
- (setq min 160 max 255))
- (t
- (if (= chars 94)
- (setq min 33 max 126)
- (setq min 32 max 127))
- (or (= plane 0)
- (setq min (+ min 128) max (+ max 128)))))
-
- (if (= dim 1)
- (list-block-of-chars charset 0 min max)
- (let ((i min))
- (while (<= i max)
- (list-block-of-chars charset i min max)
- (setq i (1+ i)))))))
-
-(defun list-non-iso-charset-chars (charset)
- "List all characters in non-built-in coded character set CHARSET."
- (let* ((slot (assq charset non-iso-charset-alist))
- (charsets (nth 1 slot))
- (translate-method (nth 2 slot))
- (ranges (nth 3 slot))
- range)
- (or slot
- (error "Unknown character set: %s" charset))
- (insert (format "Characters in the coded character set %s.\n" charset))
- (if charsets
- (insert "They are mapped to: "
- (mapconcat #'symbol-name charsets ", ")
- "\n"))
- (while ranges
- (setq range (pop ranges))
- (if (integerp (car range))
- ;; The form of RANGES is (FROM1 TO1 FROM2 TO2 ...).
- (if (and (not (functionp translate-method))
- (< (car (last range)) 256))
- ;; Do it all in one block to avoid the listing being
- ;; broken up at gaps in the range. Don't do that for
- ;; function translate-method, since not all codes in
- ;; that range may be valid.
- (list-block-of-chars translate-method
- 0 (car range) (car (last range)))
- (while range
- (list-block-of-chars translate-method
- 0 (car range) (nth 1 range))
- (setq range (nthcdr 2 range))))
- ;; The form of RANGES is ((FROM1-1 TO1-1 ...) . (FROM2-1 TO2-1 ...)).
- (let ((row-range (car range))
- row row-max
- col-range col col-max)
- (while row-range
- (setq row (car row-range) row-max (nth 1 row-range)
- row-range (nthcdr 2 row-range))
- (while (<= row row-max)
- (setq col-range (cdr range))
- (while col-range
- (setq col (car col-range) col-max (nth 1 col-range)
- col-range (nthcdr 2 col-range))
- (list-block-of-chars translate-method row col col-max))
- (setq row (1+ row)))))))))
-
-
;;;###autoload
(defun list-charset-chars (charset)
- "Display a list of characters in the specified character set.
-This can list both Emacs `official' (ISO standard) charsets and the
-characters encoded by various Emacs coding systems which correspond to
-PC `codepages' and other coded character sets. See `non-iso-charset-alist'."
+ "Display a list of characters in character set CHARSET."
(interactive (list (read-charset "Character set: ")))
+ (or (charsetp charset)
+ (error "Invalid character set: %s" charset))
(with-output-to-temp-buffer "*Character List*"
(with-current-buffer standard-output
+ (if (coding-system-p charset)
+ ;; Useful to be able to do C-u C-x = to find file code, for
+ ;; instance:
+ (set-buffer-file-coding-system charset))
(setq mode-line-format (copy-sequence mode-line-format))
(let ((slot (memq 'mode-line-buffer-identification mode-line-format)))
(if slot
(setcdr slot
(cons (format " (%s)" charset)
(cdr slot)))))
- (setq indent-tabs-mode nil)
+ (setq tab-width 4)
(set-buffer-multibyte t)
- (cond ((charsetp charset)
- (list-iso-charset-chars charset))
- ((assq charset non-iso-charset-alist)
- (list-non-iso-charset-chars charset))
- (t
- (error "Invalid character set %s" charset))))))
+ (let ((dim (charset-dimension charset))
+ (chars (charset-chars charset))
+ ;; (plane (charset-iso-graphic-plane charset))
+ (plane 1)
+ (range (plist-get (charset-plist charset) :code-space))
+ min max min2 max2)
+ (if (> dim 2)
+ (error "Can only list 1- and 2-dimensional charsets"))
+ (insert (format "Characters in the coded character set %s.\n" charset))
+ (narrow-to-region (point) (point))
+ (setq min (aref range 0)
+ max (aref range 1))
+ (if (= dim 1)
+ (list-block-of-chars charset 0 min max)
+ (setq min2 (aref range 2)
+ max2 (aref range 3))
+ (let ((i min2))
+ (while (<= i max2)
+ (list-block-of-chars charset i min max)
+ (setq i (1+ i)))))
+ (put-text-property (point-min) (point-max) 'charset charset)
+ (widen)))))
;;;###autoload
(defun describe-character-set (charset)
"Display information about built-in character set CHARSET."
- (interactive (list (let ((non-iso-charset-alist nil))
- (read-charset "Charset: "))))
+ (interactive (list (read-charset "Charset: ")))
(or (charsetp charset)
(error "Invalid charset: %S" charset))
- (let ((info (charset-info charset)))
- (help-setup-xref (list #'describe-character-set charset) (interactive-p))
- (with-output-to-temp-buffer (help-buffer)
- (with-current-buffer standard-output
- (insert "Character set: " (symbol-name charset)
- (format " (ID:%d)\n\n" (aref info 0)))
- (insert (aref info 13) "\n\n") ; description
- (insert "Number of contained characters: "
- (if (= (aref info 2) 1)
- (format "%d\n" (aref info 3))
- (format "%dx%d\n" (aref info 3) (aref info 3))))
- (insert "Final char of ISO2022 designation sequence: ")
- (if (>= (aref info 8) 0)
- (insert (format "`%c'\n" (aref info 8)))
- (insert "not assigned\n"))
- (insert (format "Width (how many columns on screen): %d\n"
- (aref info 4)))
- (insert (format "Internal multibyte sequence: %s\n"
- (charset-multibyte-form-string charset)))
- (let ((coding (plist-get (aref info 14) 'preferred-coding-system)))
- (when coding
- (insert (format "Preferred coding system: %s\n" coding))
- (search-backward (symbol-name coding))
- (help-xref-button 0 'help-coding-system coding)))))))
+ (help-setup-xref (list #'describe-character-set charset) (interactive-p))
+ (with-output-to-temp-buffer (help-buffer)
+ (with-current-buffer standard-output
+ (insert "Character set: " (symbol-name charset))
+ (let ((name (get-charset-property charset :name)))
+ (if (not (eq name charset))
+ (insert " (alias of " (symbol-name name) ?\))))
+ (insert "\n\n" (charset-description charset) "\n\n")
+ (insert "Number of contained characters: ")
+ (dotimes (i (charset-dimension charset))
+ (unless (= i 0)
+ (insert ?x))
+ (insert (format "%d" (charset-chars charset (1+ i)))))
+ (insert ?\n)
+ (let ((char (charset-iso-final-char charset)))
+ (when (> char 0)
+ (insert "Final char of ISO2022 designation sequence: ")
+ (insert (format "`%c'\n" char))))
+ (insert (format "Width (how many columns on screen): %d\n"
+ (aref char-width-table (make-char charset))))
+ (let (aliases)
+ (dolist (c charset-list)
+ (if (and (not (eq c charset))
+ (eq charset (get-charset-property c :name)))
+ (push c aliases)))
+ (if aliases
+ (insert "Aliases: " (mapconcat #'symbol-name aliases ", ") ?\n)))
+
+ (dolist (elt `((:ascii-compatible-p "ASCII compatible." nil)
+ (:map "Map file: " identity)
+ (:unify-map "Unification map file: " identity)
+ (:invalid-code
+ nil
+ ,(lambda (c)
+ (format "Invalid character: %c (code %d)" c c)))
+ (:emacs-mule-id "Id in emacs-mule coding system: "
+ number-to-string)
+ (:parents "Parents: "
+ (lambda (parents)
+ (mapconcat ,(lambda (elt)
+ (format "%s" elt))
+ parents
+ ", ")))
+ (:code-space "Code space: " ,(lambda (c)
+ (format "%s" c)))
+ (:code-offset "Code offset: " number-to-string)
+ (:iso-revision-number "ISO revision number: "
+ number-to-string)
+ (:supplementary-p
+ "Used only as a parent of some other charset." nil)))
+ (let ((val (get-charset-property charset (car elt))))
+ (when val
+ (if (cadr elt) (insert (cadr elt)))
+ (if (nth 2 elt)
+ (insert (funcall (nth 2 elt) val)))
+ (insert ?\n)))))))
\f
;;; CODING-SYSTEM
-;; Print information of designation of each graphic register in FLAGS
-;; in human readable format. See the documentation of
-;; `make-coding-system' for the meaning of FLAGS.
-(defun print-designation (flags)
- (let ((graphic-register 0)
- charset)
- (while (< graphic-register 4)
- (setq charset (aref flags graphic-register))
+(eval-when-compile ; dynamic bondage
+ (defvar graphic-register))
+
+;; Print information about designation of each graphic register in
+;; DESIGNATIONS in human readable format. See the documentation of
+;; `define-coding-system' for the meaning of DESIGNATIONS
+;; (`:designation' property).
+(defun print-designation (designations)
+ (let (charset)
+ (dotimes (graphic-register 4)
+ (setq charset (aref designations graphic-register))
(princ (format
" G%d -- %s\n"
graphic-register
(charset-description (car charset)))))
(t
"invalid designation information"))
- (setq charset (cdr charset))))
- (setq graphic-register (1+ graphic-register)))))
+ (setq charset (cdr charset)))))))
;;;###autoload
(defun describe-coding-system (coding-system)
(interactive-p))
(with-output-to-temp-buffer (help-buffer)
(print-coding-system-briefly coding-system 'doc-string)
- (princ "\n")
- (let ((vars (coding-system-get coding-system 'dependency)))
- (when vars
- (princ "See also the documentation of these customizable variables
-which alter the behavior of this coding system.\n")
- (dolist (v vars)
- (princ " `")
- (princ v)
- (princ "'\n"))
- (princ "\n")))
-
- (princ "Type: ")
(let ((type (coding-system-type coding-system))
- (flags (coding-system-flags coding-system)))
+ ;; Fixme: use this
+ (extra-spec (coding-system-plist coding-system)))
+ (princ "Type: ")
(princ type)
- (cond ((eq type nil)
- (princ " (do no conversion)"))
- ((eq type t)
+ (cond ((eq type 'undecided)
(princ " (do automatic conversion)"))
- ((eq type 0)
- (princ " (Emacs internal multibyte form)"))
- ((eq type 1)
+ ((eq type 'utf-8)
+ (princ " (UTF-8: Emacs internal multibyte form)"))
+ ((eq type 'utf-16)
+ ;; (princ " (UTF-16)")
+ )
+ ((eq type 'shift-jis)
(princ " (Shift-JIS, MS-KANJI)"))
- ((eq type 2)
+ ((eq type 'iso-2022)
(princ " (variant of ISO-2022)\n")
(princ "Initial designations:\n")
- (print-designation flags)
- (princ "Other Form: \n ")
- (princ (if (aref flags 4) "short-form" "long-form"))
- (if (aref flags 5) (princ ", ASCII@EOL"))
- (if (aref flags 6) (princ ", ASCII@CNTL"))
- (princ (if (aref flags 7) ", 7-bit" ", 8-bit"))
- (if (aref flags 8) (princ ", use-locking-shift"))
- (if (aref flags 9) (princ ", use-single-shift"))
- (if (aref flags 10) (princ ", use-roman"))
- (if (aref flags 11) (princ ", use-old-jis"))
- (if (aref flags 12) (princ ", no-ISO6429"))
- (if (aref flags 13) (princ ", init-bol"))
- (if (aref flags 14) (princ ", designation-bol"))
- (if (aref flags 15) (princ ", convert-unsafe"))
- (if (aref flags 16) (princ ", accept-latin-extra-code"))
- (princ "."))
- ((eq type 3)
- (princ " (Big5)"))
- ((eq type 4)
+ (print-designation (coding-system-get coding-system
+ :designation))
+
+ (when (coding-system-get coding-system :flags)
+ (princ "Other specifications: \n ")
+ (apply #'print-list
+ (coding-system-get coding-system :flags))))
+ ((eq type 'charset)
+ (princ " (charset)"))
+ ((eq type 'ccl)
(princ " (do conversion by CCL program)"))
- ((eq type 5)
+ ((eq type 'raw-text)
(princ " (text with random binary characters)"))
- (t (princ ": invalid coding-system."))))
- (princ "\nEOL type: ")
- (let ((eol-type (coding-system-eol-type coding-system)))
- (cond ((vectorp eol-type)
- (princ "Automatic selection from:\n\t")
- (princ eol-type)
- (princ "\n"))
- ((or (null eol-type) (eq eol-type 0)) (princ "LF\n"))
- ((eq eol-type 1) (princ "CRLF\n"))
- ((eq eol-type 2) (princ "CR\n"))
- (t (princ "invalid\n"))))
- (let ((postread (coding-system-get coding-system 'post-read-conversion)))
+ ((eq type 'emacs-mule)
+ (princ " (Emacs 21 internal encoding)"))
+ (t (princ ": invalid coding-system.")))
+ (princ "\nEOL type: ")
+ (let ((eol-type (coding-system-eol-type coding-system)))
+ (cond ((vectorp eol-type)
+ (princ "Automatic selection from:\n\t")
+ (princ eol-type)
+ (princ "\n"))
+ ((or (null eol-type) (eq eol-type 0)) (princ "LF\n"))
+ ((eq eol-type 1) (princ "CRLF\n"))
+ ((eq eol-type 2) (princ "CR\n"))
+ (t (princ "invalid\n")))))
+ (let ((postread (coding-system-get coding-system :post-read-conversion)))
(when postread
(princ "After decoding text normally,")
(princ " perform post-conversion using the function: ")
(princ "\n ")
(princ postread)
(princ "\n")))
- (let ((prewrite (coding-system-get coding-system 'pre-write-conversion)))
+ (let ((prewrite (coding-system-get coding-system :pre-write-conversion)))
(when prewrite
(princ "Before encoding text normally,")
(princ " perform pre-conversion using the function: ")
(princ prewrite)
(princ "\n")))
(with-current-buffer standard-output
- (let ((charsets (coding-system-get coding-system 'safe-charsets)))
- (when (and (not (memq (coding-system-base coding-system)
- '(raw-text emacs-mule)))
+ (let ((charsets (coding-system-charset-list coding-system)))
+ (when (and (not (eq (coding-system-base coding-system) 'raw-text))
charsets)
- (if (eq charsets t)
- (insert "This coding system can encode all charsets except for
-eight-bit-control and eight-bit-graphic.\n")
+ (cond
+ ((eq charsets 'iso-2022)
+ (insert "This coding system can encode all ISO 2022 charsets."))
+ ((eq charsets 'emacs-mule)
+ (insert "This coding system can encode all emacs-mule charsets\
+."""))
+ (t
(insert "This coding system encodes the following charsets:\n ")
(while charsets
(insert " " (symbol-name (car charsets)))
(search-backward (symbol-name (car charsets)))
(help-xref-button 0 'help-character-set (car charsets))
(goto-char (point-max))
- (setq charsets (cdr charsets))))))))))
-
+ (setq charsets (cdr charsets)))))))))))
;;;###autoload
(defun describe-current-coding-system-briefly ()
(coding-system-eol-type-mnemonic (cdr default-process-coding-system))
)))
-;; Print symbol name and mnemonic letter of CODING-SYSTEM with `princ'.
-;; If DOC-STRING is non-nil, print also the docstring of CODING-SYSTEM.
-;; If DOC-STRING is `tightly', don't print an empty line before the
-;; docstring, and print only the first line of the docstring.
-
(defun print-coding-system-briefly (coding-system &optional doc-string)
+ "Print symbol name and mnemonic letter of CODING-SYSTEM with `princ'.
+If DOC-STRING is non-nil, print also the docstring of CODING-SYSTEM.
+If DOC-STRING is `tightly', don't print an empty line before the
+docstring, and print only the first line of the docstring."
(if (not coding-system)
(princ "nil\n")
(princ (format "%c -- %s"
(coding-system-mnemonic coding-system)
coding-system))
- (let ((aliases (coding-system-get coding-system 'alias-coding-systems)))
+ (let ((aliases (coding-system-aliases coding-system)))
(cond ((eq coding-system (car aliases))
(if (cdr aliases)
(princ (format " %S" (cons 'alias: (cdr aliases))))))
(print-coding-system-briefly (keyboard-coding-system))
(princ "Coding system for terminal output:\n ")
(print-coding-system-briefly (terminal-coding-system))
+ (princ "Coding system for inter-client cut and paste:\n ")
+ (print-coding-system-briefly selection-coding-system)
(when (get-buffer-process (current-buffer))
(princ "Coding systems for process I/O:\n")
(princ " encoding input to the process: ")
(princ "
Priority order for recognizing coding systems when reading files:\n")
- (let ((l coding-category-list)
- (i 1)
- (coding-list nil)
- coding aliases)
- (while l
- (setq coding (symbol-value (car l)))
- ;; Do not list up the same coding system twice.
- (when (and coding (not (memq coding coding-list)))
- (setq coding-list (cons coding coding-list))
- (princ (format " %d. %s " i coding))
- (setq aliases (coding-system-get coding 'alias-coding-systems))
- (if (eq coding (car aliases))
+ (let ((i 1))
+ (dolist (elt (coding-system-priority-list))
+ (princ (format " %d. %s " i elt))
+ (let ((aliases (coding-system-aliases elt)))
+ (if (eq elt (car aliases))
(if (cdr aliases)
(princ (cons 'alias: (cdr aliases))))
- (if (memq coding aliases)
- (princ (list 'alias 'of (car aliases)))))
+ (princ (list 'alias 'of (car aliases))))
(terpri)
- (setq i (1+ i)))
- (setq l (cdr l))))
+ (setq i (1+ i)))))
(princ "\n Other coding systems cannot be distinguished automatically
from these, and therefore cannot be recognized automatically
with the present coding system priorities.\n\n")
+ ;; Fixme: should this be replaced or junked?
+ (if nil
(let ((categories '(coding-category-iso-7 coding-category-iso-7-else))
coding-system codings)
(while categories
(mapc
(lambda (x)
(if (and (not (eq x coding-system))
- (coding-system-get x 'no-initial-designation)
- (let ((flags (coding-system-flags x)))
- (not (or (aref flags 10) (aref flags 11)))))
+ (let ((flags (coding-system-get :flags)))
+ (not (or (memq 'use-roman flags)
+ (memq 'use-oldjis flags)))))
(setq codings (cons x codings))))
(get (car categories) 'coding-systems))
(if codings
(goto-char (point-max)))
(setq codings (cdr codings)))
(insert "\n\n")))
- (setq categories (cdr categories))))
+ (setq categories (cdr categories)))))
(princ "Particular coding systems specified for certain file names:\n")
(terpri)
(funcall func "Network I/O" network-coding-system-alist))
(help-mode))))
-;; Print detailed information on CODING-SYSTEM.
(defun print-coding-system (coding-system)
+ "Print detailed information on CODING-SYSTEM."
(let ((type (coding-system-type coding-system))
(eol-type (coding-system-eol-type coding-system))
- (flags (coding-system-flags coding-system))
- (aliases (coding-system-get coding-system 'alias-coding-systems)))
+ (flags (coding-system-get coding-system :flags))
+ (aliases (coding-system-aliases coding-system)))
(if (not (eq (car aliases) coding-system))
(princ (format "%s (alias of %s)\n" coding-system (car aliases)))
(princ coding-system)
type
(coding-system-mnemonic coding-system)
(if (integerp eol-type) eol-type 3)))
- (cond ((eq type 2) ; ISO-2022
+ (cond ((eq type 'iso2022)
(let ((idx 0)
charset)
(while (< idx 4)
(princ ",")
(setq idx (1+ idx)))
(princ (if (aref flags idx) 1 0))))
- ((eq type 4) ; CCL
+ ((eq type 'ccl)
(let (i len)
(if (symbolp (car flags))
(princ (format " %s" (car flags)))
(dolist (coding-system (sort-coding-systems (coding-system-list 'base-only)))
(if (null arg)
(print-coding-system-briefly coding-system 'tightly)
- (print-coding-system coding-system)))
- (let ((first t))
- (dolist (elt coding-system-alist)
- (unless (memq (intern (car elt)) coding-system-list)
- (when first
- (princ "\
-####################################################
-# The following coding systems are not yet loaded. #
-####################################################
-")
- (setq first nil))
- (princ-list (car elt))))))
+ (print-coding-system coding-system))))
+;; Fixme: delete?
;;;###autoload
(defun list-coding-categories ()
"Display a list of all coding categories."
\f
;;; FONT
-;; Print information of a font in FONTINFO.
(defun describe-font-internal (font-info &optional verbose)
+ "Print information about a font in FONT-INFO."
(print-list "name (opened by):" (aref font-info 0))
(print-list " full name:" (aref font-info 1))
(print-list " size:" (format "%2d" (aref font-info 2)))
(with-output-to-temp-buffer "*Help*"
(describe-font-internal font-info 'verbose)))))
-(defun print-fontset (fontset &optional print-fonts)
+(defun print-fontset-element (val)
+ ;; VAL has this format:
+ ;; ((REQUESTED-FONT-NAME OPENED-FONT-NAME ...) ...)
+ ;; CHAR RANGE is already inserted. Get character codes from
+ ;; the current line.
+ (beginning-of-line)
+ (let ((from (following-char))
+ (to (if (looking-at "[^.]*[.]* ")
+ (char-after (match-end 0)))))
+ (if (re-search-forward "[ \t]*$" nil t)
+ (delete-region (match-beginning 0) (match-end 0)))
+
+ ;; For non-ASCII characters, insert also CODE RANGE.
+ (if (or (>= from 128) (and to (>= to 128)))
+ (if to
+ (insert (format " (#x%02X .. #x%02X)" from to))
+ (insert (format " (#x%02X)" from))))
+
+ ;; Insert a requested font name.
+ (dolist (elt val)
+ (let ((requested (car elt)))
+ (if (stringp requested)
+ (insert "\n " requested)
+ (let (family registry weight slant width adstyle)
+ (if (and (fboundp 'fontp) (fontp requested))
+ (setq family (font-get requested :family)
+ registry (font-get requested :registry)
+ weight (font-get requested :weight)
+ slant (font-get requested :slant)
+ width (font-get requested :width)
+ adstyle (font-get requested :adstyle))
+ (setq family (aref requested 0)
+ registry (aref requested 5)
+ weight (aref requested 1)
+ slant (aref requested 2)
+ width (aref requested 3)
+ adstyle (aref requested 4)))
+ (if (not family)
+ (setq family "*-*")
+ (if (symbolp family)
+ (setq family (symbol-name family)))
+ (or (string-match "-" family)
+ (setq family (concat "*-" family))))
+ (if (not registry)
+ (setq registry "*-*")
+ (if (symbolp registry)
+ (setq registry (symbol-name registry)))
+ (or (string-match "-" registry)
+ (= (aref registry (1- (length registry))) ?*)
+ (setq registry (concat registry "*"))))
+ (insert (format"\n -%s-%s-%s-%s-%s-*-*-*-*-*-*-%s"
+ family (or weight "*") (or slant "*") (or width "*")
+ (or adstyle "*") registry)))))
+
+ ;; Insert opened font names (if any).
+ (if (and (boundp 'print-opened) (symbol-value 'print-opened))
+ (dolist (opened (cdr elt))
+ (insert "\n\t[" opened "]"))))))
+
+(defun print-fontset (fontset &optional print-opened)
"Print information about FONTSET.
If FONTSET is nil, print information about the default fontset.
-If optional arg PRINT-FONTS is non-nil, also print names of all opened
+If optional arg PRINT-OPENED is non-nil, also print names of all opened
fonts for FONTSET. This function actually inserts the information in
the current buffer."
(or fontset
(setq fontset (query-fontset "fontset-default")))
- (let ((tail (aref (fontset-info fontset) 2))
- elt chars font-spec opened prev-charset charset from to)
- (beginning-of-line)
- (insert "Fontset: " fontset "\n")
- (insert "CHARSET or CHAR RANGE")
- (indent-to 24)
- (insert "FONT NAME\n")
- (insert "---------------------")
- (indent-to 24)
- (insert "---------")
- (insert "\n")
- (while tail
- (setq elt (car tail) tail (cdr tail))
- (setq chars (car elt) font-spec (car (cdr elt)) opened (cdr (cdr elt)))
- (if (symbolp chars)
- (setq charset chars from nil to nil)
- (if (integerp chars)
- (setq charset (char-charset chars) from chars to chars)
- (setq charset (char-charset (car chars))
- from (car chars) to (cdr chars))))
- (unless (eq charset prev-charset)
- (insert (symbol-name charset))
- (if from
- (insert "\n")))
- (when from
- (let ((split (split-char from)))
- (if (and (= (charset-dimension charset) 2)
- (= (nth 2 split) 0))
- (setq from
- (make-char charset (nth 1 split)
- (if (= (charset-chars charset) 94) 33 32))))
- (insert " " from))
- (when (/= from to)
- (insert "-")
- (let ((split (split-char to)))
- (if (and (= (charset-dimension charset) 2)
- (= (nth 2 split) 0))
- (setq to
- (make-char charset (nth 1 split)
- (if (= (charset-chars charset) 94) 126 127))))
- (insert to))))
- (indent-to 24)
- (if (stringp font-spec)
- (insert font-spec)
- (if (car font-spec)
- (if (string-match "-" (car font-spec))
- (insert "-" (car font-spec) "-*-")
- (insert "-*-" (car font-spec) "-*-"))
- (insert "-*-"))
- (if (cdr font-spec)
- (if (string-match "-" (cdr font-spec))
- (insert (cdr font-spec))
- (insert (cdr font-spec) "-*"))
- (insert "*")))
- (insert "\n")
- (when print-fonts
- (while opened
- (indent-to 5)
- (insert "[" (car opened) "]\n")
- (setq opened (cdr opened))))
- (setq prev-charset charset)
- )))
+ (beginning-of-line)
+ (insert "Fontset: " fontset "\n")
+ (insert (propertize "CHAR RANGE" 'face 'underline)
+ " (" (propertize "CODE RANGE" 'face 'underline) ")\n")
+ (insert " " (propertize "FONT NAME" 'face 'underline)
+ " (" (propertize "REQUESTED" 'face 'underline)
+ " and [" (propertize "OPENED" 'face 'underline) "])")
+ (let ((info (fontset-info fontset)))
+ (describe-vector info 'print-fontset-element)
+ (insert "\n ---<fallback to the default fontset>---")
+ (describe-vector (char-table-extra-slot info 0) 'print-fontset-element)))
;;;###autoload
(defun describe-fontset (fontset)
(insert-section 4 "Coding systems")
(list-coding-systems-1 t)
- (princ "\
-############################
-## LIST OF CODING CATEGORIES (ordered by priority)
-## CATEGORY:CODING-SYSTEM
-##
-")
- (let ((l coding-category-list))
- (while l
- (princ (format "%s:%s\n" (car l) (symbol-value (car l))))
- (setq l (cdr l))))
(insert "\n")
(insert-section 5 "Character sets")
(setq fontsets (cdr fontsets)))))
(print-help-return-message))))
+;;;###autoload
+(defcustom unicodedata-file nil
+ "Location of UnicodeData file.
+This is the UnicodeData.txt file from the Unicode consortium, used for
+diagnostics. If it is non-nil `describe-char-after' will print data
+looked up from it."
+ :group 'mule
+ :type '(choice (const :tag "None" nil)
+ file))
+
+;; We could convert the unidata file into a Lispy form once-for-all
+;; and distribute it for loading on demand. It might be made more
+;; space-efficient by splitting strings word-wise and replacing them
+;; with lists of symbols interned in a private obarray, e.g.
+;; "LATIN SMALL LETTER A" => '(LATIN SMALL LETTER A).
+
+;;;###autoload
+(defun unicode-data (char)
+ "Return a list of Unicode data for unicode CHAR.
+Each element is a list of a property description and the property value.
+The list is null if CHAR isn't found in `unicodedata-file'."
+ (when unicodedata-file
+ (unless (file-exists-p unicodedata-file)
+ (error "`unicodedata-file' %s not found" unicodedata-file))
+ (save-excursion
+ (set-buffer (find-file-noselect unicodedata-file t t))
+ (goto-char (point-min))
+ (let ((hex (format "%04X" char))
+ found first last)
+ (if (re-search-forward (concat "^" hex) nil t)
+ (setq found t)
+ ;; It's not listed explicitly. Look for ranges, e.g. CJK
+ ;; ideographs, and check whether it's in one of them.
+ (while (and (re-search-forward "^\\([^;]+\\);[^;]+First>;" nil t)
+ (>= char (setq first
+ (string-to-number (match-string 1) 16)))
+ (progn
+ (forward-line 1)
+ (looking-at "^\\([^;]+\\);[^;]+Last>;")
+ (> char
+ (setq last
+ (string-to-number (match-string 1) 16))))))
+ (if (and (>= char first)
+ (<= char last))
+ (setq found t)))
+ (if found
+ (let ((fields (mapcar (lambda (elt)
+ (if (> (length elt) 0)
+ elt))
+ (cdr (split-string
+ (buffer-substring
+ (line-beginning-position)
+ (line-end-position))
+ ";")))))
+ ;; The length depends on whether the last field was empty.
+ (unless (or (= 13 (length fields))
+ (= 14 (length fields)))
+ (error "Invalid contents in %s" unicodedata-file))
+ ;; The field names and values lists are slightly
+ ;; modified from Mule-UCS unidata.el.
+ (list
+ (list "Name" (let ((name (nth 0 fields)))
+ ;; Check for <..., First>, <..., Last>
+ (if (string-match "\\`\\(<[^,]+\\)," name)
+ (concat (match-string 1 name) ">")
+ name)))
+ (list "Category"
+ (cdr (assoc
+ (nth 1 fields)
+ '(("Lu" . "uppercase letter")
+ ("Ll" . "lowercase letter")
+ ("Lt" . "titlecase letter")
+ ("Mn" . "non-spacing mark")
+ ("Mc" . "spacing-combining mark")
+ ("Me" . "enclosing mark")
+ ("Nd" . "decimal digit")
+ ("Nl" . "letter number")
+ ("No" . "other number")
+ ("Zs" . "space separator")
+ ("Zl" . "line separator")
+ ("Zp" . "paragraph separator")
+ ("Cc" . "other control")
+ ("Cf" . "other format")
+ ("Cs" . "surrogate")
+ ("Co" . "private use")
+ ("Cn" . "not assigned")
+ ("Lm" . "modifier letter")
+ ("Lo" . "other letter")
+ ("Pc" . "connector punctuation")
+ ("Pd" . "dash punctuation")
+ ("Ps" . "open punctuation")
+ ("Pe" . "close punctuation")
+ ("Pi" . "initial-quotation punctuation")
+ ("Pf" . "final-quotation punctuation")
+ ("Po" . "other punctuation")
+ ("Sm" . "math symbol")
+ ("Sc" . "currency symbol")
+ ("Sk" . "modifier symbol")
+ ("So" . "other symbol")))))
+ (list "Combining class"
+ (cdr (assoc
+ (string-to-number (nth 2 fields))
+ '((0 . "Spacing")
+ (1 . "Overlays and interior")
+ (7 . "Nuktas")
+ (8 . "Hiragana/Katakana voicing marks")
+ (9 . "Viramas")
+ (10 . "Start of fixed position classes")
+ (199 . "End of fixed position classes")
+ (200 . "Below left attached")
+ (202 . "Below attached")
+ (204 . "Below right attached")
+ (208 . "Left attached (reordrant around \
+single base character)")
+ (210 . "Right attached")
+ (212 . "Above left attached")
+ (214 . "Above attached")
+ (216 . "Above right attached")
+ (218 . "Below left")
+ (220 . "Below")
+ (222 . "Below right")
+ (224 . "Left (reordrant around single base \
+character)")
+ (226 . "Right")
+ (228 . "Above left")
+ (230 . "Above")
+ (232 . "Above right")
+ (233 . "Double below")
+ (234 . "Double above")
+ (240 . "Below (iota subscript)")))))
+ (list "Bidi category"
+ (cdr (assoc
+ (nth 3 fields)
+ '(("L" . "Left-to-Right")
+ ("LRE" . "Left-to-Right Embedding")
+ ("LRO" . "Left-to-Right Override")
+ ("R" . "Right-to-Left")
+ ("AL" . "Right-to-Left Arabic")
+ ("RLE" . "Right-to-Left Embedding")
+ ("RLO" . "Right-to-Left Override")
+ ("PDF" . "Pop Directional Format")
+ ("EN" . "European Number")
+ ("ES" . "European Number Separator")
+ ("ET" . "European Number Terminator")
+ ("AN" . "Arabic Number")
+ ("CS" . "Common Number Separator")
+ ("NSM" . "Non-Spacing Mark")
+ ("BN" . "Boundary Neutral")
+ ("B" . "Paragraph Separator")
+ ("S" . "Segment Separator")
+ ("WS" . "Whitespace")
+ ("ON" . "Other Neutrals")))))
+ (list "Decomposition"
+ (if (nth 4 fields)
+ (let* ((parts (split-string (nth 4 fields)))
+ (info (car parts)))
+ (if (string-match "\\`<\\(.+\\)>\\'" info)
+ (setq info (match-string 1 info))
+ (setq info nil))
+ (if info (setq parts (cdr parts)))
+ (setq parts (mapconcat
+ (lambda (arg)
+ (string (string-to-number arg 16)))
+ parts " "))
+ (concat info parts))))
+ (list "Decimal digit value"
+ (nth 5 fields))
+ (list "Digit value"
+ (nth 6 fields))
+ (list "Numeric value"
+ (nth 7 fields))
+ (list "Mirrored"
+ (if (equal "Y" (nth 8 fields))
+ "yes"))
+ (list "Old name" (nth 9 fields))
+ (list "ISO 10646 comment" (nth 10 fields))
+ (list "Uppercase" (and (nth 11 fields)
+ (string (string-to-number
+ (nth 11 fields) 16))))
+ (list "Lowercase" (and (nth 12 fields)
+ (string (string-to-number
+ (nth 12 fields) 16))))
+ (list "Titlecase" (and (nth 13 fields)
+ (string (string-to-number
+ (nth 13 fields) 16)))))))))))
+
(provide 'mule-diag)
;;; arch-tag: cd3b607c-2893-45a0-a4fa-a6535754dbee
;;; mule-util.el --- utility functions for mulitilingual environment (mule)
;; Copyright (C) 1997, 1998, 2000, 2001, 2002, 2003, 2004,
- ;; 2005, 2006, 2007 Free Software Foundation, Inc.
+ ;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- ;; 2005, 2006, 2007
+ ;; 2005, 2006, 2007, 2008
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
+;; Copyright (C) 2003
+;; National Institute of Advanced Industrial Science and Technology (AIST)
+;; Registration Number H13PRO009
;; Keywords: mule, multilingual
;; (("foobarbaz" 6 nil nil "...") . "foo...")
;; (("foobarbaz" 7 2 nil "...") . "ob...")
;; (("foobarbaz" 9 3 nil "...") . "barbaz")
-;; (("\e$B$3\e(Bh\e$B$s\e(Be\e$B$K\e(Bl\e$B$A\e(Bl\e$B$O\e(Bo" 15 1 ? t) . " h\e$B$s\e(Be\e$B$K\e(Bl\e$B$A\e(Bl\e$B$O\e(Bo")
-;; (("\e$B$3\e(Bh\e$B$s\e(Be\e$B$K\e(Bl\e$B$A\e(Bl\e$B$O\e(Bo" 14 1 ? t) . " h\e$B$s\e(Be\e$B$K\e(Bl\e$B$A\e(B...")
-;; (("x" 3 nil nil "\e$(0GnM$\e(B") . "x")
-;; (("\e$AVP\e(B" 2 nil nil "\e$(0GnM$\e(B") . "\e$AVP\e(B")
-;; (("\e$AVP\e(B" 1 nil ?x "\e$(0GnM$\e(B") . "x") ;; XEmacs error
-;; (("\e$AVPND\e(B" 3 nil ? "\e$(0GnM$\e(B") . "\e$AVP\e(B ") ;; XEmacs error
-;; (("foobarbaz" 4 nil nil "\e$(0GnM$\e(B") . "\e$(0GnM$\e(B")
-;; (("foobarbaz" 5 nil nil "\e$(0GnM$\e(B") . "f\e$(0GnM$\e(B")
-;; (("foobarbaz" 6 nil nil "\e$(0GnM$\e(B") . "fo\e$(0GnM$\e(B")
-;; (("foobarbaz" 8 3 nil "\e$(0GnM$\e(B") . "b\e$(0GnM$\e(B")
-;; (("\e$B$3\e(Bh\e$B$s\e(Be\e$B$K\e(Bl\e$B$A\e(Bl\e$B$O\e(Bo" 14 4 ?x "\e$BF|K\8l\e(B") . "xe\e$B$KF|K\8l\e(B")
-;; (("\e$B$3\e(Bh\e$B$s\e(Be\e$B$K\e(Bl\e$B$A\e(Bl\e$B$O\e(Bo" 13 4 ?x "\e$BF|K\8l\e(B") . "xex\e$BF|K\8l\e(B")
+;; (("\e$A$3\e(Bh\e$A$s\e(Be\e$A$K\e(Bl\e$A$A\e(Bl\e$A$O\e(Bo" 15 1 ? t) . " h\e$A$s\e(Be\e$A$K\e(Bl\e$A$A\e(Bl\e$A$O\e(Bo")
+;; (("\e$A$3\e(Bh\e$A$s\e(Be\e$A$K\e(Bl\e$A$A\e(Bl\e$A$O\e(Bo" 14 1 ? t) . " h\e$A$s\e(Be\e$A$K\e(Bl\e$A$A\e(B...")
+;; (("x" 3 nil nil "\e$(Gemk#\e(B") . "x")
+;; (("\e$AVP\e(B" 2 nil nil "\e$(Gemk#\e(B") . "\e$AVP\e(B")
+;; (("\e$AVP\e(B" 1 nil ?x "\e$(Gemk#\e(B") . "x") ;; XEmacs error
+;; (("\e$AVPND\e(B" 3 nil ? "\e$(Gemk#\e(B") . "\e$AVP\e(B ") ;; XEmacs error
+;; (("foobarbaz" 4 nil nil "\e$(Gemk#\e(B") . "\e$(Gemk#\e(B")
+;; (("foobarbaz" 5 nil nil "\e$(Gemk#\e(B") . "f\e$(Gemk#\e(B")
+;; (("foobarbaz" 6 nil nil "\e$(Gemk#\e(B") . "fo\e$(Gemk#\e(B")
+;; (("foobarbaz" 8 3 nil "\e$(Gemk#\e(B") . "b\e$(Gemk#\e(B")
+;; (("\e$A$3\e(Bh\e$A$s\e(Be\e$A$K\e(Bl\e$A$A\e(Bl\e$A$O\e(Bo" 14 4 ?x "\e$AHU1>\e$(Gk#\e(B") . "xe\e$A$KHU1>\e$(Gk#\e(B")
+;; (("\e$A$3\e(Bh\e$A$s\e(Be\e$A$K\e(Bl\e$A$A\e(Bl\e$A$O\e(Bo" 13 4 ?x "\e$AHU1>\e$(Gk#\e(B") . "xex\e$AHU1>\e$(Gk#\e(B")
;; ))
;; (let (ret)
;; (condition-case e
;;;###autoload
(defun coding-system-post-read-conversion (coding-system)
"Return the value of CODING-SYSTEM's `post-read-conversion' property."
- (coding-system-get coding-system 'post-read-conversion))
+ (coding-system-get coding-system :post-read-conversion))
;;;###autoload
(defun coding-system-pre-write-conversion (coding-system)
"Return the value of CODING-SYSTEM's `pre-write-conversion' property."
- (coding-system-get coding-system 'pre-write-conversion))
+ (coding-system-get coding-system :pre-write-conversion))
;;;###autoload
(defun coding-system-translation-table-for-decode (coding-system)
- "Return the value of CODING-SYSTEM's `translation-table-for-decode' property."
- (coding-system-get coding-system 'translation-table-for-decode))
+ "Return the value of CODING-SYSTEM's `decode-translation-table' property."
+ (coding-system-get coding-system :decode-translation-table))
;;;###autoload
(defun coding-system-translation-table-for-encode (coding-system)
- "Return the value of CODING-SYSTEM's `translation-table-for-encode' property."
- (coding-system-get coding-system 'translation-table-for-encode))
+ "Return the value of CODING-SYSTEM's `encode-translation-table' property."
+ (coding-system-get coding-system :encode-translation-table))
+
+;;;###autoload
+(defmacro with-coding-priority (coding-systems &rest body)
+ "Execute BODY like `progn' with CODING-SYSTEMS at the front of priority list.
+CODING-SYSTEMS is a list of coding systems. See
+`set-coding-priority'. This affects the implicit sorting of lists of
+coding sysems returned by operations such as `find-coding-systems-region'."
+ (let ((current (make-symbol "current")))
+ `(let ((,current (coding-system-priority-list)))
+ (apply #'set-coding-system-priority ,coding-systems)
+ (unwind-protect
+ (progn ,@body)
+ (apply #'set-coding-system-priority ,current)))))
+(put 'with-coding-priority 'lisp-indent-function 1)
+(put 'with-coding-priority 'edebug-form-spec t)
;;;###autoload
(defmacro detect-coding-with-priority (from to priority-list)
"Detect a coding system of the text between FROM and TO with PRIORITY-LIST.
PRIORITY-LIST is an alist of coding categories vs the corresponding
coding systems ordered by priority."
- `(unwind-protect
- (let* ((prio-list ,priority-list)
- (coding-category-list coding-category-list)
- ,@(mapcar (function (lambda (x) (list x x)))
- coding-category-list))
- (mapc (function (lambda (x) (set (car x) (cdr x))))
- prio-list)
- (set-coding-priority (mapcar #'car prio-list))
- ;; Changing the binding of a coding category requires this call.
- (update-coding-systems-internal)
- (detect-coding-region ,from ,to))
- ;; We must restore the internal database.
- (set-coding-priority coding-category-list)
- (update-coding-systems-internal)))
+ `(with-coding-priority (mapcar #'cdr ,priority-list)
+ (detect-coding-region ,from ,to)))
+(make-obsolete 'detect-coding-with-priority
+ "Use with-coding-priority and detect-coding-region" "23.1")
;;;###autoload
(defun detect-coding-with-language-environment (from to lang-env)
- "Detect a coding system of the text between FROM and TO with LANG-ENV.
+ "Detect a coding system for the text between FROM and TO with LANG-ENV.
The detection takes into account the coding system priorities for the
language environment LANG-ENV."
(let ((coding-priority (get-language-info lang-env 'coding-priority)))
(if coding-priority
- (detect-coding-with-priority
- from to
- (mapcar (function (lambda (x)
- (cons (coding-system-get x 'coding-category) x)))
- coding-priority))
- (detect-coding-region from to))))
+ (with-coding-priority coding-priority
+ (detect-coding-region from to)))))
;;;###autoload
(defun char-displayable-p (char)
;; currently selected frame.
(car (internal-char-font nil char)))
(t
- (let ((coding (terminal-coding-system)))
+ (let ((coding 'iso-2022-7bit))
(if coding
- (let ((safe-chars (coding-system-get coding 'safe-chars))
- (safe-charsets (coding-system-get coding 'safe-charsets)))
- (or (and safe-chars
- (aref safe-chars char))
- (and safe-charsets
- (memq (char-charset char) safe-charsets)))))))))
+ (let ((cs-list (coding-system-get coding :charset-list)))
+ (cond
+ ((listp cs-list)
+ (catch 'tag
+ (mapc #'(lambda (charset)
+ (if (encode-char char charset)
+ (throw 'tag charset)))
+ cs-list)
+ nil))
+ ((eq cs-list 'iso-2022)
+ (catch 'tag2
+ (mapc #'(lambda (charset)
+ (if (and (plist-get (charset-plist charset)
+ :iso-final-char)
+ (encode-char char charset))
+ (throw 'tag2 charset)))
+ charset-list)
+ nil))
+ ((eq cs-list 'emacs-mule)
+ (catch 'tag3
+ (mapc #'(lambda (charset)
+ (if (and (plist-get (charset-plist charset)
+ :emacs-mule-id)
+ (encode-char char charset))
+ (throw 'tag3 charset)))
+ charset-list)
+ nil)))))))))
\f
(provide 'mule-util)
-;;; mule.el --- basic commands for mulitilingual environment
+;;; mule.el --- basic commands for multilingual environment
- ;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ ;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
;; Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- ;; 2005, 2006, 2007
+ ;; 2005, 2006, 2007, 2008
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
+;; Copyright (C) 2003
+;; National Institute of Advanced Industrial Science and Technology (AIST)
+;; Registration Number H13PRO009
;; Keywords: mule, multilingual, character set, coding system
;;; Code:
-(defconst mule-version "5.0 (SAKAKI)" "\
+(defconst mule-version "6.0 (HANACHIRUSATO)" "\
Version number and name of this version of MULE (multilingual environment).")
-(defconst mule-version-date "1999.12.7" "\
+(defconst mule-version-date "2003.9.1" "\
Distribution date of this version of MULE (multilingual environment).")
+\f
+;;; CHARSET
+
+;; Backward compatibility code for handling emacs-mule charsets.
+(defvar private-char-area-1-min #xF0000)
+(defvar private-char-area-1-max #xFFFFE)
+(defvar private-char-area-2-min #x100000)
+(defvar private-char-area-2-max #x10FFFE)
+
+;; Table of emacs-mule charsets indexed by their emacs-mule ID.
+(defvar emacs-mule-charset-table (make-vector 256 nil))
+(aset emacs-mule-charset-table 0 'ascii)
+
+;; Convert the argument of old-style calll of define-charset to a
+;; property list used by the new-style.
+;; INFO-VECTOR is a vector of the format:
+;; [DIMENSION CHARS WIDTH DIRECTION ISO-FINAL-CHAR ISO-GRAPHIC-PLANE
+;; SHORT-NAME LONG-NAME DESCRIPTION]
+
+(defun convert-define-charset-argument (emacs-mule-id info-vector)
+ (let* ((dim (aref info-vector 0))
+ (chars (aref info-vector 1))
+ (total (if (= dim 1) chars (* chars chars)))
+ (code-space (if (= dim 1) (if (= chars 96) [32 127] [33 126])
+ (if (= chars 96) [32 127 32 127] [33 126 33 126])))
+ code-offset)
+ (if (integerp emacs-mule-id)
+ (or (= emacs-mule-id 0)
+ (and (>= emacs-mule-id 129) (< emacs-mule-id 256))
+ (error "Invalid CHARSET-ID: %d" emacs-mule-id))
+ (let (from-id to-id)
+ (if (= dim 1) (setq from-id 160 to-id 224)
+ (setq from-id 224 to-id 255))
+ (while (and (< from-id to-id)
+ (not (aref emacs-mule-charset-table from-id)))
+ (setq from-id (1+ from-id)))
+ (if (= from-id to-id)
+ (error "No more room for the new Emacs-mule charset"))
+ (setq emacs-mule-id from-id)))
+ (if (> (- private-char-area-1-max private-char-area-1-min) total)
+ (setq code-offset private-char-area-1-min
+ private-char-area-1-min (+ private-char-area-1-min total))
+ (if (> (- private-char-area-2-max private-char-area-2-min) total)
+ (setq code-offset private-char-area-2-min
+ private-char-area-2-min (+ private-char-area-2-min total))
+ (error "No more space for a new charset.")))
+ (list :dimension dim
+ :code-space code-space
+ :iso-final-char (aref info-vector 4)
+ :code-offset code-offset
+ :emacs-mule-id emacs-mule-id)))
+
+(defun define-charset (name docstring &rest props)
+ "Define NAME (symbol) as a charset with DOCSTRING.
+The remaining arguments must come in pairs ATTRIBUTE VALUE. ATTRIBUTE
+may be any symbol. The following have special meanings, and one of
+`:code-offset', `:map', `:subset', `:superset' must be specified.
+
+`:short-name'
+
+VALUE must be a short string to identify the charset. If omitted,
+NAME is used.
+
+`:long-name'
+
+VALUE must be a string longer than `:short-name' to identify the
+charset. If omitted, the value of the `:short-name' attribute is used.
+
+`:dimension'
+
+VALUE must be an integer 0, 1, 2, or 3, specifying the dimension of
+code-points of the charsets. If omitted, it is calculated from the
+value of the `:code-space' attribute.
+
+`:code-space'
+
+VALUE must be a vector of length at most 8 specifying the byte code
+range of each dimension in this format:
+ [ MIN-1 MAX-1 MIN-2 MAX-2 ... ]
+where MIN-N is the minimum byte value of Nth dimension of code-point,
+MAX-N is the maximum byte value of that.
+
+`:min-code'
+
+VALUE must be an integer specifying the mininum code point of the
+charset. If omitted, it is calculated from `:code-space'. VALUE may
+be a cons (HIGH . LOW), where HIGH is the most significant 16 bits of
+the code point and LOW is the least significant 16 bits.
+
+`:max-code'
+
+VALUE must be an integer specifying the maxinum code point of the
+charset. If omitted, it is calculated from `:code-space'. VALUE may
+be a cons (HIGH . LOW), where HIGH is the most significant 16 bits of
+the code point and LOW is the least significant 16 bits.
+
+`:iso-final-char'
+
+VALUE must be a character in the range 32 to 127 (inclusive)
+specifying the final char of the charset for ISO-2022 encoding. If
+omitted, the charset can't be encoded by ISO-2022 based
+coding-systems.
+
+`:iso-revision-number'
+
+VALUE must be an integer in the range 0..63, specifying the revision
+number of the charset for ISO-2022 encoding.
+
+`:emacs-mule-id'
+
+VALUE must be an integer of 0, 129..255. If omitted, the charset
+can't be encoded by coding-systems of type `emacs-mule'.
+
+`:ascii-compatible-p'
+
+VALUE must be nil or t (default nil). If VALUE is t, the charset is
+compatible with ASCII, i.e. the first 128 code points map to ASCII.
+
+`:supplementary-p'
+
+VALUE must be nil or t. If the VALUE is t, the charset is
+supplementary, which means it is used only as a parent or a
+subset of some other charset, or it is provided just for backward
+compatibility.
+
+`:invalid-code'
+
+VALUE must be a nonnegative integer that can be used as an invalid
+code point of the charset. If the minimum code is 0 and the maximum
+code is greater than Emacs' maximum integer value, `:invalid-code'
+should not be omitted.
+
+`:code-offset'
+
+VALUE must be an integer added to the index number of a character to
+get the corresponding character code.
+
+`:map'
+
+VALUE must be vector or string.
+
+If it is a vector, the format is [ CODE-1 CHAR-1 CODE-2 CHAR-2 ... ],
+where CODE-n is a code-point of the charset, and CHAR-n is the
+corresponding character code.
+
+If it is a string, it is a name of file that contains the above
+information. Each line of the file must be this format:
+ 0xXXX 0xYYY
+where XXX is a hexadecimal representation of CODE-n and YYY is a
+hexadecimal representation of CHAR-n. A line starting with `#' is a
+comment line.
+
+`:subset'
+
+VALUE must be a list:
+ ( PARENT MIN-CODE MAX-CODE OFFSET )
+PARENT is a parent charset. MIN-CODE and MAX-CODE specify the range
+of characters inherited from the parent. OFFSET is an integer value
+to add to a code point of the parent charset to get the corresponding
+code point of this charset.
+
+`:superset'
+
+VALUE must be a list of parent charsets. The charset inherits
+characters from them. Each element of the list may be a cons (PARENT
+. OFFSET), where PARENT is a parent charset, and OFFSET is an offset
+value to add to a code point of PARENT to get the corresponding code
+point of this charset.
+
+`:unify-map'
+
+VALUE must be vector or string.
+
+If it is a vector, the format is [ CODE-1 CHAR-1 CODE-2 CHAR-2 ... ],
+where CODE-n is a code-point of the charset, and CHAR-n is the
+corresponding Unicode character code.
+
+If it is a string, it is a name of file that contains the above
+information. The file format is the same as what described for `:map'
+attribute."
+ (when (vectorp (car props))
+ ;; Old style code:
+ ;; (define-charset CHARSET-ID CHARSET-SYMBOL INFO-VECTOR)
+ ;; Convert the argument to make it fit with the current style.
+ (let ((vec (car props)))
+ (setq props (convert-define-charset-argument name vec)
+ name docstring
+ docstring (aref vec 8))))
+ (let ((attrs (mapcar 'list '(:dimension
+ :code-space
+ :min-code
+ :max-code
+ :iso-final-char
+ :iso-revision-number
+ :emacs-mule-id
+ :ascii-compatible-p
+ :supplementary-p
+ :invalid-code
+ :code-offset
+ :map
+ :subset
+ :superset
+ :unify-map
+ :plist))))
+
+ ;; If :dimension is omitted, get the dimension from :code-space.
+ (let ((dimension (plist-get props :dimension)))
+ (or dimension
+ (let ((code-space (plist-get props :code-space)))
+ (setq dimension (if code-space (/ (length code-space) 2) 4))
+ (setq props (plist-put props :dimension dimension)))))
+
+ (let ((code-space (plist-get props :code-space)))
+ (or code-space
+ (let ((dimension (plist-get props :dimension)))
+ (setq code-space (make-vector 8 0))
+ (dotimes (i dimension)
+ (aset code-space (1+ (* i 2)) #xFF))
+ (setq props (plist-put props :code-space code-space)))))
+
+ ;; If :emacs-mule-id is specified, update emacs-mule-charset-table.
+ (let ((emacs-mule-id (plist-get props :emacs-mule-id)))
+ (if (integerp emacs-mule-id)
+ (aset emacs-mule-charset-table emacs-mule-id name)))
+
+ (dolist (slot attrs)
+ (setcdr slot (plist-get props (car slot))))
+
+ ;; Make sure that the value of :code-space is a vector of 8
+ ;; elements.
+ (let* ((slot (assq :code-space attrs))
+ (val (cdr slot))
+ (len (length val)))
+ (if (< len 8)
+ (setcdr slot
+ (vconcat val (make-vector (- 8 len) 0)))))
+
+ ;; Add :name and :docstring properties to PROPS.
+ (setq props
+ (cons :name (cons name (cons :docstring (cons docstring props)))))
+ (or (plist-get props :short-name)
+ (plist-put props :short-name (symbol-name name)))
+ (or (plist-get props :long-name)
+ (plist-put props :long-name (plist-get props :short-name)))
+ ;; We can probably get a worthwhile amount in purespace.
+ (setq props
+ (mapcar (lambda (elt)
+ (if (stringp elt)
+ (purecopy elt)
+ elt))
+ props))
+ (setcdr (assq :plist attrs) props)
+
+ (apply 'define-charset-internal name (mapcar 'cdr attrs))))
+
+
(defun load-with-code-conversion (fullname file &optional noerror nomessage)
"Execute a file of Lisp code named FILE whose absolute name is FULLNAME.
The file contents are decoded before evaluation if necessary.
;; Otherwise, eval-buffer might try to interpret random
;; binary junk as multibyte characters.
(if (and enable-multibyte-characters
- (or (eq (coding-system-type last-coding-system-used) 5)
- (eq last-coding-system-used 'no-conversion)))
+ (or (eq (coding-system-type last-coding-system-used)
+ 'raw-text)))
(set-buffer-multibyte nil))
;; Make `kill-buffer' quiet.
(set-buffer-modified-p nil))
(message "Loading %s...done" file)))
t)))
-;; API (Application Program Interface) for charsets.
-
-(defsubst charset-quoted-standard-p (obj)
- "Return t if OBJ is a quoted symbol, and is the name of a standard charset."
- (and (listp obj) (eq (car obj) 'quote)
- (symbolp (car-safe (cdr obj)))
- (let ((vector (get (car-safe (cdr obj)) 'charset)))
- (and (vectorp vector)
- (< (aref vector 0) 160)))))
-
-(defsubst charsetp (object)
- "Return t if OBJECT is a charset."
- (and (symbolp object) (vectorp (get object 'charset))))
-
-(defsubst charset-info (charset)
+(defun charset-info (charset)
"Return a vector of information of CHARSET.
+This function is provided for backward compatibility.
+
The elements of the vector are:
CHARSET-ID, BYTES, DIMENSION, CHARS, WIDTH, DIRECTION,
LEADING-CODE-BASE, LEADING-CODE-EXT,
ISO-FINAL-CHAR, ISO-GRAPHIC-PLANE,
REVERSE-CHARSET, SHORT-NAME, LONG-NAME, DESCRIPTION,
- PLIST,
+ PLIST.
where
-CHARSET-ID (integer) is the identification number of the charset.
-BYTES (integer) is the length of multi-byte form of a character in
- the charset: one of 1, 2, 3, and 4.
-DIMENSION (integer) is the number of bytes to represent a character of
-the charset: 1 or 2.
-CHARS (integer) is the number of characters in a dimension: 94 or 96.
-WIDTH (integer) is the number of columns a character in the charset
- occupies on the screen: one of 0, 1, and 2.
-DIRECTION (integer) is the rendering direction of characters in the
- charset when rendering. If 0, render from left to right, else
- render from right to left.
-LEADING-CODE-BASE (integer) is the base leading-code for the
- charset.
-LEADING-CODE-EXT (integer) is the extended leading-code for the
- charset. All charsets of less than 0xA0 has the value 0.
+CHARSET-ID is always 0.
+BYTES is always 0.
+DIMENSION is the number of bytes of a code-point of the charset:
+ 1, 2, 3, or 4.
+CHARS is the number of characters in a dimension:
+ 94, 96, 128, or 256.
+WIDTH is always 0.
+DIRECTION is always 0.
+LEADING-CODE-BASE is always 0.
+LEADING-CODE-EXT is always 0.
ISO-FINAL-CHAR (character) is the final character of the
corresponding ISO 2022 charset. If the charset is not assigned
any final character, the value is -1.
-ISO-GRAPHIC-PLANE (integer) is the graphic plane to be invoked
- while encoding to variants of ISO 2022 coding system, one of the
- following: 0/graphic-plane-left(GL), 1/graphic-plane-right(GR).
- If the charset is not assigned any final character, the value is -1.
-REVERSE-CHARSET (integer) is the charset which differs only in
- LEFT-TO-RIGHT value from the charset. If there's no such a
- charset, the value is -1.
+ISO-GRAPHIC-PLANE is always 0.
+REVERSE-CHARSET is always -1.
SHORT-NAME (string) is the short name to refer to the charset.
LONG-NAME (string) is the long name to refer to the charset
DESCRIPTION (string) is the description string of the charset.
PLIST (property list) may contain any type of information a user
want to put and get by functions `put-charset-property' and
`get-charset-property' respectively."
- (get charset 'charset))
+ (vector 0
+ 0
+ (charset-dimension charset)
+ (charset-chars charset)
+ 0
+ 0
+ 0
+ 0
+ (charset-iso-final-char charset)
+ 0
+ -1
+ (get-charset-property charset :short-name)
+ (get-charset-property charset :short-name)
+ (charset-description charset)
+ (charset-plist charset)))
;; It is better not to use backquote in this file,
;; because that makes a bootstrapping problem
;; if you need to recompile all the Lisp files using interpreted code.
-(defmacro charset-id (charset)
- "Return charset identification number of CHARSET."
- (if (charset-quoted-standard-p charset)
- (aref (charset-info (nth 1 charset)) 0)
- (list 'aref (list 'charset-info charset) 0)))
+(defun charset-id (charset)
+ "Always return 0. This is provided for backward compatibility."
+ 0)
(defmacro charset-bytes (charset)
- "Return bytes of CHARSET.
-See the function `charset-info' for more detail."
- (if (charset-quoted-standard-p charset)
- (aref (charset-info (nth 1 charset)) 1)
- (list 'aref (list 'charset-info charset) 1)))
-
-(defmacro charset-dimension (charset)
- "Return dimension of CHARSET.
-See the function `charset-info' for more detail."
- (if (charset-quoted-standard-p charset)
- (aref (charset-info (nth 1 charset)) 2)
- (list 'aref (list 'charset-info charset) 2)))
-
-(defmacro charset-chars (charset)
- "Return character numbers contained in a dimension of CHARSET.
-See the function `charset-info' for more detail."
- (if (charset-quoted-standard-p charset)
- (aref (charset-info (nth 1 charset)) 3)
- (list 'aref (list 'charset-info charset) 3)))
-
-(defmacro charset-width (charset)
- "Return width (how many column occupied on a screen) of CHARSET.
-See the function `charset-info' for more detail."
- (if (charset-quoted-standard-p charset)
- (aref (charset-info (nth 1 charset)) 4)
- (list 'aref (list 'charset-info charset) 4)))
-
-(defmacro charset-direction (charset)
- "Return direction of CHARSET.
-See the function `charset-info' for more detail."
- (if (charset-quoted-standard-p charset)
- (aref (charset-info (nth 1 charset)) 5)
- (list 'aref (list 'charset-info charset) 5)))
-
-(defmacro charset-iso-final-char (charset)
- "Return final char of CHARSET.
-See the function `charset-info' for more detail."
- (if (charset-quoted-standard-p charset)
- (aref (charset-info (nth 1 charset)) 8)
- (list 'aref (list 'charset-info charset) 8)))
-
-(defmacro charset-iso-graphic-plane (charset)
- "Return graphic plane of CHARSET.
-See the function `charset-info' for more detail."
- (if (charset-quoted-standard-p charset)
- (aref (charset-info (nth 1 charset)) 9)
- (list 'aref (list 'charset-info charset) 9)))
-
-(defmacro charset-reverse-charset (charset)
- "Return reverse charset of CHARSET.
-See the function `charset-info' for more detail."
- (if (charset-quoted-standard-p charset)
- (aref (charset-info (nth 1 charset)) 10)
- (list 'aref (list 'charset-info charset) 10)))
+ "Always return 0. This is provided for backward compatibility."
+ 0)
+
+(defun get-charset-property (charset propname)
+ "Return the value of CHARSET's PROPNAME property.
+This is the last value stored with
+ (put-charset-property CHARSET PROPNAME VALUE)."
+ (plist-get (charset-plist charset) propname))
+
+(defun put-charset-property (charset propname value)
+ "Set CHARSETS's PROPNAME property to value VALUE.
+It can be retrieved with `(get-charset-property CHARSET PROPNAME)'."
+ (set-charset-plist charset
+ (plist-put (charset-plist charset) propname value)))
+
+(defun charset-description (charset)
+ "Return description string of CHARSET."
+ (plist-get (charset-plist charset) :docstring))
+
+(defun charset-dimension (charset)
+ "Return dimension of CHARSET."
+ (plist-get (charset-plist charset) :dimension))
+
+(defun charset-chars (charset &optional dimension)
+ "Return number of characters contained in DIMENSION of CHARSET.
+DIMENSION defaults to the first dimension."
+ (unless dimension (setq dimension 1))
+ (let ((code-space (plist-get (charset-plist charset) :code-space)))
+ (1+ (- (aref code-space (1- (* 2 dimension)))
+ (aref code-space (- (* 2 dimension) 2))))))
+
+(defun charset-iso-final-char (charset)
+ "Return ISO-2022 final character of CHARSET.
+Return -1 if charset isn't an ISO 2022 one."
+ (or (plist-get (charset-plist charset) :iso-final-char)
+ -1))
(defmacro charset-short-name (charset)
- "Return short name of CHARSET.
-See the function `charset-info' for more detail."
- (if (charset-quoted-standard-p charset)
- (aref (charset-info (nth 1 charset)) 11)
- (list 'aref (list 'charset-info charset) 11)))
+ "Return short name of CHARSET."
+ (plist-get (charset-plist charset) :short-name))
(defmacro charset-long-name (charset)
- "Return long name of CHARSET.
-See the function `charset-info' for more detail."
- (if (charset-quoted-standard-p charset)
- (aref (charset-info (nth 1 charset)) 12)
- (list 'aref (list 'charset-info charset) 12)))
-
-(defmacro charset-description (charset)
- "Return description of CHARSET.
-See the function `charset-info' for more detail."
- (if (charset-quoted-standard-p charset)
- (aref (charset-info (nth 1 charset)) 13)
- (list 'aref (list 'charset-info charset) 13)))
-
-(defmacro charset-plist (charset)
- "Return list charset property of CHARSET.
-See the function `charset-info' for more detail."
- (list 'aref
- (if (charset-quoted-standard-p charset)
- (charset-info (nth 1 charset))
- (list 'charset-info charset))
- 14))
-
-(defun set-charset-plist (charset plist)
- "Set CHARSET's property list to PLIST, and return PLIST."
- (aset (charset-info charset) 14 plist))
-
-(defun make-char (charset &optional code1 code2)
- "Return a character of CHARSET whose position codes are CODE1 and CODE2.
-CODE1 and CODE2 are optional, but if you don't supply
-sufficient position codes, return a generic character which stands for
-all characters or group of characters in the character set.
-A generic character can be used to index a char table (e.g. `syntax-table').
-
-Such character sets as ascii, eight-bit-control, and eight-bit-graphic
-don't have corresponding generic characters. If CHARSET is one of
-them and you don't supply CODE1, return the character of the smallest
-code in CHARSET.
-
-If CODE1 or CODE2 are invalid (out of range), this function signals an
-error. However, the eighth bit of both CODE1 and CODE2 is zeroed
-before they are used to index CHARSET. Thus you may use, say, the
-actual ISO 8859 character code rather than subtracting 128, as you
-would need to index the corresponding Emacs charset."
- (make-char-internal (charset-id charset) code1 code2))
-
-(put 'make-char 'byte-compile
- (lambda (form)
- (let ((charset (nth 1 form)))
- (byte-compile-normal-call
- (cons 'make-char-internal
- (cons (if (charset-quoted-standard-p charset)
- (charset-id (nth 1 charset))
- (list 'charset-id charset))
- (nthcdr 2 form)))))))
+ "Return long name of CHARSET."
+ (plist-get (charset-plist charset) :long-name))
(defun charset-list ()
- "Return list of charsets ever defined.
+ "Return list of all charsets ever defined.
This function is provided for backward compatibility.
Now we have the variable `charset-list'."
charset-list)
+(make-obsolete 'charset-list "Use variable `charset-list'" "23.1")
-(defsubst generic-char-p (char)
- "Return t if and only if CHAR is a generic character.
-See also the documentation of `make-char'."
- (and (>= char 0400)
- (let ((l (split-char char)))
- (and (or (= (nth 1 l) 0) (eq (nth 2 l) 0))
- (not (eq (car l) 'composition))))))
-
-(defun decode-char (ccs code-point &optional restriction)
- "Return character specified by coded character set CCS and CODE-POINT in it.
-Return nil if such a character is not supported.
-Currently the only supported coded character set is `ucs' (ISO/IEC
-10646: Universal Multi-Octet Coded Character Set), and the result is
-translated through the translation-table named
-`utf-translation-table-for-decode', or through the
-translation-hash-table named `utf-subst-table-for-decode'
-\(if `utf-translate-cjk-mode' is non-nil).
-
-Optional argument RESTRICTION specifies a way to map the pair of CCS
-and CODE-POINT to a character. Currently not supported and just ignored."
- (cond
- ((eq ccs 'ucs)
- (or (and utf-translate-cjk-mode
- (utf-lookup-subst-table-for-decode code-point))
- (let ((c (cond
- ((< code-point 160)
- code-point)
- ((< code-point 256)
- (make-char 'latin-iso8859-1 code-point))
- ((< code-point #x2500)
- (setq code-point (- code-point #x0100))
- (make-char 'mule-unicode-0100-24ff
- (+ (/ code-point 96) 32) (+ (% code-point 96) 32)))
- ((< code-point #x3400)
- (setq code-point (- code-point #x2500))
- (make-char 'mule-unicode-2500-33ff
- (+ (/ code-point 96) 32) (+ (% code-point 96) 32)))
- ((and (>= code-point #xe000) (< code-point #x10000))
- (setq code-point (- code-point #xe000))
- (make-char 'mule-unicode-e000-ffff
- (+ (/ code-point 96) 32)
- (+ (% code-point 96) 32))))))
- (when c
- (or (aref (get 'utf-translation-table-for-decode
- 'translation-table) c)
- c)))))))
-
-(defun encode-char (char ccs &optional restriction)
- "Return code-point in coded character set CCS that corresponds to CHAR.
-Return nil if CHAR is not included in CCS.
-Currently the only supported coded character set is `ucs' (ISO/IEC
-10646: Universal Multi-Octet Coded Character Set), and CHAR is first
-translated through the translation-table named
-`utf-translation-table-for-encode', or through the
-translation-hash-table named `utf-subst-table-for-encode' \(if
-`utf-translate-cjk-mode' is non-nil).
-
-CHAR should be in one of these charsets:
- ascii, latin-iso8859-1, mule-unicode-0100-24ff, mule-unicode-2500-33ff,
- mule-unicode-e000-ffff, eight-bit-control
-Otherwise, return nil.
-
-Optional argument RESTRICTION specifies a way to map CHAR to a
-code-point in CCS. Currently not supported and just ignored."
- (let* ((split (split-char char))
- (charset (car split))
- trans)
- (cond ((eq ccs 'ucs)
- (or (and utf-translate-cjk-mode
- (utf-lookup-subst-table-for-encode char))
- (let ((table (get 'utf-translation-table-for-encode
- 'translation-table)))
- (setq trans (aref table char))
- (if trans
- (setq split (split-char trans)
- charset (car split)))
- (cond ((eq charset 'ascii)
- (or trans char))
- ((eq charset 'latin-iso8859-1)
- (+ (nth 1 split) 128))
- ((eq charset 'mule-unicode-0100-24ff)
- (+ #x0100 (+ (* (- (nth 1 split) 32) 96)
- (- (nth 2 split) 32))))
- ((eq charset 'mule-unicode-2500-33ff)
- (+ #x2500 (+ (* (- (nth 1 split) 32) 96)
- (- (nth 2 split) 32))))
- ((eq charset 'mule-unicode-e000-ffff)
- (+ #xe000 (+ (* (- (nth 1 split) 32) 96)
- (- (nth 2 split) 32))))
- ((eq charset 'eight-bit-control)
- char))))))))
+\f
+;;; CHARACTER
+(defalias 'char-valid-p 'characterp)
+(make-obsolete 'char-valid-p 'characterp "23.1")
+
+(defun generic-char-p (char)
+ "Always return nil. This is provided for backward compatibility."
+ nil)
+(make-obsolete 'generic-char-p "Generic characters no longer exist" "23.1")
+(defun make-char-internal (charset-id &optional code1 code2)
+ (let ((charset (aref emacs-mule-charset-table charset-id)))
+ (or charset
+ (error "Invalid Emacs-mule charset ID: %d" charset-id))
+ (make-char charset code1 code2)))
\f
;; Save the ASCII case table in case we need it later. Some locales
;; (such as Turkish) modify the case behavior of ASCII characters,
\f
;; Coding system stuff
-;; Coding system is a symbol that has the property `coding-system'.
-;;
-;; The value of the property `coding-system' is a vector of the
-;; following format:
-;; [TYPE MNEMONIC DOC-STRING PLIST FLAGS]
-;; We call this vector as coding-spec. See comments in src/coding.c
-;; for more detail.
-
-(defconst coding-spec-type-idx 0)
-(defconst coding-spec-mnemonic-idx 1)
-(defconst coding-spec-doc-string-idx 2)
-(defconst coding-spec-plist-idx 3)
-(defconst coding-spec-flags-idx 4)
-
-;; PLIST is a property list of a coding system. To share PLIST among
-;; alias coding systems, a coding system has PLIST in coding-spec
-;; instead of having it in normal property list of Lisp symbol.
-;; Here's a list of coding system properties currently being used.
-;;
-;; o coding-category
-;;
-;; The value is a coding category the coding system belongs to. The
-;; function `make-coding-system' sets this value automatically
-;; unless its argument PROPERTIES specifies this property.
-;;
-;; o alias-coding-systems
-;;
-;; The value is a list of coding systems of the same alias group. The
-;; first element is the coding system made at first, which we call as
-;; `base coding system'. The function `make-coding-system' sets this
-;; value automatically and `define-coding-system-alias' updates it.
-;;
-;; See the documentation of make-coding-system for the meanings of the
-;; following properties.
-;;
-;; o post-read-conversion
-;; o pre-write-conversion
-;; o translation-table-for-decode
-;; o translation-table-for-encode
-;; o safe-chars
-;; o safe-charsets
-;; o mime-charset
-;; o valid-codes (meaningful only for a coding system based on CCL)
-
-
-(defsubst coding-system-spec (coding-system)
- "Return coding-spec of CODING-SYSTEM."
- (get (check-coding-system coding-system) 'coding-system))
+;; Coding system is a symbol that has been defined by the function
+;; `define-coding-system'.
-(defun coding-system-type (coding-system)
- "Return the coding type of CODING-SYSTEM.
-A coding type is an integer value indicating the encoding method
-of CODING-SYSTEM. See the function `make-coding-system' for more detail."
- (aref (coding-system-spec coding-system) coding-spec-type-idx))
+(defconst coding-system-iso-2022-flags
+ '(long-form
+ ascii-at-eol
+ ascii-at-cntl
+ 7-bit
+ locking-shift
+ single-shift
+ designation
+ revision
+ direction
+ init-at-bol
+ designate-at-bol
+ safe
+ latin-extra
+ composition
+ euc-tw-shift
+ use-roman
+ use-oldjis)
+ "List of symbols that control ISO-2022 encoder/decoder.
-(defun coding-system-mnemonic (coding-system)
- "Return the mnemonic character of CODING-SYSTEM.
-The mnemonic character of a coding system is used in mode line
-to indicate the coding system. If the arg is nil, return ?-."
- (let ((spec (coding-system-spec coding-system)))
- (if spec (aref spec coding-spec-mnemonic-idx) ?-)))
+The value of the `:flags' attribute in the argument of the function
+`define-coding-system' must be one of them.
+
+If `long-form' is specified, use a long designation sequence on
+encoding for the charsets `japanese-jisx0208-1978', `chinese-gb2312',
+and `japanese-jisx0208'. The long designation sequence doesn't
+conform to ISO 2022, but is used by such coding systems as
+`compound-text'.
+
+If `ascii-at-eol' is specified, designate ASCII to g0 at end of line
+on encoding.
+
+If `ascii-at-cntl' is specified, designate ASCII to g0 before control
+codes and SPC on encoding.
+
+If `7-bit' is specified, use 7-bit code only on encoding.
+
+If `locking-shift' is specified, decode locking-shift code correctly
+on decoding, and use locking-shift to invoke a graphic element on
+encoding.
+
+If `single-shift' is specified, decode single-shift code correctly on
+decoding, and use single-shift to invoke a graphic element on encoding.
+
+If `designation' is specified, decode designation code correctly on
+decoding, and use designation to designate a charset to a graphic
+element on encoding.
+
+If `revision' is specified, produce an escape sequence to specify
+revision number of a charset on encoding. Such an escape sequence is
+always correctly decoded on decoding.
+
+If `direction' is specified, decode ISO6429's code for specifying
+direction correctly, and produce the code on encoding.
+
+If `init-at-bol' is specified, on encoding, it is assumed that
+invocation and designation statuses are reset at each beginning of
+line even if `ascii-at-eol' is not specified; thus no codes for
+resetting them are produced.
+
+If `safe' is specified, on encoding, characters not supported by a
+coding are replaced with `?'.
+
+If `latin-extra' is specified, the code-detection routine assumes that a
+code specified in `latin-extra-code-table' (which see) is valid.
+
+If `composition' is specified, an escape sequence to specify
+composition sequence is correctly decoded on decoding, and is produced
+on encoding.
+
+If `euc-tw-shift' is specified, the EUC-TW specific shifting code is
+correctly decoded on decoding, and is produced on encoding.
+
+If `use-roman' is specified, JIS0201-1976-Roman is designated instead
+of ASCII.
+
+If `use-oldjis' is specified, JIS0208-1976 is designated instead of
+JIS0208-1983.")
+
+(defun define-coding-system (name docstring &rest props)
+ "Define NAME (a symbol) as a coding system with DOCSTRING and attributes.
+The remaining arguments must come in pairs ATTRIBUTE VALUE. ATTRIBUTE
+may be any symbol.
+
+The following attributes have special meanings. Those labeled as
+\"(required)\", should not be omitted.
+
+`:mnemonic' (required)
+
+VALUE is a character to display on mode line for the coding system.
+
+`:coding-type' (required)
+
+VALUE must be one of `charset', `utf-8', `utf-16', `iso-2022',
+`emacs-mule', `shift-jis', `ccl', `raw-text', `undecided'.
+
+`:eol-type'
+
+VALUE is the EOL (end-of-line) format of the coding system. It must be
+one of `unix', `dos', `mac'. The symbol `unix' means Unix-like EOL
+\(i.e. single LF), `dos' means DOS-like EOL \(i.e. sequence of CR LF),
+and `mac' means MAC-like EOL \(i.e. single CR). If omitted, on
+decoding by the coding system, Emacs automatically detects the EOL
+format of the source text.
+
+`:charset-list'
+
+VALUE must be a list of charsets supported by the coding system. On
+encoding by the coding system, if a character belongs to multiple
+charsets in the list, a charset that comes earlier in the list is
+selected. If `:coding-type' is `iso-2022', VALUE may be `iso-2022',
+which indicates that the coding system supports all ISO-2022 based
+charsets. If `:coding-type' is `emacs-mule', VALUE may be
+`emacs-mule', which indicates that the coding system supports all
+charsets that have the `:emacs-mule-id' property.
+
+`:ascii-compatible-p'
+
+If VALUE is non-nil, the coding system decodes all 7-bit bytes into
+the corresponding ASCII characters, and encodes all ASCII characters
+back to the corresponding 7-bit bytes. VALUE defaults to nil.
+
+`:decode-translation-table'
+
+VALUE must be a translation table to use on decoding.
+
+`:encode-translation-table'
+
+VALUE must be a translation table to use on encoding.
+
+`:post-read-conversion'
+
+VALUE must be a function to call after some text is inserted and
+decoded by the coding system itself and before any functions in
+`after-insert-functions' are called. The arguments to this function
+are the same as those of a function in `after-insert-file-functions',
+i.e. LENGTH of the text to be decoded with point at the head of it,
+and the function should leave point unchanged.
+
+`:pre-write-conversion'
+
+VALUE must be a function to call after all functions in
+`write-region-annotate-functions' and `buffer-file-format' are called,
+and before the text is encoded by the coding system itself. The
+arguments to this function are the same as those of a function in
+`write-region-annotate-functions'.
+
+`:default-char'
+
+VALUE must be a character. On encoding, a character not supported by
+the coding system is replaced with VALUE.
+
+`:for-unibyte'
+
+VALUE non-nil means that visiting a file with the coding system
+results in a unibyte buffer.
+
+`:eol-type'
+
+VALUE must be `unix', `dos', `mac'. The symbol `unix' means Unix-like
+EOL (LF), `dos' means DOS-like EOL (CRLF), and `mac' means MAC-like
+EOL (CR). If omitted, on decoding, the coding system detects EOL
+format automatically, and on encoding, uses Unix-like EOL.
+
+`:mime-charset'
+
+VALUE must be a symbol whose name is that of a MIME charset converted
+to lower case.
+
+`:mime-text-unsuitable'
+
+VALUE non-nil means the `:mime-charset' property names a charset which
+is unsuitable for the top-level media type \"text\".
+
+`:flags'
+
+VALUE must be a list of symbols that control the ISO-2022 converter.
+Each must be a member of the list `coding-system-iso-2022-flags'
+\(which see). This attribute has a meaning only when `:coding-type'
+is `iso-2022'.
+
+`:designation'
+
+VALUE must be a vector [G0-USAGE G1-USAGE G2-USAGE G3-USAGE].
+GN-USAGE specifies the usage of graphic register GN as follows.
+
+If it is nil, no charset can be designated to GN.
+
+If it is a charset, the charset is initially designated to GN, and
+never used by the other charsets.
+
+If it is a list, the elements must be charsets, nil, 94, or 96. GN
+can be used by all the listed charsets. If the list contains 94, any
+iso-2022 charset whose code-space ranges are 94 long can be designated
+to GN. If the list contains 96, any charsets whose whose ranges are
+96 long can be designated to GN. If the first element is a charset,
+that charset is initially designated to GN.
+
+This attribute has a meaning only when `:coding-type' is `iso-2022'.
+
+`:bom'
+
+This attributes specifies whether the coding system uses a `byte order
+mark'. VALUE must nil, t, or cons of coding systems whose
+`:coding-type' is `utf-16'.
+
+If the value is nil, on decoding, don't treat the first two-byte as
+BOM, and on encoding, don't produce BOM bytes.
+
+If the value is t, on decoding, skip the first two-byte as BOM, and on
+encoding, produce BOM bytes accoding to the value of `:endian'.
+
+If the value is cons, on decoding, check the first two-byte. If theyq
+are 0xFE 0xFF, use the car part coding system of the value. If they
+are 0xFF 0xFE, use the car part coding system of the value.
+Otherwise, treat them as bytes for a normal character. On encoding,
+produce BOM bytes accoding to the value of `:endian'.
+
+This attribute has a meaning only when `:coding-type' is `utf-16'.
+
+`:endian'
+
+VALUE must be `big' or `little' specifying big-endian and
+little-endian respectively. The default value is `big'.
+
+This attribute has a meaning only when `:coding-type' is `utf-16'.
+
+`:ccl-decoder'
+
+VALUE is a symbol representing the registered CCL program used for
+decoding. This attribute has a meaning only when `:coding-type' is
+`ccl'.
+
+`:ccl-encoder'
+
+VALUE is a symbol representing the registered CCL program used for
+encoding. This attribute has a meaning only when `:coding-type' is
+`ccl'."
+ (let* ((common-attrs (mapcar 'list
+ '(:mnemonic
+ :coding-type
+ :charset-list
+ :ascii-compatible-p
+ :decode-translation-table
+ :encode-translation-table
+ :post-read-conversion
+ :pre-write-conversion
+ :default-char
+ :for-unibyte
+ :plist
+ :eol-type)))
+ (coding-type (plist-get props :coding-type))
+ (spec-attrs (mapcar 'list
+ (cond ((eq coding-type 'iso-2022)
+ '(:initial
+ :reg-usage
+ :request
+ :flags))
+ ((eq coding-type 'utf-16)
+ '(:bom
+ :endian))
+ ((eq coding-type 'ccl)
+ '(:ccl-decoder
+ :ccl-encoder
+ :valids))))))
+
+ (dolist (slot common-attrs)
+ (setcdr slot (plist-get props (car slot))))
+
+ (dolist (slot spec-attrs)
+ (setcdr slot (plist-get props (car slot))))
+
+ (if (eq coding-type 'iso-2022)
+ (let ((designation (plist-get props :designation))
+ (flags (plist-get props :flags))
+ (initial (make-vector 4 nil))
+ (reg-usage (cons 4 4))
+ request elt)
+ (dotimes (i 4)
+ (setq elt (aref designation i))
+ (cond ((charsetp elt)
+ (aset initial i elt)
+ (setq request (cons (cons elt i) request)))
+ ((consp elt)
+ (aset initial i (car elt))
+ (if (charsetp (car elt))
+ (setq request (cons (cons (car elt) i) request)))
+ (dolist (e (cdr elt))
+ (cond ((charsetp e)
+ (setq request (cons (cons e i) request)))
+ ((eq e 94)
+ (setcar reg-usage i))
+ ((eq e 96)
+ (setcdr reg-usage i))
+ ((eq e t)
+ (setcar reg-usage i)
+ (setcdr reg-usage i)))))))
+ (setcdr (assq :initial spec-attrs) initial)
+ (setcdr (assq :reg-usage spec-attrs) reg-usage)
+ (setcdr (assq :request spec-attrs) request)
+
+ ;; Change :flags value from a list to a bit-mask.
+ (let ((bits 0)
+ (i 0))
+ (dolist (elt coding-system-iso-2022-flags)
+ (if (memq elt flags)
+ (setq bits (logior bits (lsh 1 i))))
+ (setq i (1+ i)))
+ (setcdr (assq :flags spec-attrs) bits))))
+
+ ;; Add :name and :docstring properties to PROPS.
+ (setq props
+ (cons :name (cons name (cons :docstring (cons (purecopy docstring)
+ props)))))
+ (setcdr (assq :plist common-attrs) props)
+ (apply 'define-coding-system-internal
+ name (mapcar 'cdr (append common-attrs spec-attrs)))))
(defun coding-system-doc-string (coding-system)
"Return the documentation string for CODING-SYSTEM."
- (aref (coding-system-spec coding-system) coding-spec-doc-string-idx))
-
-(defun coding-system-plist (coding-system)
- "Return the property list of CODING-SYSTEM."
- (aref (coding-system-spec coding-system) coding-spec-plist-idx))
+ (plist-get (coding-system-plist coding-system) :docstring))
-(defun coding-system-flags (coding-system)
- "Return `flags' of CODING-SYSTEM.
-A `flags' of a coding system is a vector of length 32 indicating detailed
-information of a coding system. See the function `make-coding-system'
-for more detail."
- (aref (coding-system-spec coding-system) coding-spec-flags-idx))
+(defun coding-system-mnemonic (coding-system)
+ "Return the mnemonic character of CODING-SYSTEM.
+The mnemonic character of a coding system is used in mode line to
+indicate the coding system. If CODING-SYSTEM. is nil, return ?=."
+ (plist-get (coding-system-plist coding-system) :mnemonic))
-(defun coding-system-get (coding-system prop)
- "Extract a value from CODING-SYSTEM's property list for property PROP."
- (plist-get (coding-system-plist coding-system) prop))
+(defun coding-system-type (coding-system)
+ "Return the coding type of CODING-SYSTEM.
+A coding type is a symbol indicating the encoding method of CODING-SYSTEM.
+See the function `define-coding-system' for more detail."
+ (plist-get (coding-system-plist coding-system) :coding-type))
-(defun coding-system-put (coding-system prop val)
- "Change value in CODING-SYSTEM's property list PROP to VAL."
- (let ((plist (coding-system-plist coding-system)))
- (if plist
- (plist-put plist prop val)
- (aset (coding-system-spec coding-system) coding-spec-plist-idx
- (list prop val)))))
+(defun coding-system-charset-list (coding-system)
+ "Return list of charsets supported by CODING-SYSTEM.
+If CODING-SYSTEM supports all ISO-2022 charsets, return `iso-2022'.
+If CODING-SYSTEM supports all emacs-mule charsets, return `emacs-mule'."
+ (plist-get (coding-system-plist coding-system) :charset-list))
(defun coding-system-category (coding-system)
- "Return the coding category of CODING-SYSTEM.
-See also `coding-category-list'."
- (coding-system-get coding-system 'coding-category))
-
-(defun coding-system-base (coding-system)
- "Return the base coding system of CODING-SYSTEM.
-A base coding system is what made by `make-coding-system'.
-Neither aliases nor subsidiary coding systems are base coding systems."
- (car (coding-system-get coding-system 'alias-coding-systems)))
-
-;; Coding system also has a property `eol-type'.
-;;
-;; This property indicates how the coding system handles end-of-line
-;; format. The value is integer 0, 1, 2, or a vector of three coding
-;; systems. Each integer value 0, 1, and 2 indicates the format of
-;; end-of-line LF, CRLF, and CR respectively. A vector value
-;; indicates that the format of end-of-line should be detected
-;; automatically. Nth element of the vector is the subsidiary coding
-;; system whose `eol-type' property is N.
-
-(defun coding-system-eol-type (coding-system)
- "Return eol-type of CODING-SYSTEM.
-An eol-type is integer 0, 1, 2, or a vector of coding systems.
-
-Integer values 0, 1, and 2 indicate a format of end-of-line; LF,
-CRLF, and CR respectively.
-
-A vector value indicates that a format of end-of-line should be
-detected automatically. Nth element of the vector is the subsidiary
-coding system whose eol-type is N."
- (get coding-system 'eol-type))
+ "Return a category symbol of CODING-SYSTEM."
+ (plist-get (coding-system-plist coding-system) :category))
+
+(defun coding-system-get (coding-system prop)
+ "Extract a value from CODING-SYSTEM's property list for property PROP.
+For compatibility with Emacs 20/21, this accepts old-style symbols
+like `mime-charset' as well as the current style like `:mime-charset'."
+ (or (plist-get (coding-system-plist coding-system) prop)
+ (if (not (keywordp prop))
+ ;; For backward compatiblity.
+ (if (eq prop 'ascii-incompatible)
+ (not (plist-get (coding-system-plist coding-system)
+ :ascii-compatible-p))
+ (plist-get (coding-system-plist coding-system)
+ (intern (concat ":" (symbol-name prop))))))))
(defun coding-system-eol-type-mnemonic (coding-system)
"Return the string indicating end-of-line format of CODING-SYSTEM."
Two coding systems are identical if two symbols are equal
or one is an alias of the other."
(or (eq coding-system-1 coding-system-2)
- (and (equal (coding-system-spec coding-system-1)
- (coding-system-spec coding-system-2))
+ (and (equal (coding-system-plist coding-system-1)
+ (coding-system-plist coding-system-2))
(let ((eol-type-1 (coding-system-eol-type coding-system-1))
(eol-type-2 (coding-system-eol-type coding-system-2)))
(or (eq eol-type-1 eol-type-2)
(defun coding-system-list (&optional base-only)
"Return a list of all existing non-subsidiary coding systems.
-If optional arg BASE-ONLY is non-nil, only base coding systems are listed.
-The value doesn't include subsidiary coding systems which are what
+If optional arg BASE-ONLY is non-nil, only base coding systems are
+listed. The value doesn't include subsidiary coding systems which are
made from bases and aliases automatically for various end-of-line
formats (e.g. iso-latin-1-unix, koi8-r-dos)."
- (let* ((codings (copy-sequence coding-system-list))
- (tail (cons nil codings)))
- ;; Remove subsidiary coding systems (eol variants) and alias
- ;; coding systems (if necessary).
- (while (cdr tail)
- (let* ((coding (car (cdr tail)))
- (aliases (coding-system-get coding 'alias-coding-systems)))
- (if (or
- ;; CODING is an eol variant if not in ALIASES.
- (not (memq coding aliases))
- ;; CODING is an alias if it is not car of ALIASES.
- (and base-only (not (eq coding (car aliases)))))
- (setcdr tail (cdr (cdr tail)))
- (setq tail (cdr tail)))))
+ (let ((codings nil))
+ (dolist (coding coding-system-list)
+ (if (eq (coding-system-base coding) coding)
+ (if base-only
+ (setq codings (cons coding codings))
+ (dolist (alias (coding-system-aliases coding))
+ (setq codings (cons alias codings))))))
codings))
-(defun map-charset-chars (func charset)
- "Use FUNC to map over all characters in CHARSET for side effects.
-FUNC is a function of two args, the start and end (inclusive) of a
-character code range. Thus FUNC should iterate over [START, END]."
- (let* ((dim (charset-dimension charset))
- (chars (charset-chars charset))
- (start (if (= chars 94)
- 33
- 32)))
- (if (= dim 1)
- (funcall func
- (make-char charset start)
- (make-char charset (+ start chars -1)))
- (dotimes (i chars)
- (funcall func
- (make-char charset (+ i start) start)
- (make-char charset (+ i start) (+ start chars -1)))))))
-
-(defalias 'register-char-codings 'ignore "")
-(make-obsolete 'register-char-codings
- "it exists just for backward compatibility, and does nothing."
- "21.3")
-
(defconst char-coding-system-table nil
"This is an obsolete variable.
It exists just for backward compatibility, and the value is always nil.")
-(defun make-subsidiary-coding-system (coding-system)
- "Make subsidiary coding systems (eol-type variants) of CODING-SYSTEM."
- (let ((coding-spec (coding-system-spec coding-system))
- (subsidiaries (vector (intern (format "%s-unix" coding-system))
- (intern (format "%s-dos" coding-system))
- (intern (format "%s-mac" coding-system))))
- elt)
- (dotimes (i 3)
- (setq elt (aref subsidiaries i))
- (put elt 'coding-system coding-spec)
- (put elt 'eol-type i)
- (put elt 'coding-system-define-form nil)
- (add-to-coding-system-list elt)
- (or (assoc (symbol-name elt) coding-system-alist)
- (setq coding-system-alist
- (cons (list (symbol-name elt)) coding-system-alist))))
- subsidiaries))
-
(defun transform-make-coding-system-args (name type &optional doc-string props)
"For internal use only.
Transform XEmacs style args for `make-coding-system' to Emacs style.
properties
eol-type)
"Define a new coding system CODING-SYSTEM (symbol).
-Remaining arguments are TYPE, MNEMONIC, DOC-STRING, FLAGS (optional),
-and PROPERTIES (optional) which construct a coding-spec of CODING-SYSTEM
-in the following format:
- [TYPE MNEMONIC DOC-STRING PLIST FLAGS]
-
-TYPE is an integer value indicating the type of the coding system as follows:
- 0: Emacs internal format,
- 1: Shift-JIS (or MS-Kanji) used mainly on Japanese PCs,
- 2: ISO-2022 including many variants,
- 3: Big5 used mainly on Chinese PCs,
- 4: private, CCL programs provide encoding/decoding algorithm,
- 5: Raw-text, which means that text contains random 8-bit codes.
-
-MNEMONIC is a character to be displayed on mode line for the coding system.
-
-DOC-STRING is a documentation string for the coding system.
-
-FLAGS specifies more detailed information of the coding system as follows:
-
- If TYPE is 2 (ISO-2022), FLAGS is a list of these elements:
- CHARSET0, CHARSET1, CHARSET2, CHARSET3, SHORT-FORM,
- ASCII-EOL, ASCII-CNTL, SEVEN, LOCKING-SHIFT, SINGLE-SHIFT,
- USE-ROMAN, USE-OLDJIS, NO-ISO6429, INIT-BOL, DESIGNATION-BOL,
- SAFE, ACCEPT-LATIN-EXTRA-CODE.
- CHARSETn are character sets initially designated to Gn graphic registers.
- If CHARSETn is nil, Gn is never used.
- If CHARSETn is t, Gn can be used but nothing designated initially.
- If CHARSETn is a list of character sets, those character sets are
- designated to Gn on output, but nothing designated to Gn initially.
- But, character set `ascii' can be designated only to G0.
- SHORT-FORM non-nil means use short designation sequence on output.
- ASCII-EOL non-nil means designate ASCII to g0 at end of line on output.
- ASCII-CNTL non-nil means designate ASCII to g0 before control codes and
- SPACE on output.
- SEVEN non-nil means use 7-bit code only on output.
- LOCKING-SHIFT non-nil means use locking-shift.
- SINGLE-SHIFT non-nil means use single-shift.
- USE-ROMAN non-nil means designate JIS0201-1976-Roman instead of ASCII.
- USE-OLDJIS non-nil means designate JIS0208-1976 instead of JIS0208-1983.
- NO-ISO6429 non-nil means not use ISO6429's direction specification.
- INIT-BOL non-nil means any designation state is assumed to be reset
- to initial at each beginning of line on output.
- DESIGNATION-BOL non-nil means designation sequences should be placed
- at beginning of line on output.
- SAFE non-nil means convert unsafe characters to `?' on output.
- Characters not specified in the property `safe-charsets' nor
- `safe-chars' are unsafe.
- ACCEPT-LATIN-EXTRA-CODE non-nil means code-detection routine accepts
- a code specified in `latin-extra-code-table' (which see) as a valid
- code of the coding system.
-
- If TYPE is 4 (private), FLAGS should be a cons of CCL programs, for
- decoding and encoding. CCL programs should be specified by their
- symbols.
-
-PROPERTIES is an alist of properties vs the corresponding values. The
-following properties are recognized:
-
- o post-read-conversion
-
- The value is a function to call after some text is inserted and
- decoded by the coding system itself and before any functions in
- `after-insert-functions' are called. The argument of this
- function is the same as for a function in
- `after-insert-file-functions', i.e. LENGTH of the text inserted,
- with point at the head of the text to be decoded.
-
- o pre-write-conversion
-
- The value is a function to call after all functions in
- `write-region-annotate-functions' and `buffer-file-format' are
- called, and before the text is encoded by the coding system itself.
- The arguments to this function are the same as those of a function
- in `write-region-annotate-functions', i.e. FROM and TO, specifying
- a region of text.
-
- o translation-table-for-decode
-
- The value is a translation table to be applied on decoding. See
- the function `make-translation-table' for the format of translation
- table. This is not applicable to type 4 (CCL-based) coding systems.
-
- o translation-table-for-encode
-
- The value is a translation table to be applied on encoding. This is
- not applicable to type 4 (CCL-based) coding systems.
-
- o safe-chars
-
- The value is a char table. If a character has non-nil value in it,
- the character is safely supported by the coding system. This
- overrides the specification of safe-charsets.
-
- o safe-charsets
-
- The value is a list of charsets safely supported by the coding
- system. The value t means that all charsets Emacs handles are
- supported. Even if some charset is not in this list, it doesn't
- mean that the charset can't be encoded in the coding system;
- it just means that some other receiver of text encoded
- in the coding system won't be able to handle that charset.
-
- o mime-charset
-
- The value is a symbol whose name is the `MIME-charset' parameter of
- the coding system.
-
- o mime-text-unsuitable
-
- A non-nil value means the `mime-charset' property names a charset
- which is unsuitable for the top-level media type \"text\".
-
- o valid-codes (meaningful only for a coding system based on CCL)
-
- The value is a list to indicate valid byte ranges of the encoded
- file. Each element of the list is an integer or a cons of integer.
- In the former case, the integer value is a valid byte code. In the
- latter case, the integers specify the range of valid byte codes.
-
- o composition (meaningful only when TYPE is 0 or 2)
-
- If the value is non-nil, the coding system preserves composition
- information.
-
- o ascii-incompatible
-
- If the value is non-nil, the coding system is not compatible
- with ASCII, which means it encodes or decodes ASCII character
- string to the different byte sequence.
-
-These properties are set in PLIST, a property list. This function
-also sets properties `coding-category' and `alias-coding-systems'
-automatically.
-
-EOL-TYPE specifies the EOL type of the coding-system in one of the
-following formats:
-
- o symbol (unix, dos, or mac)
-
- The symbol `unix' means Unix-like EOL (LF), `dos' means
- DOS-like EOL (CRLF), and `mac' means MAC-like EOL (CR).
-
- o number (0, 1, or 2)
-
- The number 0, 1, and 2 mean UNIX, DOS, and MAC-like EOL
- respectively.
-
- o vector of coding-systems of length 3
-
- The EOL type is detected automatically for the coding system.
- And, according to the detected EOL type, one of the coding
- systems in the vector is selected. Elements of the vector
- corresponds to Unix-like EOL, DOS-like EOL, and Mac-like EOL
- in this order.
-
-Kludgy features for backward compatibility:
-
-1. If TYPE is 4 and car or cdr of FLAGS is a vector, the vector is
-treated as a compiled CCL code.
-
-2. If PROPERTIES is just a list of character sets, the list is set as
-a value of `safe-charsets' in PLIST."
-
+This function is provided for backward compatibility.
+Use `define-coding-system' instead."
;; For compatiblity with XEmacs, we check the type of TYPE. If it
;; is a symbol, perhaps, this function is called with XEmacs-style
;; arguments. Here, try to transform that kind of arguments to
properties (nth 5 args)
eol-type (nth 6 args))))
- ;; Set a value of `coding-system' property.
- (let ((coding-spec (make-vector 5 nil))
- (no-initial-designation t)
- (no-alternative-designation t)
- (accept-latin-extra-code nil)
- coding-category)
- (if (or (not (integerp type)) (< type 0) (> type 5))
- (error "TYPE argument must be 0..5"))
- (if (or (not (integerp mnemonic)) (<= mnemonic ? ) (> mnemonic 127))
- (error "MNEMONIC argument must be an ASCII printable character"))
- (aset coding-spec coding-spec-type-idx type)
- (aset coding-spec coding-spec-mnemonic-idx mnemonic)
- (aset coding-spec coding-spec-doc-string-idx
- (purecopy (if (stringp doc-string) doc-string "")))
- (cond ((= type 0)
- (setq coding-category 'coding-category-emacs-mule))
- ((= type 1)
- (setq coding-category 'coding-category-sjis))
- ((= type 2) ; ISO2022
- (let ((i 0)
- (vec (make-vector 32 nil))
- (g1-designation nil)
- (fl flags))
- (while (< i 4)
- (let ((charset (car fl)))
- (if (and no-initial-designation
- (> i 0)
- (or (charsetp charset)
- (and (consp charset)
- (charsetp (car charset)))))
- (setq no-initial-designation nil))
- (if (charsetp charset)
- (if (= i 1) (setq g1-designation charset))
- (if (consp charset)
- (let ((tail charset)
- elt)
- (while tail
- (setq elt (car tail))
- (if (eq elt t)
- (setq no-alternative-designation nil)
- (if (and elt (not (charsetp elt)))
- (error "Invalid charset: %s" elt)))
- (setq tail (cdr tail)))
- (setq g1-designation (car charset)))
- (if charset
- (if (eq charset t)
- (setq no-alternative-designation nil)
- (error "Invalid charset: %s" charset)))))
- (aset vec i charset))
- (setq fl (cdr fl) i (1+ i)))
- (while (and (< i 32) fl)
- (aset vec i (car fl))
- (if (and (= i 16) ; ACCEPT-LATIN-EXTRA-CODE
- (car fl))
- (setq accept-latin-extra-code t))
- (setq fl (cdr fl) i (1+ i)))
- (aset coding-spec 4 vec)
- (setq coding-category
- (if (aref vec 8) ; Use locking-shift.
- (or (and (aref vec 7) 'coding-category-iso-7-else)
- 'coding-category-iso-8-else)
- (if (aref vec 7) ; 7-bit only.
- (if (aref vec 9) ; Use single-shift.
- 'coding-category-iso-7-else
- (if no-alternative-designation
- 'coding-category-iso-7-tight
- 'coding-category-iso-7))
- (if (or no-initial-designation
- (not no-alternative-designation))
- 'coding-category-iso-8-else
- (if (and (charsetp g1-designation)
- (= (charset-dimension g1-designation) 2))
- 'coding-category-iso-8-2
- 'coding-category-iso-8-1)))))))
- ((= type 3)
- (setq coding-category 'coding-category-big5))
- ((= type 4) ; private
- (setq coding-category 'coding-category-ccl)
- (if (not (consp flags))
- (error "Invalid FLAGS argument for TYPE 4 (CCL)")
- (let ((decoder (check-ccl-program
- (car flags)
- (intern (format "%s-decoder" coding-system))))
- (encoder (check-ccl-program
- (cdr flags)
- (intern (format "%s-encoder" coding-system)))))
- (if (and decoder encoder)
- (aset coding-spec 4 (cons decoder encoder))
- (error "Invalid FLAGS argument for TYPE 4 (CCL)")))))
- (t ; i.e. (= type 5)
- (setq coding-category 'coding-category-raw-text)))
-
- (let ((plist (list 'coding-category coding-category
- 'alias-coding-systems (list coding-system))))
- (if no-initial-designation
- (plist-put plist 'no-initial-designation t))
- (if (and properties
- (or (eq properties t)
- (not (consp (car properties)))))
- ;; In the old version, the arg PROPERTIES is a list to be
- ;; set in PLIST as a value of property `safe-charsets'.
- (setq properties (list (cons 'safe-charsets properties))))
- ;; In the current version PROPERTIES is a property list.
- ;; Reflect it into PLIST one by one while handling safe-chars
- ;; specially.
- (let ((safe-charsets (cdr (assq 'safe-charsets properties)))
- (safe-chars (cdr (assq 'safe-chars properties)))
- (l properties)
- prop val)
- ;; If only safe-charsets is specified, make a char-table from
- ;; it, and store that char-table as the value of `safe-chars'.
- (if (and (not safe-chars) safe-charsets)
- (let (charset)
- (if (eq safe-charsets t)
- (setq safe-chars t)
- (setq safe-chars (make-char-table 'safe-chars))
- (while safe-charsets
- (setq charset (car safe-charsets)
- safe-charsets (cdr safe-charsets))
- (cond ((eq charset 'ascii)) ; just ignore
- ((eq charset 'eight-bit-control)
- (let ((i 128))
- (while (< i 160)
- (aset safe-chars i t)
- (setq i (1+ i)))))
- ((eq charset 'eight-bit-graphic)
- (let ((i 160))
- (while (< i 256)
- (aset safe-chars i t)
- (setq i (1+ i)))))
- (t
- (aset safe-chars (make-char charset) t))))
- (if accept-latin-extra-code
- (let ((i 128))
- (while (< i 160)
- (if (aref latin-extra-code-table i)
- (aset safe-chars i t))
- (setq i (1+ i))))))
- (setq l (cons (cons 'safe-chars safe-chars) l))))
- (while l
- (setq prop (car (car l)) val (cdr (car l)) l (cdr l))
- (if (eq prop 'safe-chars)
- (progn
- (if (and (symbolp val)
- (get val 'translation-table))
- (setq safe-chars (get val 'translation-table)))
- (setq val safe-chars)))
- (plist-put plist prop val)))
- ;; The property `coding-category' may have been set differently
- ;; through PROPERTIES.
- (setq coding-category (plist-get plist 'coding-category))
- (aset coding-spec coding-spec-plist-idx plist))
- (put coding-system 'coding-system coding-spec)
- (put coding-system 'coding-system-define-form nil)
- (put coding-category 'coding-systems
- (cons coding-system (get coding-category 'coding-systems))))
-
- ;; Next, set a value of `eol-type' property.
- (if (not eol-type)
- ;; If EOL-TYPE is nil, set a vector of subsidiary coding
- ;; systems, each corresponds to a coding system for the detected
- ;; EOL format.
- (setq eol-type (make-subsidiary-coding-system coding-system)))
- (setq eol-type
- (cond ((or (eq eol-type 'unix) (null eol-type))
- 0)
- ((eq eol-type 'dos)
- 1)
- ((eq eol-type 'mac)
- 2)
- ((or (and (vectorp eol-type)
- (= (length eol-type) 3))
- (and (numberp eol-type)
- (and (>= eol-type 0)
- (<= eol-type 2))))
- eol-type)
+ (setq type
+ (cond ((eq type 0) 'emacs-mule)
+ ((eq type 1) 'shift-jis)
+ ((eq type 2) 'iso2022)
+ ((eq type 3) 'big5)
+ ((eq type 4) 'ccl)
+ ((eq type 5) 'raw-text)
(t
- (error "Invalid EOL-TYPE spec:%S" eol-type))))
- (put coding-system 'eol-type eol-type)
-
- (define-coding-system-internal coding-system)
-
- ;; At last, register CODING-SYSTEM in `coding-system-list' and
- ;; `coding-system-alist'.
- (add-to-coding-system-list coding-system)
- (or (assoc (symbol-name coding-system) coding-system-alist)
- (setq coding-system-alist (cons (list (symbol-name coding-system))
- coding-system-alist)))
-
- ;; For a coding system of cateogory iso-8-1 and iso-8-2, create
- ;; XXX-with-esc variants.
- (let ((coding-category (coding-system-category coding-system)))
- (if (or (eq coding-category 'coding-category-iso-8-1)
- (eq coding-category 'coding-category-iso-8-2))
- (let ((esc (intern (concat (symbol-name coding-system) "-with-esc")))
- (doc (format "Same as %s but can handle any charsets by ISO's escape sequences." coding-system))
- (safe-charsets (assq 'safe-charsets properties))
- (mime-charset (assq 'mime-charset properties)))
- (if safe-charsets
- (setcdr safe-charsets t)
- (setq properties (cons (cons 'safe-charsets t) properties)))
- (if mime-charset
- (setcdr mime-charset nil))
- (make-coding-system esc type mnemonic doc
- (if (listp (car flags))
- (cons (append (car flags) '(t)) (cdr flags))
- (cons (list (car flags) t) (cdr flags)))
- properties))))
-
- coding-system)
-
-(put 'safe-chars 'char-table-extra-slots 0)
-
-(defun define-coding-system-alias (alias coding-system)
- "Define ALIAS as an alias for coding system CODING-SYSTEM."
- (put alias 'coding-system (coding-system-spec coding-system))
- (put alias 'coding-system-define-form nil)
- (add-to-coding-system-list alias)
- (or (assoc (symbol-name alias) coding-system-alist)
- (setq coding-system-alist (cons (list (symbol-name alias))
- coding-system-alist)))
- (let ((eol-type (coding-system-eol-type coding-system)))
- (if (vectorp eol-type)
- (progn
- (nconc (coding-system-get alias 'alias-coding-systems) (list alias))
- (put alias 'eol-type (make-subsidiary-coding-system alias)))
- (put alias 'eol-type eol-type))))
+ (error "Invalid coding system type: %s" type))))
+
+ (setq properties
+ (let ((plist nil) key)
+ (dolist (elt properties)
+ (setq key (car elt))
+ (cond ((eq key 'post-read-conversion)
+ (setq key :post-read-conversion))
+ ((eq key 'pre-write-conversion)
+ (setq key :pre-write-conversion))
+ ((eq key 'translation-table-for-decode)
+ (setq key :decode-translation-table))
+ ((eq key 'translation-table-for-encode)
+ (setq key :encode-translation-table))
+ ((eq key 'safe-charsets)
+ (setq key :charset-list))
+ ((eq key 'mime-charset)
+ (setq key :mime-charset))
+ ((eq key 'valid-codes)
+ (setq key :valids)))
+ (setq plist (plist-put plist key (cdr elt))))
+ plist))
+ (setq properties (plist-put properties :mnemonic mnemonic))
+ (plist-put properties :coding-type type)
+ (cond ((eq eol-type 0) (setq eol-type 'unix))
+ ((eq eol-type 1) (setq eol-type 'dos))
+ ((eq eol-type 2) (setq eol-type 'mac))
+ ((vectorp eol-type) (setq eol-type nil)))
+ (plist-put properties :eol-type eol-type)
+
+ (cond
+ ((eq type 'iso2022)
+ (plist-put properties :flags
+ (list (and (or (consp (nth 0 flags))
+ (consp (nth 1 flags))
+ (consp (nth 2 flags))
+ (consp (nth 3 flags))) 'designation)
+ (or (nth 4 flags) 'long-form)
+ (and (nth 5 flags) 'ascii-at-eol)
+ (and (nth 6 flags) 'ascii-at-cntl)
+ (and (nth 7 flags) '7-bit)
+ (and (nth 8 flags) 'locking-shift)
+ (and (nth 9 flags) 'single-shift)
+ (and (nth 10 flags) 'use-roman)
+ (and (nth 11 flags) 'use-oldjis)
+ (or (nth 12 flags) 'direction)
+ (and (nth 13 flags) 'init-at-bol)
+ (and (nth 14 flags) 'designate-at-bol)
+ (and (nth 15 flags) 'safe)
+ (and (nth 16 flags) 'latin-extra)))
+ (plist-put properties :designation
+ (let ((vec (make-vector 4 nil)))
+ (dotimes (i 4)
+ (let ((spec (nth i flags)))
+ (if (eq spec t)
+ (aset vec i '(94 96))
+ (if (consp spec)
+ (progn
+ (if (memq t spec)
+ (setq spec (append (delq t spec) '(94 96))))
+ (aset vec i spec))))))
+ vec)))
+
+ ((eq type 'ccl)
+ (plist-put properties :ccl-decoder (car flags))
+ (plist-put properties :ccl-encoder (cdr flags))))
+
+ (apply 'define-coding-system coding-system doc-string properties))
(defun merge-coding-systems (first second)
"Fill in any unspecified aspects of coding system FIRST from SECOND.
(interactive "zCoding system for file names (default nil): ")
(check-coding-system coding-system)
(if (and coding-system
- (coding-system-get coding-system 'ascii-incompatible))
- (error "%s is not ASCII-compatible" coding-system))
+ (not (coding-system-get coding-system :ascii-compatible-p))
+ (not (coding-system-get coding-system :suitable-for-file-name)))
+ (error "%s is not suitable for file names" coding-system))
(setq file-name-coding-system coding-system))
(defvar default-terminal-coding-system nil
(if coding-system
(setq default-keyboard-coding-system coding-system))
(if (and coding-system
- (coding-system-get coding-system 'ascii-incompatible))
- (error "%s is not ASCII-compatible" coding-system))
+ (not (coding-system-get coding-system :ascii-compatible-p))
+ (not (coding-system-get coding-system :suitable-for-keyboard)))
+ (error "%s is not suitable for keyboard" coding-system))
(set-keyboard-coding-system-internal coding-system display)
(setq keyboard-coding-system coding-system)
(encoded-kbd-setup-display display))
(defvar last-next-selection-coding-system nil)
(defun set-next-selection-coding-system (coding-system)
- "Make CODING-SYSTEM used for the next communication with other X clients.
+ "Use CODING-SYSTEM for next communication with other window system clients.
This setting is effective for the next communication only."
(interactive
(list (read-coding-system
(if last-next-selection-coding-system
- (format "Coding system for the next X selection (default %S): "
+ (format "Coding system for the next selection (default %S): "
last-next-selection-coding-system)
- "Coding system for the next X selection: ")
+ "Coding system for the next selection: ")
last-next-selection-coding-system)))
(if coding-system
(setq last-next-selection-coding-system coding-system)
(defun set-coding-priority (arg)
"Set priority of coding categories according to ARG.
-ARG is a list of coding categories ordered by priority."
- (let ((l arg)
- (current-list (copy-sequence coding-category-list)))
- ;; Check the validity of ARG while deleting coding categories in
- ;; ARG from CURRENT-LIST. We assume that CODING-CATEGORY-LIST
- ;; contains all coding categories.
- (while l
- (if (or (null (get (car l) 'coding-category-index))
- (null (memq (car l) current-list)))
- (error "Invalid or duplicated element in argument: %s" arg))
- (setq current-list (delq (car l) current-list))
- (setq l (cdr l)))
- ;; Update `coding-category-list' and return it.
- (setq coding-category-list (append arg current-list))
- (set-coding-priority-internal)))
+ARG is a list of coding categories ordered by priority.
+
+This function is provided for backward compatibility.
+Now we have more convenient function `set-coding-system-priority'."
+ (apply 'set-coding-system-priority
+ (mapcar #'(lambda (x) (symbol-value x)) arg)))
+(make-obsolete 'set-coding-priority 'set-coding-system-priority "23.1")
;;; X selections
(defvar ctext-non-standard-encodings-alist
- '(("big5-0" big5 2 (chinese-big5-1 chinese-big5-2))
+ '(("big5-0" big5 2 big5)
("ISO8859-14" iso-8859-14 1 latin-iso8859-14)
- ("ISO8859-15" iso-8859-15 1 latin-iso8859-15))
+ ("ISO8859-15" iso-8859-15 1 latin-iso8859-15)
+ ("gbk-0" gbk 2 chinese-gbk))
"Alist of non-standard encoding names vs the corresponding usages in CTEXT.
It controls how extended segments of a compound text are handled
character is variable), 1, 2, 3, or 4.
CHARSET is a charater set containing characters that are encoded
-in the segment. It can be a list of character sets. It can also
-be a char-table, in which case characters that have non-nil value
-in the char-table are the target.
+in the segment. It can be a list of character sets.
On decoding CTEXT, all encoding names listed here are recognized.
listed for the current language environment under the key
`ctext-non-standard-encodings' are used.")
-(defvar ctext-non-standard-encodings
- '("big5-0")
+(defvar ctext-non-standard-encodings nil
"List of non-standard encoding names used in extended segments of CTEXT.
Each element must be one of the names listed in the variable
`ctext-non-standard-encodings-alist' (which see).")
(defun ctext-post-read-conversion (len)
"Decode LEN characters encoded as Compound Text with Extended Segments."
+ ;; We don't need the following because it is expected that this
+ ;; function is mainly used for decoding X selection which is not
+ ;; that big data.
+ ;;(buffer-disable-undo) ; minimize consing due to insertions and deletions
(save-match-data
(save-restriction
+ (narrow-to-region (point) (+ (point) len))
(let ((case-fold-search nil)
- (in-workbuf (string= (buffer-name) " *code-converting-work*"))
last-coding-system-used
pos bytes)
- (or in-workbuf
- (narrow-to-region (point) (+ (point) len)))
- (if in-workbuf
- (set-buffer-multibyte t))
+ (decode-coding-region (point-min) (point-max) 'ctext)
(while (re-search-forward ctext-non-standard-encodings-regexp
nil 'move)
(setq pos (match-beginning 0))
(if (match-beginning 1)
;; ESC % / [0-4] M L --ENCODING-NAME-- \002 --BYTES--
- (let* ((M (char-after (+ pos 4)))
- (L (char-after (+ pos 5)))
+ (let* ((M (multibyte-char-to-unibyte (char-after (+ pos 4))))
+ (L (multibyte-char-to-unibyte (char-after (+ pos 5))))
(encoding (match-string 2))
(encoding-info (assoc-string
encoding
(goto-char (point-min))
(- (point-max) (point)))))
-;; Return a char table of extended segment usage for each character.
-;; Each value of the char table is nil, one of the elements of
-;; `ctext-non-standard-encodings-alist', or the symbol `utf-8'.
+;; Return an alist of CHARSET vs CTEXT-USAGE-INFO generated from
+;; `ctext-non-standard-encodings' and a list specified by the key
+;; `ctext-non-standard-encodings' for the currrent language
+;; environment. CTEXT-USAGE-INFO is one of the element of
+;; `ctext-non-standard-encodings-alist' or nil. In the former case, a
+;; character in CHARSET is encoded using extended segment. In the
+;; latter case, a character in CHARSET is encoded using normal ISO2022
+;; designation sequence. If a character is not in any of CHARSETs, it
+;; is encoded using UTF-8 encoding extention.
(defun ctext-non-standard-encodings-table ()
- (let ((table (make-char-table 'translation-table)))
- (aset table (make-char 'mule-unicode-0100-24ff) 'utf-8)
- (aset table (make-char 'mule-unicode-2500-33ff) 'utf-8)
- (aset table (make-char 'mule-unicode-e000-ffff) 'utf-8)
- (dolist (encoding (reverse
- (append
+ (let (table)
+ ;; Setup charsets specified by the key
+ ;; `ctext-non-standard-encodings' for the current language
+ ;; environment and in `ctext-non-standard-encodings'.
+ (dolist (encoding (append
(get-language-info current-language-environment
'ctext-non-standard-encodings)
- ctext-non-standard-encodings)))
+ ctext-non-standard-encodings))
(let* ((slot (assoc encoding ctext-non-standard-encodings-alist))
(charset (nth 3 slot)))
- (if charset
- (cond ((charsetp charset)
- (aset table (make-char charset) slot))
- ((listp charset)
- (dolist (elt charset)
- (aset table (make-char elt) slot)))
- ((char-table-p charset)
- (map-char-table #'(lambda (k v)
- (if (and v (> k 128)) (aset table k slot)))
- charset))))))
- table))
+ (if (charsetp charset)
+ (push (cons charset slot) table)
+ (dolist (cs charset)
+ (push (cons cs slot) table)))))
+
+ ;; Next prepend charsets for ISO2022 designation sequence.
+ (dolist (charset charset-list)
+ (let ((final (plist-get (charset-plist charset) :iso-final-char)))
+ (if (and (integerp final)
+ (>= final #x40) (<= final #x7e)
+ ;; Exclude ascii and chinese-cns11643-X.
+ (not (eq charset 'ascii))
+ (not (string-match "cns11643" (symbol-name charset))))
+ (push (cons charset nil) table))))
+
+ ;; Returned reversed list so that the charsets specified by the
+ ;; key `ctext-non-standard-encodings' for the current language
+ ;; have the highest priority.
+ (nreverse table)))
(defun ctext-pre-write-conversion (from to)
"Encode characters between FROM and TO as Compound Text w/Extended Segments.
by encode-coding-string, generate a new temp buffer, insert the
text, and convert it in the temporary buffer. Otherwise, convert in-place."
(save-match-data
- (let ((workbuf (get-buffer-create " *code-conversion-work*")))
- ;; Setup a working buffer if necessary.
- (cond ((stringp from)
- (set-buffer workbuf)
- (erase-buffer)
- (set-buffer-multibyte (multibyte-string-p from))
- (insert from))
- ((not (eq (current-buffer) workbuf))
- (let ((buf (current-buffer))
- (multibyte enable-multibyte-characters))
- (set-buffer workbuf)
- (erase-buffer)
- (set-buffer-multibyte multibyte)
- (insert-buffer-substring buf from to)))))
+ ;; Setup a working buffer if necessary.
+ (when (stringp from)
+ (set-buffer (generate-new-buffer " *temp"))
+ (set-buffer-multibyte (multibyte-string-p from))
+ (insert from))
;; Now we can encode the whole buffer.
(let ((encoding-table (ctext-non-standard-encodings-table))
last-coding-system-used
last-pos last-encoding-info
- encoding-info end-pos)
+ encoding-info end-pos ch)
(goto-char (setq last-pos (point-min)))
(setq end-pos (point-marker))
(while (re-search-forward "[^\000-\177]+" nil t)
;; Found a sequence of non-ASCII characters.
(setq last-pos (match-beginning 0)
- last-encoding-info (aref encoding-table (char-after last-pos)))
+ ch (char-after last-pos)
+ last-encoding-info (catch 'tag
+ (dolist (elt encoding-table)
+ (if (encode-char ch (car elt))
+ (throw 'tag (cdr elt))))
+ 'utf-8))
(set-marker end-pos (match-end 0))
(goto-char (1+ last-pos))
(catch 'tag
(while t
(setq encoding-info
(if (< (point) end-pos)
- (aref encoding-table (following-char))))
+ (catch 'tag
+ (setq ch (following-char))
+ (dolist (elt encoding-table)
+ (if (encode-char ch (car elt))
+ (throw 'tag (cdr elt))))
+ 'utf-8)))
(unless (eq last-encoding-info encoding-info)
(cond ((consp last-encoding-info)
;; Encode the previous range using an extended
(encode-coding-region last-pos (point) coding-system)
(setq len (+ (length encoding-name) 1
(- (point) last-pos)))
+ ;; According to the spec of CTEXT, it is not
+ ;; necessary to produce this extra designation
+ ;; sequence, but some buggy application
+ ;; (e.g. crxvt-gb) requires it.
+ (insert "\e(B")
(save-excursion
(goto-char last-pos)
- (insert (string-to-multibyte
- (format "\e%%/%d%c%c%s\ 2"
- noctets
- (+ (/ len 128) 128)
- (+ (% len 128) 128)
- encoding-name))))))
+ (insert (format "\e%%/%d" noctets))
+ (insert-byte (+ (/ len 128) 128) 1)
+ (insert-byte (+ (% len 128) 128) 1)
+ (insert encoding-name)
+ (insert 2))))
((eq last-encoding-info 'utf-8)
;; Encode the previous range using UTF-8 encoding
;; extention.
'(("^BABYL OPTIONS:[ \t]*-\\*-[ \t]*rmail[ \t]*-\\*-" . no-conversion)
("\\`\xFE\xFF" . utf-16be-with-signature)
("\\`\xFF\xFE" . utf-16le-with-signature)
- ("\\`\xEF\xBB\xBF" . utf-8))
+ ("\\`\xEF\xBB\xBF" . utf-8)
+ ("\\`;ELC\024\0\0\0" . emacs-mule)) ; Emacs 20-compiled
"Alist of patterns vs corresponding coding systems.
Each element looks like (REGEXP . CODING-SYSTEM).
A file whose first bytes match REGEXP is decoded by CODING-SYSTEM on reading.
(setq buffer-file-coding-system-explicit coding-system-for-read))
(if last-coding-system-used
(let ((coding-system
- (find-new-buffer-file-coding-system last-coding-system-used))
- (modified-p (buffer-modified-p)))
+ (find-new-buffer-file-coding-system last-coding-system-used)))
(when coding-system
;; Tell set-buffer-file-coding-system not to mark the file
;; as modified; we just read it, and it's supposed to be unmodified.
;; Marking it modified would try to lock it, which would
;; check the modtime, and we don't want to do that again now.
- (set-buffer-file-coding-system coding-system t t)
- (if (and enable-multibyte-characters
- (or (eq coding-system 'no-conversion)
- (eq (coding-system-type coding-system) 5))
- ;; If buffer was unmodified and the size is the
- ;; same as INSERTED, we must be visiting it.
- (not modified-p)
- (= (buffer-size) inserted))
- ;; For coding systems no-conversion and raw-text...,
- ;; edit the buffer as unibyte.
- (let ((pos-marker (copy-marker (+ (point) inserted)))
- ;; Prevent locking.
- (buffer-file-name nil))
- (if visit
- ;; If we're doing this for find-file,
- ;; don't record undo info; this counts as
- ;; part of producing the buffer's initial contents.
- (let ((buffer-undo-list t))
- (set-buffer-multibyte nil))
- (set-buffer-multibyte nil))
- (setq inserted (- pos-marker (point)))))
- (restore-buffer-modified-p modified-p))))
+ (set-buffer-file-coding-system coding-system t t))))
inserted)
;; The coding-spec and eol-type of coding-system returned is decided
;; But eol-type is not yet set.
(setq local-eol nil))
(if (and buffer-file-coding-system
- (not (eq (coding-system-type buffer-file-coding-system) t)))
- ;; This is not `undecided'.
+ (not (eq (coding-system-type buffer-file-coding-system)
+ 'undecided)))
(setq local-coding (coding-system-base buffer-file-coding-system)))
(if (and (local-variable-p 'buffer-file-coding-system)
;; But eol-type is not found.
;; If EOL conversions are inhibited, force unix eol-type.
(setq found-eol (if inhibit-eol-conversion 0)))
- (if (eq (coding-system-type coding) t)
- (setq found-coding 'undecided)
- (setq found-coding (coding-system-base coding)))
+ (setq found-coding (coding-system-base coding))
(if (and (not found-eol) (eq found-coding 'undecided))
;; No valid coding information found.
Each argument is a list of elements of the form (FROM . TO), where FROM
is a character to be translated to TO.
-FROM can be a generic character (see `make-char'). In this case, TO is
-a generic character containing the same number of characters, or an
-ordinary character. If FROM and TO are both generic characters, all
-characters belonging to FROM are translated to characters belonging to TO
-without changing their position code(s).
-
The arguments and forms in each argument are processed in the given
order, and if a previous form already translates TO to some other
character, say TO-ALT, FROM is also translated to TO-ALT."
(let ((table (make-char-table 'translation-table))
revlist)
- (while args
- (let ((elts (car args)))
- (while elts
- (let* ((from (car (car elts)))
- (from-i 0) ; degree of freedom of FROM
- (from-rev (nreverse (split-char from)))
- (to (cdr (car elts)))
- (to-i 0) ; degree of freedom of TO
- (to-rev (nreverse (split-char to))))
- ;; Check numbers of heading 0s in FROM-REV and TO-REV.
- (while (eq (car from-rev) 0)
- (setq from-i (1+ from-i) from-rev (cdr from-rev)))
- (while (eq (car to-rev) 0)
- (setq to-i (1+ to-i) to-rev (cdr to-rev)))
- (if (and (/= from-i to-i) (/= to-i 0))
- (error "Invalid character pair (%d . %d)" from to))
- ;; If we have already translated TO to TO-ALT, FROM should
- ;; also be translated to TO-ALT. But, this is only if TO
- ;; is a generic character or TO-ALT is not a generic
- ;; character.
- (let ((to-alt (aref table to)))
- (if (and to-alt
- (or (> to-i 0) (not (generic-char-p to-alt))))
- (setq to to-alt)))
- (if (> from-i 0)
- (set-char-table-default table from to)
- (aset table from to))
- ;; If we have already translated some chars to FROM, they
- ;; should also be translated to TO.
- (let ((l (assq from revlist)))
- (if l
- (let ((ch (car l)))
- (setcar l to)
- (setq l (cdr l))
- (while l
- (aset table ch to)
- (setq l (cdr l)) ))))
- ;; Now update REVLIST.
- (let ((l (assq to revlist)))
- (if l
- (setcdr l (cons from (cdr l)))
- (setq revlist (cons (list to from) revlist)))))
- (setq elts (cdr elts))))
- (setq args (cdr args)))
+ (dolist (elts args)
+ (dolist (elt elts)
+ (let ((from (car elt))
+ (to (cdr elt))
+ to-alt rev-from rev-to)
+ ;; If we have already translated TO to TO-ALT, FROM should
+ ;; also be translated to TO-ALT.
+ (if (setq to-alt (aref table to))
+ (setq to to-alt))
+ (aset table from to)
+ ;; If we have already translated some chars to FROM, they
+ ;; should also be translated to TO.
+ (when (setq rev-from (assq from revlist))
+ (dolist (elt (cdr rev-from))
+ (aset table elt to))
+ (setq revlist (delq rev-from revlist)
+ rev-from (cdr rev-from)))
+ ;; Now update REVLIST.
+ (setq rev-to (assq to revlist))
+ (if rev-to
+ (setcdr rev-to (cons from (cdr rev-to)))
+ (setq rev-to (list to from)
+ revlist (cons rev-to revlist)))
+ (if rev-from
+ (setcdr rev-to (append rev-from (cdr rev-to)))))))
;; Return TABLE just created.
+ (set-char-table-extra-slot table 1 1)
table))
(defun make-translation-table-from-vector (vec)
(if (>= ch 256)
(aset rev-table ch i))))
(set-char-table-extra-slot table 0 rev-table)
+ (set-char-table-extra-slot table 1 1)
+ (set-char-table-extra-slot rev-table 1 1)
table))
+(defun make-translation-table-from-alist (alist)
+ "Make translation table from N<->M mapping in ALIST.
+ALIST is an alist, each element has the form (FROM . TO).
+FROM and TO are a character or a vector of characters.
+If FROM is a character, that character is translated to TO.
+If FROM is a vector of characters, that sequence is translated to TO.
+The first extra-slot of the value is a translation table for reverse mapping."
+ (let ((tables (vector (make-char-table 'translation-table)
+ (make-char-table 'translation-table)))
+ table max-lookup from to idx val)
+ (dotimes (i 2)
+ (setq table (aref tables i))
+ (setq max-lookup 1)
+ (dolist (elt alist)
+ (if (= i 0)
+ (setq from (car elt) to (cdr elt))
+ (setq from (cdr elt) to (car elt)))
+ (if (characterp from)
+ (setq idx from)
+ (setq idx (aref from 0)
+ max-lookup (max max-lookup (length from))))
+ (setq val (aref table idx))
+ (if val
+ (progn
+ (or (consp val)
+ (setq val (list (cons (vector idx) val))))
+ (if (characterp from)
+ (setq from (vector from)))
+ (setq val (nconc val (list (cons from to)))))
+ (if (characterp from)
+ (setq val to)
+ (setq val (list (cons from to)))))
+ (aset table idx val))
+ (set-char-table-extra-slot table 1 max-lookup))
+ (set-char-table-extra-slot (aref tables 0) 0 (aref tables 1))
+ (aref tables 0)))
+
(defun define-translation-table (symbol &rest args)
"Define SYMBOL as the name of translation table made by ARGS.
This sets up information so that the table can be used for
(put 'with-category-table 'lisp-indent-function 1)
(defmacro with-category-table (table &rest body)
- "Evaluate BODY with category table of current buffer set to TABLE.
+ "Execute BODY like `progn' with CATEGORY-TABLE the current category table.
The category table of the current buffer is saved, BODY is evaluated,
then the saved table is restored, even in case of an abnormal exit.
Value is what BODY returns."
(setq ignore-relative-composition
(make-char-table 'ignore-relative-composition))
+(make-obsolete 'set-char-table-default
+ "Generic characters no longer exist" "23.1")
;;; Built-in auto-coding-functions:
;;; quail.el --- provides simple input method for multilingual text
;; Copyright (C) 1997, 1998, 2000, 2001, 2002, 2003, 2004, 2005,
- ;; 2006, 2007 Free Software Foundation, Inc.
+ ;; 2006, 2007, 2008 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- ;; 2005, 2006, 2007
+ ;; 2005, 2006, 2007, 2008
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
(if translation
(progn
(if (consp translation)
- (setq translation (aref (cdr translation) 0)))
+ (if (> (length (cdr translation)) 0)
+ (setq translation (aref (cdr translation) 0))
+ (setq translation " ")))
(setq done-list (cons translation done-list)))
(setq translation ch))
(aset layout i translation))
(defun quail-input-string-to-events (str)
"Convert input string STR to a list of events.
-Do so while interleaving with the following special events:
-\(compose-last-chars LEN COMPONENTS)
-\(quail-advice INPUT-STRING)"
- (let* ((events (mapcar
- (lambda (c)
- ;; This gives us the chance to unify on input
- ;; (e.g. using ucs-tables.el).
- (or (and translation-table-for-input
- (aref translation-table-for-input c))
- c))
- str))
- (len (length str))
- (idx len)
- composition from to)
- (while (and (> idx 0)
- (setq composition (find-composition idx 0 str t)))
- (setq from (car composition) to (nth 1 composition))
- (setcdr (nthcdr (1- to) events)
- (cons (list 'compose-last-chars (- to from)
- (and (not (nth 3 composition)) (nth 2 composition)))
- (nthcdr to events)))
- (setq idx (1- from)))
+If STR has `advice' text property, append the following special event:
+\(quail-advice STR)"
+ (let ((events (mapcar
+ (lambda (c)
+ ;; This gives us the chance to unify on input
+ ;; (e.g. using ucs-tables.el).
+ (or (and translation-table-for-input
+ (aref translation-table-for-input c))
+ c))
+ str)))
(if (or (get-text-property 0 'advice str)
(next-single-property-change 0 'advice str))
(setq events
"Return string to be shown as current translation of key sequence.
LEN is the length of the sequence. DEF is a definition part of the
Quail map for the sequence."
- (or (and (consp def) (aref (cdr def) (car (car def))))
+ (or (and (consp def)
+ (if (> (length (cdr def)) (car (car def)))
+ (aref (cdr def) (car (car def)))
+ ""))
def
(and (> len 1)
(let* ((str (quail-get-current-str
(defun quail-get-translations ()
"Return a string containing the current possible translations."
+ (or (multibyte-string-p quail-current-key)
+ (setq quail-current-key (string-to-multibyte quail-current-key)))
(let ((map (quail-lookup-key quail-current-key nil t))
(str (copy-sequence quail-current-key)))
(if quail-current-translations
;; Show the current key.
(let ((guidance (quail-guidance)))
(if (listp guidance)
- ;; We must replace thetyped key with the specified PROMPTKEY.
+ ;; We must replace the typed key with the specified PROMPT-KEY.
(dotimes (i (length str))
(let ((prompt-key (cdr (assoc (aref str i) guidance))))
(if prompt-key
(when (> num 0)
(insert "
KEY SEQUENCE
------------
+------------
")
(if (quail-show-layout)
(insert "You can also input more characters")
;; At last, write out LEIM list file.
(with-current-buffer list-buf
- (setq buffer-file-coding-system 'iso-2022-7bit)
- (save-buffer 0))
+ (let ((coding-system-for-write 'iso-2022-7bit))
+ (save-buffer 0)))
(kill-buffer list-buf)
(message "Updating %s ... done" leim-list)))
\f
;;; titdic-cnv.el --- convert cxterm dictionary (TIT format) to Quail package -*- coding:iso-2022-7bit; -*-
;; Copyright (C) 1997, 1998, 2000, 2001, 2002, 2003, 2004,
- ;; 2005, 2006, 2007 Free Software Foundation, Inc.
+ ;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- ;; 2005, 2006, 2007
+ ;; 2005, 2006, 2007, 2008
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
+;; Copyright (C) 2003
+;; National Institute of Advanced Industrial Science and Technology (AIST)
+;; Registration Number H13PRO009
;; Keywords: Quail, TIT, cxterm
(princ ";; Quail package `")
(princ package)
- (princ "' -*- coding:iso-2022-7bit; ")
+ (princ (format "' -*- coding:%s; " coding-system-for-write))
(princ "byte-compile-disable-print-circle:t; -*-\n")
(princ ";; Generated by the command `titdic-convert'\n;;\tDate: ")
(princ (current-time-string))
Optional argument DIRNAME if specified is the directory name under which
the generated Quail package is saved."
(interactive "FTIT dictionary file: ")
- (let ((coding-system-for-write 'iso-2022-7bit-unix))
+ (let ((coding-system-for-write nil))
(with-temp-file (tit-make-quail-package-file-name filename dirname)
- ;; Explicitly speficy eol format to `unix'.
- (set-buffer-file-coding-system 'iso-2022-7bit-unix)
(let ((standard-output (current-buffer)))
(with-temp-buffer
(set-buffer-multibyte nil)
(setq coding-system (nth 1 slot))
(message "Decoding with coding system %s..." coding-system)
(goto-char (point-min))
- (decode-coding-region (point-min) (point-max) coding-system))
+ (decode-coding-region (point-min) (point-max) coding-system)
+ ;; Explicitly set eol format to `unix'.
+ (setq coding-system-for-write
+ (coding-system-change-eol-conversion coding-system 'unix))
+ (remove-text-properties (point-min) (point-max) '(charset nil)))
+ (set-buffer-multibyte t)
;; Set point the starting position of the body part.
(goto-char (point-min))
(if (not (search-forward "\nBEGIN" nil t))
(error "TIT dictionary can't be decoded correctly"))
- ;; Process the header part in multibyte mode.
- (with-current-buffer standard-output
- (set-buffer-multibyte t))
- (set-buffer-multibyte t)
+ ;; Process the header part.
(forward-line 1)
(narrow-to-region (point-min) (point))
(tit-process-header filename)
(widen)
- ;; Process the body part. For speed, we turn off multibyte facility.
- (with-current-buffer standard-output
- (set-buffer-multibyte nil))
- (set-buffer-multibyte nil)
+ ;; Process the body part
(tit-process-body))))))
;;;###autoload
(or (file-readable-p filename)
(error "%s does not exist" filename))
(let ((tail quail-misc-package-ext-info)
- (default-buffer-file-coding-system 'iso-2022-7bit)
+ coding-system-for-write
slot
name title dicfile coding quailfile converter copyright
dicbuf)
converter (nth 5 slot)
copyright (nth 6 slot))
(message "Converting %s to %s..." dicfile quailfile)
+ ;; Explicitly set eol format to `unix'.
+ (setq coding-system-for-write
+ (coding-system-change-eol-conversion coding 'unix))
(with-temp-file (expand-file-name quailfile dirname)
- ;; Explicitly speficy eol format to `unix'.
- (set-buffer-file-coding-system 'iso-2022-7bit-unix)
- (insert ";; Quail package `" name "' -*- coding:iso-2022-7bit; ")
- (insert "byte-compile-disable-print-circle:t; -*-\n");
+ (insert (format ";; Quail package `%s' -*- coding:%s; " name coding))
+ (insert "byte-compile-disable-print-circle:t; -*-\n")
(insert ";; Generated by the command `miscdic-convert'\n")
(insert ";; Date: " (current-time-string) "\n")
(insert ";; Source dictionary file: " dicfile "\n")
(insert ";;; Code:\n\n")
(insert "(require 'quail)\n")
(insert "(quail-define-package \"" name "\" \""
- (if (eq coding 'big5) "Chinese-BIG5" "Chinese-CNS")
+ (if (eq coding 'big5) "Chinese-BIG5"
+ (if (eq coding 'iso-2022-cn-ext) "Chinese-CNS"
+ "Chinese-GB"))
"\" \"" title "\" t\n")
(let* ((coding-system-for-read coding)
(dicbuf (find-file-noselect filename)))
command-line-args-left (cdr command-line-args-left))
(if (file-directory-p filename)
(dolist (file (directory-files filename t nil t))
- (miscdic-convert file dir))
+ (or (file-directory-p file)
+ (miscdic-convert file dir)))
(miscdic-convert filename dir))))
(kill-emacs 0))
;;; utf-7.el --- utf-7 coding system
- ;; Copyright (C) 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ ;; Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Keywords: i18n, mail
;;; Code:
-;;;###autoload(autoload-coding-system 'utf-7 '(require 'utf-7))
-(make-coding-system
- 'utf-7 0 ?U
- "UTF-7 encoding of Unicode (RFC 2152)"
- nil
- `((safe-chars . ,(coding-system-get 'utf-16be 'safe-chars))
- (mime-charset . utf-7)
- (pre-write-conversion . utf-7-pre-write-conversion)
- (post-read-conversion . utf-7-post-read-conversion)))
-
-;;;###autoload(autoload-coding-system 'utf-7-imap '(require 'utf-7))
-(make-coding-system
- 'utf-7-imap 0 ?u
- "UTF-7 encoding of Unicode, IMAP version (RFC 2060)"
- nil
- `((safe-chars . ,(coding-system-get 'utf-16be 'safe-chars))
- (pre-write-conversion . utf-7-imap-pre-write-conversion)
- (post-read-conversion . utf-7-imap-post-read-conversion)))
-
(defun utf-7-decode (len imap)
"Decode LEN bytes of UTF-7 at point.
IMAP non-nil means use the IMAP version."
(delete-backward-char 1)))))))
(- (point-max) (point-min)))))
+;;;###autoload
(defun utf-7-post-read-conversion (len)
(utf-7-decode len nil))
+;;;###autoload
(defun utf-7-imap-post-read-conversion (len)
(utf-7-decode len t))
(insert ?-)))))
nil))
+;;;###autoload
(defun utf-7-pre-write-conversion (from to)
(utf-7-encode from to nil))
+;;;###autoload
(defun utf-7-imap-pre-write-conversion (from to)
(utf-7-encode from to t))
;;; isearch.el --- incremental search minor mode
;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1999, 2000,
- ;; 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ ;; 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Daniel LaLiberte <liberte@cs.uiuc.edu>
;; Maintainer: FSF
(defvar isearch-mode-map
(let* ((i 0)
(map (make-keymap)))
- (or (vectorp (nth 1 map))
- (char-table-p (nth 1 map))
+ (or (char-table-p (nth 1 map))
(error "The initialization of isearch-mode-map must be updated"))
;; Make all multibyte characters search for themselves.
- (let ((l (generic-character-list))
- (table (nth 1 map)))
- (while l
- (set-char-table-default table (car l) 'isearch-printing-char)
- (setq l (cdr l))))
+ (set-char-table-range (nth 1 map) (cons #x100 (max-char))
+ 'isearch-printing-char)
;; Make function keys, etc, which aren't bound to a scrolling-function
;; exit the search.
(define-key map [t] 'isearch-other-control-char)
;;; china-util.el --- utilities for Chinese -*- coding: iso-2022-7bit -*-
- ;; Copyright (C) 1995, 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ ;; Copyright (C) 1995, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
;; Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- ;; 2005, 2006, 2007
+ ;; 2005, 2006, 2007, 2008
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
+;; Copyright (C) 2003
+;; National Institute of Advanced Industrial Science and Technology (AIST)
+;; Registration Number H13PRO009
;; Keywords: mule, multilingual, Chinese
(push i chars)
(setq i (1+ i)))
(while (< i 127)
- (push (+ i 128) chars)
+ (push (decode-char 'eight-bit (+ i 128)) chars)
(setq i (1+ i)))
(apply 'string (nreverse chars)))))
(interactive)
(encode-hz-region (point-min) (point-max)))
-;; The following sets up a translation table (big5-to-cns) from Big 5
-;; to CNS encoding, using some auxiliary functions to make the code
-;; more readable.
-
-;; Many kudos to Himi! The used code has been adapted from his
-;; mule-ucs package.
-
-(eval-when-compile
-(defun big5-to-flat-code (num)
- "Convert NUM in Big 5 encoding to a `flat code'.
-0xA140 will be mapped to position 0, 0xA141 to position 1, etc.
-There are no gaps in the flat code."
-
- (let ((hi (/ num 256))
- (lo (% num 256)))
- (+ (* 157 (- hi #xa1))
- (- lo (if (>= lo #xa1) 98 64)))))
-
-(defun flat-code-to-big5 (num)
- "Convert NUM from a `flat code' to Big 5 encoding.
-This is the inverse function of `big5-to-flat-code'."
-
- (let ((hi (/ num 157))
- (lo (% num 157)))
- (+ (* 256 (+ hi #xa1))
- (+ lo (if (< lo 63) 64 98)))))
-
-(defun euc-to-flat-code (num)
- "Convert NUM in EUC encoding (in GL representation) to a `flat code'.
-0x2121 will be mapped to position 0, 0x2122 to position 1, etc.
-There are no gaps in the flat code."
-
- (let ((hi (/ num 256))
- (lo (% num 256)))
- (+ (* 94 (- hi #x21))
- (- lo #x21))))
-
-(defun flat-code-to-euc (num)
- "Convert NUM from a `flat code' to EUC encoding (in GL representation).
-The inverse function of `euc-to-flat-code'. The high and low bytes are
-returned in a list."
-
- (let ((hi (/ num 94))
- (lo (% num 94)))
- (list (+ hi #x21) (+ lo #x21))))
-
-(defun expand-euc-big5-alist (alist)
- "Create a translation table and fills it with data given in ALIST.
-Elements of ALIST can be either given as
-
- ((euc-charset . startchar) . (big5-range-begin . big5-range-end))
-
-or as
-
- (euc-character . big5-charcode)
-
-The former maps a range of glyphs in an EUC charset (where STARTCHAR
-is in GL representation) to a certain range of Big 5 encoded
-characters, the latter maps a single glyph. Glyphs which can't be
-mapped will be represented with the byte 0xFF.
-
-The return value is the filled translation table."
-
- (let ((chartable (make-char-table 'translation-table #xFF))
- char
- big5
- i
- end
- codepoint
- charset)
- (dolist (elem alist)
- (setq char (car elem)
- big5 (cdr elem))
- (cond ((and (consp char)
- (consp big5))
- (setq i (big5-to-flat-code (car big5))
- end (big5-to-flat-code (cdr big5))
- codepoint (euc-to-flat-code (cdr char))
- charset (car char))
- (while (>= end i)
- (aset chartable
- (decode-big5-char (flat-code-to-big5 i))
- (apply (function make-char)
- charset
- (flat-code-to-euc codepoint)))
- (setq i (1+ i)
- codepoint (1+ codepoint))))
- ((and (char-valid-p char)
- (numberp big5))
- (setq i (decode-big5-char big5))
- (aset chartable i char))
- (t
- (error "Unknown slot type: %S" elem))))
- ;; the return value
- chartable)))
-
-;; All non-CNS encodings are commented out.
-
-(define-translation-table 'big5-to-cns
- (eval-when-compile
- (expand-euc-big5-alist
- '(
- ;; Symbols
- ((chinese-cns11643-1 . #x2121) . (#xA140 . #xA1F5))
- (?\e$(G"X\e(B . #xA1F6)
- (?\e$(G"W\e(B . #xA1F7)
- ((chinese-cns11643-1 . #x2259) . (#xA1F8 . #xA2AE))
- ((chinese-cns11643-1 . #x2421) . (#xA2AF . #xA3BF))
- ;; Control codes (vendor dependent)
- ((chinese-cns11643-1 . #x4221) . (#xA3C0 . #xA3E0))
- ;; Level 1 Ideographs
- ((chinese-cns11643-1 . #x4421) . (#xA440 . #xACFD))
- (?\e$(GWS\e(B . #xACFE)
- ((chinese-cns11643-1 . #x5323) . (#xAD40 . #xAFCF))
- ((chinese-cns11643-1 . #x5754) . (#xAFD0 . #xBBC7))
- ((chinese-cns11643-1 . #x6B51) . (#xBBC8 . #xBE51))
- (?\e$(GkP\e(B . #xBE52)
- ((chinese-cns11643-1 . #x6F5C) . (#xBE53 . #xC1AA))
- ((chinese-cns11643-1 . #x7536) . (#xC1AB . #xC2CA))
- (?\e$(Gu5\e(B . #xC2CB)
- ((chinese-cns11643-1 . #x7737) . (#xC2CC . #xC360))
- ((chinese-cns11643-1 . #x782E) . (#xC361 . #xC3B8))
- (?\e$(Gxe\e(B . #xC3B9)
- (?\e$(Gxd\e(B . #xC3BA)
- ((chinese-cns11643-1 . #x7866) . (#xC3BB . #xC455))
- (?\e$(Gx-\e(B . #xC456)
- ((chinese-cns11643-1 . #x7962) . (#xC457 . #xC67E))
- ;; Symbols
- ((chinese-cns11643-1 . #x2621) . (#xC6A1 . #xC6BE))
- ;; Radicals
- (?\e$(G'#\e(B . #xC6BF)
- (?\e$(G'$\e(B . #xC6C0)
- (?\e$(G'&\e(B . #xC6C1)
- (?\e$(G'(\e(B . #xC6C2)
- (?\e$(G'-\e(B . #xC6C3)
- (?\e$(G'.\e(B . #xC6C4)
- (?\e$(G'/\e(B . #xC6C5)
- (?\e$(G'4\e(B . #xC6C6)
- (?\e$(G'7\e(B . #xC6C7)
- (?\e$(G':\e(B . #xC6C8)
- (?\e$(G'<\e(B . #xC6C9)
- (?\e$(G'B\e(B . #xC6CA)
- (?\e$(G'G\e(B . #xC6CB)
- (?\e$(G'N\e(B . #xC6CC)
- (?\e$(G'S\e(B . #xC6CD)
- (?\e$(G'T\e(B . #xC6CE)
- (?\e$(G'U\e(B . #xC6CF)
- (?\e$(G'Y\e(B . #xC6D0)
- (?\e$(G'Z\e(B . #xC6D1)
- (?\e$(G'a\e(B . #xC6D2)
- (?\e$(G'f\e(B . #xC6D3)
- (?\e$(G()\e(B . #xC6D4)
- (?\e$(G(*\e(B . #xC6D5)
- (?\e$(G(c\e(B . #xC6D6)
- (?\e$(G(l\e(B . #xC6D7)
- ;; Diacritical Marks
- ; ((japanese-jisx0208 . #x212F) . (#xC6D8 . #xC6D9))
- ;; Japanese Kana Supplement
- ; ((japanese-jisx0208 . #x2133) . (#xC6DA . #xC6E3))
- ;; Japanese Hiragana
- ; ((japanese-jisx0208 . #x2421) . (#xC6E7 . #xC77A))
- ;; Japanese Katakana
- ; ((japanese-jisx0208 . #x2521) . (#xC77B . #xC7F2))
- ;; Cyrillic Characters
- ; ((japanese-jisx0208 . #x2721) . (#xC7F3 . #xC854))
- ; ((japanese-jisx0208 . #x2751) . (#xC855 . #xC875))
- ;; Special Chinese Characters
- (?\e$(J!#\e(B . #xC879)
- (?\e$(J!$\e(B . #xC87B)
- (?\e$(J!*\e(B . #xC87D)
- (?\e$(J!R\e(B . #xC8A2)
-
- ;; JIS X 0208 NOT SIGN (cf. U+00AC)
- ; (?\e$B"L\e(B . #xC8CD)
- ;; JIS X 0212 BROKEN BAR (cf. U+00A6)
- ; (?\e$(D"C\e(B . #xC8CE)
-
- ;; GB 2312 characters
- ; (?\e$A!d\e(B . #xC8CF)
- ; (?\e$A!e\e(B . #xC8D0)
- ;;;;; C8D1 - Japanese `(\e$B3t\e(B)'
- ; (?\e$A!m\e(B . #xC8D2)
- ;;;;; C8D2 - Tel.
-
- ;; Level 2 Ideographs
- ((chinese-cns11643-2 . #x2121) . (#xC940 . #xC949))
- (?\e$(GDB\e(B . #xC94A);; a duplicate of #xA461
- ((chinese-cns11643-2 . #x212B) . (#xC94B . #xC96B))
- ((chinese-cns11643-2 . #x214D) . (#xC96C . #xC9BD))
- (?\e$(H!L\e(B . #xC9BE)
- ((chinese-cns11643-2 . #x217D) . (#xC9BF . #xC9EC))
- ((chinese-cns11643-2 . #x224E) . (#xC9ED . #xCAF6))
- (?\e$(H"M\e(B . #xCAF7)
- ((chinese-cns11643-2 . #x2439) . (#xCAF8 . #xD6CB))
- (?\e$(H>c\e(B . #xD6CC)
- ((chinese-cns11643-2 . #x3770) . (#xD6CD . #xD779))
- (?\e$(H?j\e(B . #xD77A)
- ((chinese-cns11643-2 . #x387E) . (#xD77B . #xDADE))
- (?\e$(H7o\e(B . #xDADF)
- ((chinese-cns11643-2 . #x3E64) . (#xDAE0 . #xDBA6))
- ((chinese-cns11643-2 . #x3F6B) . (#xDBA7 . #xDDFB))
- (?\e$(HAv\e(B . #xDDFC);; a duplicate of #xDCD1
- ((chinese-cns11643-2 . #x4424) . (#xDDFD . #xE8A2))
- ((chinese-cns11643-2 . #x554C) . (#xE8A3 . #xE975))
- ((chinese-cns11643-2 . #x5723) . (#xE976 . #xEB5A))
- ((chinese-cns11643-2 . #x5A29) . (#xEB5B . #xEBF0))
- (?\e$(HUK\e(B . #xEBF1)
- ((chinese-cns11643-2 . #x5B3F) . (#xEBF2 . #xECDD))
- (?\e$(HW"\e(B . #xECDE)
- ((chinese-cns11643-2 . #x5C6A) . (#xECDF . #xEDA9))
- ((chinese-cns11643-2 . #x5D75) . (#xEDAA . #xEEEA))
- (?\e$(Hd/\e(B . #xEEEB)
- ((chinese-cns11643-2 . #x6039) . (#xEEEC . #xF055))
- (?\e$(H]t\e(B . #xF056)
- ((chinese-cns11643-2 . #x6243) . (#xF057 . #xF0CA))
- (?\e$(HZ(\e(B . #xF0CB)
- ((chinese-cns11643-2 . #x6337) . (#xF0CC . #xF162))
- ((chinese-cns11643-2 . #x6430) . (#xF163 . #xF16A))
- (?\e$(Hga\e(B . #xF16B)
- ((chinese-cns11643-2 . #x6438) . (#xF16C . #xF267))
- (?\e$(Hi4\e(B . #xF268)
- ((chinese-cns11643-2 . #x6573) . (#xF269 . #xF2C2))
- ((chinese-cns11643-2 . #x664E) . (#xF2C3 . #xF374))
- ((chinese-cns11643-2 . #x6762) . (#xF375 . #xF465))
- ((chinese-cns11643-2 . #x6935) . (#xF466 . #xF4B4))
- (?\e$(HfM\e(B . #xF4B5)
- ((chinese-cns11643-2 . #x6962) . (#xF4B6 . #xF4FC))
- ((chinese-cns11643-2 . #x6A4C) . (#xF4FD . #xF662))
- (?\e$(HjK\e(B . #xF663)
- ((chinese-cns11643-2 . #x6C52) . (#xF664 . #xF976))
- ((chinese-cns11643-2 . #x7167) . (#xF977 . #xF9C3))
- (?\e$(Hqf\e(B . #xF9C4)
- (?\e$(Hr4\e(B . #xF9C5)
- (?\e$(Hr@\e(B . #xF9C6)
- ((chinese-cns11643-2 . #x7235) . (#xF9C7 . #xF9D1))
- ((chinese-cns11643-2 . #x7241) . (#xF9D2 . #xF9D5))
-
- ;; Additional Ideographs
- (?\e$(IC7\e(B . #xF9D6)
- (?\e$(IOP\e(B . #xF9D7)
- (?\e$(IDN\e(B . #xF9D8)
- (?\e$(IPJ\e(B . #xF9D9)
- (?\e$(I,]\e(B . #xF9DA)
- (?\e$(I=~\e(B . #xF9DB)
- (?\e$(IK\\e(B . #xF9DC)
- )
- ))
-)
+;;;###autoload
+(defun post-read-decode-hz (len)
+ (let ((pos (point))
+ (buffer-modified-p (buffer-modified-p))
+ last-coding-system-used)
+ (prog1
+ (decode-hz-region pos (+ pos len))
+ (set-buffer-modified-p buffer-modified-p))))
+;;;###autoload
+(defun pre-write-encode-hz (from to)
+ (let ((buf (current-buffer)))
+ (set-buffer (generate-new-buffer " *temp*"))
+ (if (stringp from)
+ (insert from)
+ (insert-buffer-substring buf from to))
+ (let (last-coding-system-used)
+ (encode-hz-region 1 (point-max)))
+ nil))
;;
(provide 'china-util)
;;; chinese.el --- support for Chinese -*- coding: iso-2022-7bit; -*-
- ;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ ;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
;; Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- ;; 2005, 2006, 2007
+ ;; 2005, 2006, 2007, 2008
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
+;; Copyright (C) 2003
+;; National Institute of Advanced Industrial Science and Technology (AIST)
+;; Registration Number H13PRO009
;; Keywords: multilingual, Chinese
;;; Chinese (general)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(make-coding-system
- 'iso-2022-cn 2 ?C
- "ISO 2022 based 7bit encoding for Chinese GB and CNS (MIME:ISO-2022-CN)."
- '(ascii
- (nil chinese-gb2312 chinese-cns11643-1)
- (nil chinese-cns11643-2)
- nil
- nil ascii-eol ascii-cntl seven locking-shift single-shift nil nil nil
- init-bol)
- '((safe-charsets ascii chinese-gb2312 chinese-cns11643-1 chinese-cns11643-2)
- (mime-charset . iso-2022-cn)))
+
+(define-coding-system 'iso-2022-cn
+ "ISO 2022 based 7bit encoding for Chinese GB and CNS (MIME:ISO-2022-CN)."
+ :coding-type 'iso-2022
+ :mnemonic ?C
+ :charset-list '(ascii chinese-gb2312 chinese-cns11643-1 chinese-cns11643-2)
+ :designation [ascii
+ (nil chinese-gb2312 chinese-cns11643-1)
+ (nil chinese-cns11643-2)
+ nil]
+ :flags '(ascii-at-eol ascii-at-cntl 7-bit
+ designation locking-shift single-shift init-at-bol)
+ :mime-charset 'iso-2022-cn
+ :suitable-for-keyboard t)
(define-coding-system-alias 'chinese-iso-7bit 'iso-2022-cn)
-(make-coding-system
- 'iso-2022-cn-ext 2 ?C
- "ISO 2022 based 7bit encoding for Chinese GB and CNS (MIME:ISO-2022-CN-EXT)."
- '(ascii
- (nil chinese-gb2312 chinese-cns11643-1)
- (nil chinese-cns11643-2)
- (nil chinese-cns11643-3 chinese-cns11643-4 chinese-cns11643-5
- chinese-cns11643-6 chinese-cns11643-7)
- nil ascii-eol ascii-cntl seven locking-shift single-shift nil nil nil
- init-bol)
- '((safe-charsets ascii chinese-gb2312 chinese-cns11643-1 chinese-cns11643-2
- chinese-cns11643-3 chinese-cns11643-4 chinese-cns11643-5
- chinese-cns11643-6 chinese-cns11643-7)
- (mime-charset . iso-2022-cn-ext)))
+(define-coding-system 'iso-2022-cn-ext
+ "ISO 2022 based 7bit encoding for Chinese GB and CNS (MIME:ISO-2022-CN-EXT)."
+ :coding-type 'iso-2022
+ :mnemonic ?C
+ :charset-list '(ascii
+ chinese-gb2312 chinese-cns11643-1
+ chinese-cns11643-2 chinese-cns11643-3 chinese-cns11643-4
+ chinese-cns11643-5 chinese-cns11643-6 chinese-cns11643-7)
+ :designation '[ascii
+ (nil chinese-gb2312 chinese-cns11643-1)
+ (nil chinese-cns11643-2)
+ (nil chinese-cns11643-3 chinese-cns11643-4 chinese-cns11643-5
+ chinese-cns11643-6 chinese-cns11643-7)]
+ :flags '(ascii-at-eol ascii-at-cntl 7-bit
+ designation locking-shift single-shift init-at-bol)
+ :mime-charset 'iso-2022-cn-ext
+ :suitable-for-keyboard t)
\f
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Chinese GB2312 (simplified)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(make-coding-system
- 'chinese-iso-8bit 2 ?c
- "ISO 2022 based EUC encoding for Chinese GB2312 (MIME:GB2312)."
- '(ascii chinese-gb2312 nil nil
- nil ascii-eol ascii-cntl nil nil nil nil)
- '((safe-charsets ascii chinese-gb2312)
- (mime-charset . gb2312)))
+(define-coding-system 'chinese-iso-8bit
+ "ISO 2022 based EUC encoding for Chinese GB2312 (MIME:GB2312)."
+ :coding-type 'iso-2022
+ :mnemonic ?c
+ :charset-list '(ascii chinese-gb2312)
+ :designation [ascii chinese-gb2312 nil nil]
+ :mime-charset 'gb2312)
(define-coding-system-alias 'cn-gb-2312 'chinese-iso-8bit)
(define-coding-system-alias 'euc-china 'chinese-iso-8bit)
(define-coding-system-alias 'euc-cn 'chinese-iso-8bit)
(define-coding-system-alias 'cn-gb 'chinese-iso-8bit)
(define-coding-system-alias 'gb2312 'chinese-iso-8bit)
-(define-coding-system-alias 'cp936 'chinese-iso-8bit)
-(make-coding-system
- 'chinese-hz 0 ?z
- "Hz/ZW 7-bit encoding for Chinese GB2312 (MIME:HZ-GB-2312)."
- nil
- '((safe-charsets ascii chinese-gb2312)
- (mime-charset . hz-gb-2312)
- (post-read-conversion . post-read-decode-hz)
- (pre-write-conversion . pre-write-encode-hz)))
+(define-coding-system 'chinese-hz
+ "Hz/ZW 7-bit encoding for Chinese GB2312 (MIME:HZ-GB-2312)."
+ :coding-type 'utf-8
+ :mnemonic ?z
+ :charset-list '(ascii chinese-gb2312)
+ :mime-charset 'hz-gb-2312
+ :post-read-conversion 'post-read-decode-hz
+ :pre-write-conversion 'pre-write-encode-hz)
(define-coding-system-alias 'hz-gb-2312 'chinese-hz)
(define-coding-system-alias 'hz 'chinese-hz)
-(defun post-read-decode-hz (len)
- (let ((pos (point))
- (buffer-modified-p (buffer-modified-p))
- last-coding-system-used)
- (prog1
- (decode-hz-region pos (+ pos len))
- (set-buffer-modified-p buffer-modified-p))))
-
-(defun pre-write-encode-hz (from to)
- (let ((buf (current-buffer)))
- (set-buffer (generate-new-buffer " *temp*"))
- (if (stringp from)
- (insert from)
- (insert-buffer-substring buf from to))
- (let (last-coding-system-used)
- (encode-hz-region 1 (point-max)))
- nil))
-
(set-language-info-alist
"Chinese-GB" '((charset chinese-gb2312 chinese-sisheng)
(coding-system chinese-iso-8bit iso-2022-cn chinese-hz)
;; Chinese BIG5 (traditional)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(make-coding-system
- 'chinese-big5 3 ?B
- "BIG5 8-bit encoding for Chinese (MIME:Big5)."
- nil
- '((safe-charsets ascii chinese-big5-1 chinese-big5-2)
- (mime-charset . big5)
- (charset-origin-alist (chinese-big5-1 "BIG5" encode-big5-char)
- (chinese-big5-2 "BIG5" encode-big5-char))))
+(define-coding-system 'chinese-big5
+ "BIG5 8-bit encoding for Chinese (MIME:Big5)"
+ :coding-type 'charset
+ :mnemonic ?B
+ :charset-list '(ascii big5)
+ :mime-charset 'big5)
(define-coding-system-alias 'big5 'chinese-big5)
(define-coding-system-alias 'cn-big5 'chinese-big5)
(define-coding-system-alias 'cp950 'chinese-big5)
-;; Big5 font requires special encoding.
-(define-ccl-program ccl-encode-big5-font
- `(0
- ;; In: R0:chinese-big5-1 or chinese-big5-2
- ;; R1:position code 1
- ;; R2:position code 2
- ;; Out: R1:font code point 1
- ;; R2:font code point 2
- ((r2 = ((((r1 - ?\x21) * 94) + r2) - ?\x21))
- (if (r0 == ,(charset-id 'chinese-big5-2)) (r2 += 6280))
- (r1 = ((r2 / 157) + ?\xA1))
- (r2 %= 157)
- (if (r2 < ?\x3F) (r2 += ?\x40) (r2 += ?\x62))))
- "CCL program to encode a Big5 code to code point of Big5 font.")
-
-(setq font-ccl-encoder-alist
- (cons (cons "big5" ccl-encode-big5-font) font-ccl-encoder-alist))
-
(set-language-info-alist
"Chinese-BIG5" '((charset chinese-big5-1 chinese-big5-2)
(coding-system chinese-big5 chinese-iso-7bit)
(coding-priority chinese-big5 iso-2022-cn chinese-iso-8bit)
(input-method . "chinese-py-punct-b5")
+ (ctext-non-standard-encodings "big5-0")
(features china-util)
- (sample-text . "Cantonese (\e$(0GnM$\e(B,\e$(0N]0*Hd\e(B) \e$(0*/=(\e(B, \e$(0+$)p\e(B")
+ (sample-text . "Cantonese (\e$(Gemk#\e(B,\e$(Gl]N)fc\e(B) \e$ATg3?\e(B, \e$ADc:C\e(B")
(documentation . "Support for Chinese Big5 character set.")
(tutorial . "TUTORIAL.zh"))
'("Chinese"))
+(define-coding-system 'chinese-big5-hkscs
+ "BIG5-HKSCS 8-bit encoding for Chinese, Hong Kong supplement (MIME:Big5-HKSCS)"
+ :coding-type 'charset
+ :mnemonic ?B
+ :charset-list '(ascii big5-hkscs)
+ :mime-charset 'big5-hkscs)
+(define-coding-system-alias 'big5-hkscs 'chinese-big5-hkscs)
+(define-coding-system-alias 'cn-big5-hkscs 'chinese-big5-hkscs)
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Chinese CNS11643 (traditional)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defvar big5-to-cns (make-translation-table)
- "Translation table for encoding to `euc-tw'.")
-;; Could have been done by china-util loaded before.
-(unless (get 'big5-to-cns 'translation-table)
- (define-translation-table 'big5-to-cns big5-to-cns))
-
-(define-ccl-program ccl-decode-euc-tw
- ;; CNS plane 1 needs either two or four bytes in EUC-TW encoding;
- ;; CNS planes 2 to 7 always need four bytes. In internal encoding of
- ;; Emacs, CNS planes 1 and 2 need three bytes, and planes 3 to 7 need
- ;; four bytes. Thus a buffer magnification value of 2 (for both
- ;; encoding and decoding) is sufficient.
- `(2
- ;; we don't have enough registers to hold all charset-ids
- ((r4 = ,(charset-id 'chinese-cns11643-1))
- (r5 = ,(charset-id 'chinese-cns11643-2))
- (r6 = ,(charset-id 'chinese-cns11643-3))
- (loop
- (read-if (r0 < #x80)
- ;; ASCII
- (write-repeat r0)
- ;; not ASCII
- (if (r0 == #x8E)
- ;; single shift
- (read-if (r1 < #xA1)
- ;; invalid byte
- ((write r0)
- (write-repeat r1))
- (if (r1 > #xA7)
- ;; invalid plane
- ((write r0)
- (write-repeat r1))
- ;; OK, we have a plane
- (read-if (r2 < #xA1)
- ;; invalid first byte
- ((write r0 r1)
- (write-repeat r2))
- (read-if (r3 < #xA1)
- ;; invalid second byte
- ((write r0 r1 r2)
- (write-repeat r3))
- ;; CNS 1-7, finally
- ((branch (r1 - #xA1)
- (r1 = r4)
- (r1 = r5)
- (r1 = r6)
- (r1 = ,(charset-id 'chinese-cns11643-4))
- (r1 = ,(charset-id 'chinese-cns11643-5))
- (r1 = ,(charset-id 'chinese-cns11643-6))
- (r1 = ,(charset-id 'chinese-cns11643-7)))
- (r2 = ((((r2 - #x80) << 7) + r3) - #x80))
- (write-multibyte-character r1 r2)
- (repeat))))))
- ;; standard EUC
- (if (r0 < #xA1)
- ;; invalid first byte
- (write-repeat r0)
- (read-if (r1 < #xA1)
- ;; invalid second byte
- ((write r0)
- (write-repeat r1))
- ;; CNS 1, finally
- ((r1 = ((((r0 - #x80) << 7) + r1) - #x80))
- (write-multibyte-character r4 r1)
- (repeat)))))))))
- "CCL program to decode EUC-TW encoding."
-)
-
-(define-ccl-program ccl-encode-euc-tw
- `(2
- ;; we don't have enough registers to hold all charset-ids
- ((r2 = ,(charset-id 'ascii))
- (r3 = ,(charset-id 'chinese-big5-1))
- (r4 = ,(charset-id 'chinese-big5-2))
- (r5 = ,(charset-id 'chinese-cns11643-1))
- (r6 = ,(charset-id 'chinese-cns11643-2))
- (loop
- (read-multibyte-character r0 r1)
- (if (r0 == r2)
- (write-repeat r1)
- (;; Big 5 encoded characters are first translated to CNS
- (if (r0 == r3)
- (translate-character big5-to-cns r0 r1)
- (if (r0 == r4)
- (translate-character big5-to-cns r0 r1)))
- (if (r0 == r5)
- (r0 = #xA1)
- (if (r0 == r6)
- (r0 = #xA2)
- (if (r0 == ,(charset-id 'chinese-cns11643-3))
- (r0 = #xA3)
- (if (r0 == ,(charset-id 'chinese-cns11643-4))
- (r0 = #xA4)
- (if (r0 == ,(charset-id 'chinese-cns11643-5))
- (r0 = #xA5)
- (if (r0 == ,(charset-id 'chinese-cns11643-6))
- (r0 = #xA6)
- (if (r0 == ,(charset-id 'chinese-cns11643-7))
- (r0 = #xA7)
- ;; not CNS. We use a dummy character which
- ;; can't occur in EUC-TW encoding to indicate
- ;; this.
- (write-repeat #xFF))))))))))
- (if (r0 != #xA1)
- ;; single shift and CNS plane
- ((write #x8E)
- (write r0)))
- (write ((r1 >> 7) + #x80))
- (write ((r1 % #x80) + #x80))
- (repeat))))
- "CCL program to encode EUC-TW encoding."
-)
-
-(defun euc-tw-pre-write-conversion (beg end)
- "Semi-dummy pre-write function effectively to autoload china-util."
- ;; Ensure translation table is loaded.
- (require 'china-util)
- ;; Don't do this again.
- (coding-system-put 'euc-tw 'pre-write-conversion nil)
- nil)
-
-(make-coding-system
- 'euc-tw 4 ?Z
- "ISO 2022 based EUC encoding for Chinese CNS11643.
-Big5 encoding is accepted for input also (which is then converted to CNS)."
- '(ccl-decode-euc-tw . ccl-encode-euc-tw)
- '((safe-charsets ascii
- chinese-big5-1
- chinese-big5-2
- chinese-cns11643-1
- chinese-cns11643-2
- chinese-cns11643-3
- chinese-cns11643-4
- chinese-cns11643-5
- chinese-cns11643-6
- chinese-cns11643-7)
- (valid-codes (0 . 255))
- (pre-write-conversion . euc-tw-pre-write-conversion)))
+(define-coding-system 'euc-tw
+ "ISO 2022 based EUC encoding for Chinese CNS11643."
+ :coding-type 'iso-2022
+ :mnemonic ?Z
+ :charset-list '(ascii
+ chinese-cns11643-1
+ chinese-cns11643-2
+ chinese-cns11643-3
+ chinese-cns11643-4
+ chinese-cns11643-5
+ chinese-cns11643-6
+ chinese-cns11643-7)
+ :designation [ascii chinese-cns11643-1 (chinese-cns11643-1
+ chinese-cns11643-2
+ chinese-cns11643-3
+ chinese-cns11643-4
+ chinese-cns11643-5
+ chinese-cns11643-6
+ chinese-cns11643-7) nil]
+ :mime-charset 'euc-tw)
(define-coding-system-alias 'euc-taiwan 'euc-tw)
chinese-iso-8bit)
(features china-util)
(input-method . "chinese-cns-quick")
+ ;; Fixme: presumably it won't accept big5 now.
(documentation . "\
Support for Chinese CNS character sets. Note that the EUC-TW coding system
accepts Big5 for input also (which is then converted to CNS)."))
converted to CNS)."))
'("Chinese"))
+
+;;; Chinese GBK
+
+(define-coding-system 'chinese-gbk
+ "GBK encoding for Chinese (MIME:GBK)."
+ :coding-type 'charset
+ :mnemonic ?c
+ :charset-list '(ascii chinese-gbk)
+ :mime-charset 'gbk)
+(define-coding-system-alias 'gbk 'chinese-gbk)
+(define-coding-system-alias 'cp936 'chinese-gbk)
+(define-coding-system-alias 'windows-936 'chinese-gbk)
+
+(set-language-info-alist
+ "Chinese-GBK" '((charset chinese-gbk)
+ (coding-system chinese-gbk)
+ (coding-priority gbk iso-2022-cn chinese-big5
+ chinese-iso-8bit) ; fixme?
+ (ctext-non-standard-encodings "gbk-0")
+ (input-method . "chinese-py-punct") ; fixme?
+ (sample-text . "Chinese (\e$BCfJ8\e(B,\e$BIaDL\e$A;0\e(B,\e$A::So\e(B) \e$(D95\e$B9%\e(B")
+ (features china-util)
+ (documentation . "Support for Chinese GBK character set.")
+ (tutorial . "TUTORIAL.cn"))
+ '("Chinese"))
+
+;;; Chinese GB18030
+
+(define-coding-system 'chinese-gb18030
+ "GB18030 encoding for Chinese (MIME:GB18030)."
+ :coding-type 'charset
+ :mnemonic ?c
+ :charset-list '(ascii gb18030-2-byte
+ gb18030-4-byte-bmp gb18030-4-byte-smp
+ gb18030-4-byte-ext-1 gb18030-4-byte-ext-2)
+ :mime-charset 'gb18030)
+
+(define-coding-system-alias 'gb18030 'chinese-gb18030)
+
+(set-language-info-alist
+ "Chinese-GB18030" '((charset gb18030)
+ (coding-system chinese-gb18030)
+ (coding-priority gb18030 gbk iso-2022-cn chinese-big5
+ chinese-iso-8bit) ; fixme?
+ (input-method . "chinese-py-punct") ; fixme?
+ (sample-text . "Chinese (\e$BCfJ8\e(B,\e$BIaDL\e$A;0\e(B,\e$A::So\e(B) \e$(D0_\e$B9%\e(B")
+ (features china-util)
+ (documentation
+ . "Support for Chinese GB18030 character set.")
+ (tutorial . "TUTORIAL.cn"))
+ '("Chinese"))
+
+;; Fixme: add HKSCS
+
(provide 'chinese)
;;; arch-tag: b82fcf7a-84f6-4e0b-b38c-1742dac0e09f
;;; cyril-util.el --- utilities for Cyrillic scripts
;; Copyright (C) 1997, 1998, 2001, 2002, 2003, 2004, 2005,
- ;; 2006, 2007 Free Software Foundation, Inc.
+ ;; 2006, 2007, 2008 Free Software Foundation, Inc.
;; Keywords: mule, multilingual, Cyrillic
;;;###autoload
(defun cyrillic-encode-koi8-r-char (char)
"Return KOI8-R external character code of CHAR if appropriate."
- (aref (char-table-extra-slot
- (get 'cyrillic-koi8-r-nonascii-translation-table 'translation-table)
- 0)
- char))
+ (encode-char char 'koi8-r))
;;;###autoload
(defun cyrillic-encode-alternativnyj-char (char)
"Return ALTERNATIVNYJ external character code of CHAR if appropriate."
- (aref (char-table-extra-slot
- (get 'cyrillic-alternativnyj-nonascii-translation-table
- 'translation-table)
- 0)
- char))
+ (encode-char char 'alternativnyj))
\f
;; Display
(aset standard-display-table ?\e,L*\e(B [?N ?j])
(aset standard-display-table ?\e,L/\e(B [?D ?j])
- ;; Unicode version:
- (aset standard-display-table ?\e$,1(P\e(B [?a])
- (aset standard-display-table ?\e$,1(Q\e(B [?b])
- (aset standard-display-table ?\e$,1(R\e(B [?v])
- (aset standard-display-table ?\e$,1(S\e(B [?g])
- (aset standard-display-table ?\e$,1(T\e(B [?d])
- (aset standard-display-table ?\e$,1(U\e(B [?e])
- (aset standard-display-table ?\e$,1(q\e(B [?y ?o])
- (aset standard-display-table ?\e$,1(V\e(B [?z ?h])
- (aset standard-display-table ?\e$,1(W\e(B [?z])
- (aset standard-display-table ?\e$,1(X\e(B [?i])
- (aset standard-display-table ?\e$,1(Y\e(B [?j])
- (aset standard-display-table ?\e$,1(Z\e(B [?k])
- (aset standard-display-table ?\e$,1([\e(B [?l])
- (aset standard-display-table ?\e$,1(\\e(B [?m])
- (aset standard-display-table ?\e$,1(]\e(B [?n])
- (aset standard-display-table ?\e$,1(^\e(B [?o])
- (aset standard-display-table ?\e$,1(_\e(B [?p])
- (aset standard-display-table ?\e$,1(`\e(B [?r])
- (aset standard-display-table ?\e$,1(a\e(B [?s])
- (aset standard-display-table ?\e$,1(b\e(B [?t])
- (aset standard-display-table ?\e$,1(c\e(B [?u])
- (aset standard-display-table ?\e$,1(d\e(B [?f])
- (aset standard-display-table ?\e$,1(e\e(B [?k ?h])
- (aset standard-display-table ?\e$,1(f\e(B [?t ?s])
- (aset standard-display-table ?\e$,1(g\e(B [?c ?h])
- (aset standard-display-table ?\e$,1(h\e(B [?s ?h])
- (aset standard-display-table ?\e$,1(i\e(B [?s ?c ?h])
- (aset standard-display-table ?\e$,1(j\e(B [?~])
- (aset standard-display-table ?\e$,1(k\e(B [?y])
- (aset standard-display-table ?\e$,1(l\e(B [?'])
- (aset standard-display-table ?\e$,1(m\e(B [?e ?'])
- (aset standard-display-table ?\e$,1(n\e(B [?y ?u])
- (aset standard-display-table ?\e$,1(o\e(B [?y ?a])
-
- (aset standard-display-table ?\e$,1(0\e(B [?A])
- (aset standard-display-table ?\e$,1(1\e(B [?B])
- (aset standard-display-table ?\e$,1(2\e(B [?V])
- (aset standard-display-table ?\e$,1(3\e(B [?G])
- (aset standard-display-table ?\e$,1(4\e(B [?D])
- (aset standard-display-table ?\e$,1(5\e(B [?E])
- (aset standard-display-table ?\e$,1(!\e(B [?Y ?o])
- (aset standard-display-table ?\e$,1(6\e(B [?Z ?h])
- (aset standard-display-table ?\e$,1(7\e(B [?Z])
- (aset standard-display-table ?\e$,1(8\e(B [?I])
- (aset standard-display-table ?\e$,1(9\e(B [?J])
- (aset standard-display-table ?\e$,1(:\e(B [?K])
- (aset standard-display-table ?\e$,1(;\e(B [?L])
- (aset standard-display-table ?\e$,1(<\e(B [?M])
- (aset standard-display-table ?\e$,1(=\e(B [?N])
- (aset standard-display-table ?\e$,1(>\e(B [?O])
- (aset standard-display-table ?\e$,1(?\e(B [?P])
- (aset standard-display-table ?\e$,1(@\e(B [?R])
- (aset standard-display-table ?\e$,1(A\e(B [?S])
- (aset standard-display-table ?\e$,1(B\e(B [?T])
- (aset standard-display-table ?\e$,1(C\e(B [?U])
- (aset standard-display-table ?\e$,1(D\e(B [?F])
- (aset standard-display-table ?\e$,1(E\e(B [?K ?h])
- (aset standard-display-table ?\e$,1(F\e(B [?T ?s])
- (aset standard-display-table ?\e$,1(G\e(B [?C ?h])
- (aset standard-display-table ?\e$,1(H\e(B [?S ?h])
- (aset standard-display-table ?\e$,1(I\e(B [?S ?c ?h])
- (aset standard-display-table ?\e$,1(J\e(B [?~])
- (aset standard-display-table ?\e$,1(K\e(B [?Y])
- (aset standard-display-table ?\e$,1(L\e(B [?'])
- (aset standard-display-table ?\e$,1(M\e(B [?E ?'])
- (aset standard-display-table ?\e$,1(N\e(B [?Y ?u])
- (aset standard-display-table ?\e$,1(O\e(B [?Y ?a])
-
- (aset standard-display-table ?\e$,1(t\e(B [?i ?e])
- (aset standard-display-table ?\e$,1(w\e(B [?i])
- (aset standard-display-table ?\e$,1(~\e(B [?u])
- (aset standard-display-table ?\e$,1(r\e(B [?d ?j])
- (aset standard-display-table ?\e$,1({\e(B [?c ?h ?j])
- (aset standard-display-table ?\e$,1(s\e(B [?g ?j])
- (aset standard-display-table ?\e$,1(u\e(B [?s])
- (aset standard-display-table ?\e$,1(|\e(B [?k])
- (aset standard-display-table ?\e$,1(v\e(B [?i])
- (aset standard-display-table ?\e$,1(x\e(B [?j])
- (aset standard-display-table ?\e$,1(y\e(B [?l ?j])
- (aset standard-display-table ?\e$,1(z\e(B [?n ?j])
- (aset standard-display-table ?\e$,1(\7f\e(B [?d ?z])
-
- (aset standard-display-table ?\e$,1($\e(B [?Y ?e])
- (aset standard-display-table ?\e$,1('\e(B [?Y ?i])
- (aset standard-display-table ?\e$,1(.\e(B [?U])
- (aset standard-display-table ?\e$,1("\e(B [?D ?j])
- (aset standard-display-table ?\e$,1(+\e(B [?C ?h ?j])
- (aset standard-display-table ?\e$,1(#\e(B [?G ?j])
- (aset standard-display-table ?\e$,1(%\e(B [?S])
- (aset standard-display-table ?\e$,1(,\e(B [?K])
- (aset standard-display-table ?\e$,1(&\e(B [?I])
- (aset standard-display-table ?\e$,1((\e(B [?J])
- (aset standard-display-table ?\e$,1()\e(B [?L ?j])
- (aset standard-display-table ?\e$,1(*\e(B [?N ?j])
- (aset standard-display-table ?\e$,1(/\e(B [?D ?j])
-
(when (equal cyrillic-language "Bulgarian")
(aset standard-display-table ?\e,Li\e(B [?s ?h ?t])
(aset standard-display-table ?\e,LI\e(B [?S ?h ?t])
(aset standard-display-table ?\e,Ln\e(B [?i ?u])
(aset standard-display-table ?\e,LN\e(B [?I ?u])
(aset standard-display-table ?\e,Lo\e(B [?i ?a])
- (aset standard-display-table ?\e,LO\e(B [?I ?a])
- ;; Unicode version:
- (aset standard-display-table ?\e$,1(i\e(B [?s ?h ?t])
- (aset standard-display-table ?\e$,1(I\e(B [?S ?h ?t])
- (aset standard-display-table ?\e$,1(n\e(B [?i ?u])
- (aset standard-display-table ?\e$,1(N\e(B [?I ?u])
- (aset standard-display-table ?\e$,1(o\e(B [?i ?a])
- (aset standard-display-table ?\e$,1(O\e(B [?I ?a]))
+ (aset standard-display-table ?\e,LO\e(B [?I ?a]))
(when (equal cyrillic-language "Ukrainian") ; based on the official
; transliteration table
(aset standard-display-table ?\e,LY\e(B [?i])
(aset standard-display-table ?\e,L9\e(B [?Y])
(aset standard-display-table ?\e,Ln\e(B [?i ?u])
- (aset standard-display-table ?\e,Lo\e(B [?i ?a])
- ;; Unicode version:
- (aset standard-display-table ?\e$,1(X\e(B [?y])
- (aset standard-display-table ?\e$,1(8\e(B [?Y])
- (aset standard-display-table ?\e$,1(Y\e(B [?i])
- (aset standard-display-table ?\e$,1(9\e(B [?Y])
- (aset standard-display-table ?\e$,1(n\e(B [?i ?u])
- (aset standard-display-table ?\e$,1(o\e(B [?i ?a]))))
+ (aset standard-display-table ?\e,Lo\e(B [?i ?a]))))
;;
(provide 'cyril-util)
;;; cyrillic.el --- support for Cyrillic -*- coding: iso-2022-7bit; -*-
- ;; Copyright (C) 1997, 1998, 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ ;; Copyright (C) 1997, 1998, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
;; Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- ;; 2005, 2006, 2007
+ ;; 2005, 2006, 2007, 2008
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
+;; Copyright (C) 2003
+;; National Institute of Advanced Industrial Science and Technology (AIST)
+;; Registration Number H13PRO009
;; Author: Kenichi Handa <handa@etl.go.jp>
;; Keywords: multilingual, Cyrillic, i18n
;; ISO-8859-5 stuff
-(make-coding-system
- 'cyrillic-iso-8bit 2 ?5
- "ISO 2022 based 8-bit encoding for Cyrillic script (MIME:ISO-8859-5)."
- '(ascii cyrillic-iso8859-5 nil nil
- nil nil nil nil nil nil nil nil nil nil nil t)
- '((safe-charsets ascii cyrillic-iso8859-5)
- (mime-charset . iso-8859-5)))
+(define-coding-system 'cyrillic-iso-8bit
+ "ISO 2022 based 8-bit encoding for Cyrillic script (MIME:ISO-8859-5)."
+ :coding-type 'charset
+ :mnemonic ?5
+ :charset-list '(iso-8859-5)
+ :mime-charset 'iso-8859-5)
(define-coding-system-alias 'iso-8859-5 'cyrillic-iso-8bit)
(set-language-info-alist
- "Cyrillic-ISO" '((charset cyrillic-iso8859-5)
+ "Cyrillic-ISO" '((charset iso-8859-5)
(coding-system cyrillic-iso-8bit)
(coding-priority cyrillic-iso-8bit)
(input-method . "cyrillic-yawerty") ; fixme
- (nonascii-translation . cyrillic-iso8859-5)
+ (nonascii-translation . iso-8859-5)
(unibyte-display . cyrillic-iso-8bit)
(features cyril-util)
(sample-text . "Russian (\e,L@caaZXY\e(B) \e,L7T`PRabRcYbU\e(B!")
;; KOI-8R stuff
-;; The mule-unicode portion of this is from
-;; http://www.unicode.org/Public/MAPPINGS/VENDORS/MISC/KOI8-R.TXT,
-;; which references RFC 1489.
-(defvar cyrillic-koi8-r-decode-table
- [
- 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
- ;; 8859-5 plus Unicode
- ?\e$,2 \e(B ?\e$,2 "\e(B ?\e$,2 ,\e(B ?\e$,2 0\e(B ?\e$,2 4\e(B ?\e$,2 8\e(B ?\e$,2 <\e(B ?\e$,2 D\e(B ?\e$,2 L\e(B ?\e$,2 T\e(B ?\e$,2 \\e(B ?\e$,2!@\e(B ?\e$,2!D\e(B ?\e$,2!H\e(B ?\e$,2!L\e(B ?\e$,2!P\e(B
- ?\e$,2!Q\e(B ?\e$,2!R\e(B ?\e$,2!S\e(B ?\e$,1{ \e(B ?\e$,2!`\e(B ?\e$,1s"\e(B ?\e$,1x:\e(B ?\e$,1xh\e(B ?\e$,1y$\e(B ?\e$,1y%\e(B ?\e,L \e(B ?\e$,1{!\e(B ?\e,A0\e(B ?\e,A2\e(B ?\e,A7\e(B ?\e,Aw\e(B
- ?\e$,2 p\e(B ?\e$,2 q\e(B ?\e$,2 r\e(B ?\e,Lq\e(B ?\e$,2 s\e(B ?\e$,2 t\e(B ?\e$,2 u\e(B ?\e$,2 v\e(B ?\e$,2 w\e(B ?\e$,2 x\e(B ?\e$,2 y\e(B ?\e$,2 z\e(B ?\e$,2 {\e(B ?\e$,2 |\e(B ?\e$,2 }\e(B ?\e$,2 ~\e(B
- ?\e$,2 \7f\e(B ?\e$,2! \e(B ?\e$,2!!\e(B ?\e,L!\e(B ?\e$,2!"\e(B ?\e$,2!#\e(B ?\e$,2!$\e(B ?\e$,2!%\e(B ?\e$,2!&\e(B ?\e$,2!'\e(B ?\e$,2!(\e(B ?\e$,2!)\e(B ?\e$,2!*\e(B ?\e$,2!+\e(B ?\e$,2!,\e(B ?\e,A)\e(B
- ?\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
- ;; All Unicode:
-;; ?\e$,2 \e(B ?\e$,2 "\e(B ?\e$,2 ,\e(B ?\e$,2 0\e(B ?\e$,2 4\e(B ?\e$,2 8\e(B ?\e$,2 <\e(B ?\e$,2 D\e(B ?\e$,2 L\e(B ?\e$,2 T\e(B ?\e$,2 \\e(B ?\e$,2!@\e(B ?\e$,2!D\e(B ?\e$,2!H\e(B ?\e$,2!L\e(B ?\e$,2!P\e(B
-;; ?\e$,2!Q\e(B ?\e$,2!R\e(B ?\e$,2!S\e(B ?\e$,1{ \e(B ?\e$,2!`\e(B ?\e$,1s"\e(B ?\e$,1x:\e(B ?\e$,1xh\e(B ?\e$,1y$\e(B ?\e$,1y%\e(B ?\e,A \e(B ?\e$,1{!\e(B ?\e,A0\e(B ?\e,A2\e(B ?\e,A7\e(B ?\e,Aw\e(B
-;; ?\e$,2 p\e(B ?\e$,2 q\e(B ?\e$,2 r\e(B ?\e$,1(q\e(B ?\e$,2 s\e(B ?\e$,2 t\e(B ?\e$,2 u\e(B ?\e$,2 v\e(B ?\e$,2 w\e(B ?\e$,2 x\e(B ?\e$,2 y\e(B ?\e$,2 z\e(B ?\e$,2 {\e(B ?\e$,2 |\e(B ?\e$,2 }\e(B ?\e$,2 ~\e(B
-;; ?\e$,2 \7f\e(B ?\e$,2! \e(B ?\e$,2!!\e(B ?\e$,1(!\e(B ?\e$,2!"\e(B ?\e$,2!#\e(B ?\e$,2!$\e(B ?\e$,2!%\e(B ?\e$,2!&\e(B ?\e$,2!'\e(B ?\e$,2!(\e(B ?\e$,2!)\e(B ?\e$,2!*\e(B ?\e$,2!+\e(B ?\e$,2!,\e(B ?\e,A)\e(B
-;; ?\e$,1(n\e(B ?\e$,1(P\e(B ?\e$,1(Q\e(B ?\e$,1(f\e(B ?\e$,1(T\e(B ?\e$,1(U\e(B ?\e$,1(d\e(B ?\e$,1(S\e(B ?\e$,1(e\e(B ?\e$,1(X\e(B ?\e$,1(Y\e(B ?\e$,1(Z\e(B ?\e$,1([\e(B ?\e$,1(\\e(B ?\e$,1(]\e(B ?\e$,1(^\e(B
-;; ?\e$,1(_\e(B ?\e$,1(o\e(B ?\e$,1(`\e(B ?\e$,1(a\e(B ?\e$,1(b\e(B ?\e$,1(c\e(B ?\e$,1(V\e(B ?\e$,1(R\e(B ?\e$,1(l\e(B ?\e$,1(k\e(B ?\e$,1(W\e(B ?\e$,1(h\e(B ?\e$,1(m\e(B ?\e$,1(i\e(B ?\e$,1(g\e(B ?\e$,1(j\e(B
-;; ?\e$,1(N\e(B ?\e$,1(0\e(B ?\e$,1(1\e(B ?\e$,1(F\e(B ?\e$,1(4\e(B ?\e$,1(5\e(B ?\e$,1(D\e(B ?\e$,1(3\e(B ?\e$,1(E\e(B ?\e$,1(8\e(B ?\e$,1(9\e(B ?\e$,1(:\e(B ?\e$,1(;\e(B ?\e$,1(<\e(B ?\e$,1(=\e(B ?\e$,1(>\e(B
-;; ?\e$,1(?\e(B ?\e$,1(O\e(B ?\e$,1(@\e(B ?\e$,1(A\e(B ?\e$,1(B\e(B ?\e$,1(C\e(B ?\e$,1(6\e(B ?\e$,1(2\e(B ?\e$,1(L\e(B ?\e$,1(K\e(B ?\e$,1(7\e(B ?\e$,1(H\e(B ?\e$,1(M\e(B ?\e$,1(I\e(B ?\e$,1(G\e(B ?\e$,1(J\e(B
- ]
- "Cyrillic KOI8-R decoding table.")
-
-(let ((table (make-translation-table-from-vector
- cyrillic-koi8-r-decode-table)))
- (define-translation-table 'cyrillic-koi8-r-nonascii-translation-table table)
- (define-translation-table 'cyrillic-koi8-r-encode-table
- (char-table-extra-slot table 0)))
-
-;; No point in keeping it around. (It can't be let-bound, since it's
-;; needed for macro expansion.)
-(makunbound 'cyrillic-koi8-r-decode-table)
-
-(define-ccl-program ccl-decode-koi8
- `(4
- ((loop
- (r0 = 0)
- (read r1)
- (if (r1 < 128)
- (write-repeat r1)
- ((translate-character cyrillic-koi8-r-nonascii-translation-table r0 r1)
- (translate-character ucs-translation-table-for-decode r0 r1)
- (write-multibyte-character r0 r1)
- (repeat))))))
- "CCL program to decode KOI8-R.")
-
-(define-ccl-program ccl-encode-koi8
- `(1
- ((loop
- (read-multibyte-character r0 r1)
- (translate-character cyrillic-koi8-r-encode-table r0 r1)
- (if (r0 != ,(charset-id 'ascii))
- (if (r0 != ,(charset-id 'eight-bit-graphic))
- (if (r0 != ,(charset-id 'eight-bit-control))
- (r1 = ??))))
- (write-repeat r1))))
- "CCL program to encode KOI8-R.")
-
-(defun cyrillic-unify-encoding (table)
- "Set up equivalent characters in the encoding TABLE.
-This works whether or not the table is Unicode-based or
-8859-5-based. (Only appropriate for Cyrillic.)"
- (let ((table (get table 'translation-table)))
- (dotimes (i 96)
- (let* ((c (make-char 'cyrillic-iso8859-5 (+ i 32)))
- (u ; equivalent Unicode char
- (cond ((eq c ?\e,L \e(B) ?\e,A \e(B)
- ((eq c ?\e,L-\e(B) ?\e,A-\e(B)
- ((eq c ?\e,L}\e(B) ?\e,A'\e(B)
- (t (decode-char 'ucs (+ #x400 i)))))
- (ec (aref table c)) ; encoding of 8859-5
- (uc (aref table u))) ; encoding of Unicode
- (unless (memq c '(?\e,L \e(B ?\e,L-\e(B ?\e,L}\e(B)) ; 8859-5 exceptions
- (unless uc
- (aset table u ec))
- (unless ec
- (aset table c uc)))))))
-
-(cyrillic-unify-encoding 'cyrillic-koi8-r-encode-table)
-
-(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-R 8-bit encoding for Cyrillic (MIME: KOI8-R)."
- '(ccl-decode-koi8 . ccl-encode-koi8)
- `((safe-chars . cyrillic-koi8-r-encode-table)
- (mime-charset . koi8-r)
- (valid-codes (0 . 255))
- (dependency unify-8859-on-encoding-mode unify-8859-on-decoding-mode)))
+(define-coding-system 'cyrillic-koi8
+ "KOI8 8-bit encoding for Cyrillic (MIME: KOI8-R)."
+ :coding-type 'charset
+ ;; 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.
+ :mnemonic ?R
+ :charset-list '(koi8)
+ :mime-charset 'koi8-r)
(define-coding-system-alias 'koi8-r 'cyrillic-koi8)
(define-coding-system-alias 'koi8 'cyrillic-koi8)
(define-coding-system-alias 'cp878 'cyrillic-koi8)
-(let ((elt `("koi8-r" koi8-r 1
- ,(get 'cyrillic-koi8-r-encode-table 'translation-table)))
- (slot (assoc "koi8-r" ctext-non-standard-encodings-alist)))
- (if slot
- (setcdr slot (cdr elt))
- (push elt ctext-non-standard-encodings-alist)))
-
-;; Allow displaying some of KOI & al with an 8859-5-encoded font. We
-;; won't bother about the exceptions when encoding the font, since
-;; NBSP will fall through below and work anyhow, and we'll have
-;; avoided setting the fontset for the other two to 8859-5 -- they're
-;; not in KOI and Alternativnyj anyhow.
-(define-ccl-program ccl-encode-8859-5-font
- `(0
- ((if (r0 == ,(charset-id 'cyrillic-iso8859-5))
- (r1 += 128)
- (if (r0 == ,(charset-id 'mule-unicode-0100-24ff))
- (r1 = (r2 + 128))))))
- "Encode ISO 8859-5 and Cyrillic Unicode chars to 8859-5 font.")
-
-(add-to-list 'font-ccl-encoder-alist '("iso8859-5" . ccl-encode-8859-5-font))
-
-;; The table is set up later to encode both Unicode and 8859-5.
-(define-ccl-program ccl-encode-koi8-font
- `(0
- (if (r2 >= 0)
- ((r1 <<= 7)
- (r1 += r2)))
- (translate-character cyrillic-koi8-r-encode-table r0 r1))
- "CCL program to encode Cyrillic chars to KOI font.")
-
-(add-to-list 'font-ccl-encoder-alist '("koi8" . ccl-encode-koi8-font))
-
(set-language-info-alist
- "Cyrillic-KOI8" `((charset cyrillic-iso8859-5)
- (nonascii-translation
- . ,(get 'cyrillic-koi8-r-nonascii-translation-table
- 'translation-table))
+ "Cyrillic-KOI8" `((charset koi8)
(coding-system cyrillic-koi8)
(coding-priority cyrillic-koi8 cyrillic-iso-8bit)
(ctext-non-standard-encodings "koi8-r")
+ (nonascii-translation . koi8)
(input-method . "russian-typewriter")
(features cyril-util)
(unibyte-display . cyrillic-koi8)
(tutorial . "TUTORIAL.ru"))
'("Cyrillic"))
-
-(defvar cyrillic-koi8-u-decode-table
- [
- 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
- ;; All Unicode:
-;; ?\e$,2 \e(B ?\e$,2 "\e(B ?\e$,2 ,\e(B ?\e$,2 0\e(B ?\e$,2 4\e(B ?\e$,2 8\e(B ?\e$,2 <\e(B ?\e$,2 D\e(B ?\e$,2 L\e(B ?\e$,2 T\e(B ?\e$,2 \\e(B ?\e$,2!@\e(B ?\e$,2!D\e(B ?\e$,2!H\e(B ?\e$,2!L\e(B ?\e$,2!P\e(B
-;; ?\e$,2!Q\e(B ?\e$,2!R\e(B ?\e$,2!S\e(B ?\e$,1{ \e(B ?\e$,2!`\e(B ?\e$,1x9\e(B ?\e$,1x:\e(B ?\e$,1xh\e(B ?\e$,1y$\e(B ?\e$,1y%\e(B ?\e,L \e(B ?\e$,1{!\e(B ?\e,A0\e(B ?\e,A2\e(B ?\e,A7\e(B ?\e,Aw\e(B
-;; ?\e$,2 p\e(B ?\e$,2 q\e(B ?\e$,2 r\e(B ?\e$,1(q\e(B ?\e$,1(t\e(B ?\e$,2 t\e(B ?\e$,1(v\e(B ?\e$,1(w\e(B ?\e$,2 w\e(B ?\e$,2 x\e(B ?\e$,2 y\e(B ?\e$,2 z\e(B ?\e$,2 {\e(B ?\e$,1)Q\e(B ?\e$,2 }\e(B ?\e$,2 ~\e(B
-;; ?\e$,2 \7f\e(B ?\e$,2! \e(B ?\e$,2!!\e(B ?\e$,1(!\e(B ?\e$,1($\e(B ?\e$,2!#\e(B ?\e$,1(&\e(B ?\e$,1('\e(B ?\e$,2!&\e(B ?\e$,2!'\e(B ?\e$,2!(\e(B ?\e$,2!)\e(B ?\e$,2!*\e(B ?\e$,1)P\e(B ?\e$,2!,\e(B ?\e,A)\e(B
-;; ?\e$,1(n\e(B ?\e$,1(P\e(B ?\e$,1(Q\e(B ?\e$,1(f\e(B ?\e$,1(T\e(B ?\e$,1(U\e(B ?\e$,1(d\e(B ?\e$,1(S\e(B ?\e$,1(e\e(B ?\e$,1(X\e(B ?\e$,1(Y\e(B ?\e$,1(Z\e(B ?\e$,1([\e(B ?\e$,1(\\e(B ?\e$,1(]\e(B ?\e$,1(^\e(B
-;; ?\e$,1(_\e(B ?\e$,1(o\e(B ?\e$,1(`\e(B ?\e$,1(a\e(B ?\e$,1(b\e(B ?\e$,1(c\e(B ?\e$,1(V\e(B ?\e$,1(R\e(B ?\e$,1(l\e(B ?\e$,1(k\e(B ?\e$,1(W\e(B ?\e$,1(h\e(B ?\e$,1(m\e(B ?\e$,1(i\e(B ?\e$,1(g\e(B ?\e$,1(j\e(B
-;; ?\e$,1(N\e(B ?\e$,1(0\e(B ?\e$,1(1\e(B ?\e$,1(F\e(B ?\e$,1(4\e(B ?\e$,1(5\e(B ?\e$,1(D\e(B ?\e$,1(3\e(B ?\e$,1(E\e(B ?\e$,1(8\e(B ?\e$,1(9\e(B ?\e$,1(:\e(B ?\e$,1(;\e(B ?\e$,1(<\e(B ?\e$,1(=\e(B ?\e$,1(>\e(B
-;; ?\e$,1(?\e(B ?\e$,1(O\e(B ?\e$,1(@\e(B ?\e$,1(A\e(B ?\e$,1(B\e(B ?\e$,1(C\e(B ?\e$,1(6\e(B ?\e$,1(2\e(B ?\e$,1(L\e(B ?\e$,1(K\e(B ?\e$,1(7\e(B ?\e$,1(H\e(B ?\e$,1(M\e(B ?\e$,1(I\e(B ?\e$,1(G\e(B ?\e$,1(J\e(B
-;; 8859-5 plus Unicode:
- ?\e$,2 \e(B ?\e$,2 "\e(B ?\e$,2 ,\e(B ?\e$,2 0\e(B ?\e$,2 4\e(B ?\e$,2 8\e(B ?\e$,2 <\e(B ?\e$,2 D\e(B ?\e$,2 L\e(B ?\e$,2 T\e(B ?\e$,2 \\e(B ?\e$,2!@\e(B ?\e$,2!D\e(B ?\e$,2!H\e(B ?\e$,2!L\e(B ?\e$,2!P\e(B
- ?\e$,2!Q\e(B ?\e$,2!R\e(B ?\e$,2!S\e(B ?\e$,1{ \e(B ?\e$,2!`\e(B ?\e$,1x9\e(B ?\e$,1x:\e(B ?\e$,1xh\e(B ?\e$,1y$\e(B ?\e$,1y%\e(B ?\e,L \e(B ?\e$,1{!\e(B ?\e,A0\e(B ?\e,A2\e(B ?\e,A7\e(B ?\e,Aw\e(B
- ?\e$,2 p\e(B ?\e$,2 q\e(B ?\e$,2 r\e(B ?\e,Lq\e(B ?\e,Lt\e(B ?\e$,2 t\e(B ?\e,Lv\e(B ?\e,Lw\e(B ?\e$,2 w\e(B ?\e$,2 x\e(B ?\e$,2 y\e(B ?\e$,2 z\e(B ?\e$,2 {\e(B ?\e$,1)Q\e(B ?\e$,2 }\e(B ?\e$,2 ~\e(B
- ?\e$,2 \7f\e(B ?\e$,2! \e(B ?\e$,2!!\e(B ?\e,L!\e(B ?\e,L$\e(B ?\e$,2!#\e(B ?\e,L&\e(B ?\e,L'\e(B ?\e$,2!&\e(B ?\e$,2!'\e(B ?\e$,2!(\e(B ?\e$,2!)\e(B ?\e$,2!*\e(B ?\e$,1)P\e(B ?\e$,2!,\e(B ?\e,A)\e(B
- ?\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
- ]
- "Cyrillic KOI8-U decoding table.")
-
-(let ((table (make-translation-table-from-vector
- cyrillic-koi8-u-decode-table)))
- (define-translation-table 'cyrillic-koi8-u-nonascii-translation-table table)
- (define-translation-table 'cyrillic-koi8-u-encode-table
- (char-table-extra-slot table 0)))
-
-(makunbound 'cyrillic-koi8-u-decode-table)
-
-(define-ccl-program ccl-decode-koi8-u
- `(4
- ((loop
- (r0 = 0)
- (read r1)
- (if (r1 < 128)
- (write-repeat r1)
- ((translate-character cyrillic-koi8-u-nonascii-translation-table r0 r1)
- (translate-character ucs-translation-table-for-decode r0 r1)
- (write-multibyte-character r0 r1)
- (repeat))))))
- "CCL program to decode KOI8-U.")
-
-(define-ccl-program ccl-encode-koi8-u
- `(1
- ((loop
- (read-multibyte-character r0 r1)
- (translate-character cyrillic-koi8-u-encode-table r0 r1)
- (if (r0 != ,(charset-id 'ascii))
- (if (r0 != ,(charset-id 'eight-bit-graphic))
- (if (r0 != ,(charset-id 'eight-bit-control))
- (r1 = ??))))
- (write-repeat r1))))
- "CCL program to encode KOI8-U.")
-
-(cyrillic-unify-encoding 'cyrillic-koi8-u-encode-table)
-
-(make-coding-system
- 'koi8-u 4
- ?U "KOI8-U 8-bit encoding for Cyrillic (MIME: KOI8-U)"
- '(ccl-decode-koi8-u . ccl-encode-koi8-u)
- `((safe-chars . cyrillic-koi8-u-encode-table)
- (mime-charset . koi8-u)
- (valid-codes (0 . 255))
- (dependency unify-8859-on-encoding-mode unify-8859-on-decoding-mode)))
-
-(define-ccl-program ccl-encode-koi8-u-font
- `(0
- (translate-character cyrillic-koi8-u-encode-table r0 r1))
- "CCL program to encode Cyrillic chars to KOI-U font.")
-
-(add-to-list 'font-ccl-encoder-alist '("koi8-u" . ccl-encode-koi8-u-font))
+(define-coding-system 'koi8-u
+ "KOI8-U 8-bit encoding for Cyrillic (MIME: KOI8-U)"
+ :coding-type 'charset
+ :mnemonic ?U
+ :charset-list '(koi8-u)
+ :mime-charset 'koi8-u)
(set-language-info-alist
- "Ukrainian" `((coding-system koi8-u)
+ "Ukrainian" `((charset koi8-u)
+ (coding-system koi8-u)
(coding-priority koi8-u)
- (nonascii-translation
- . ,(get 'cyrillic-koi8-u-nonascii-translation-table
- 'translation-table))
+ (nonascii-translation . koi8-u)
(input-method . "ukrainian-computer")
(documentation
. "Support for Ukrainian with KOI8-U character set."))
;;; ALTERNATIVNYJ stuff
-;; Fixme: It's unclear what's the correct table. I've found
-;; statements both that it's the same as cp866 and somewhat different,
-;; but nothing that looks really definitive.
-(defvar cyrillic-alternativnyj-decode-table
- [
- 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$,1(0\e(B ?\e$,1(1\e(B ?\e$,1(2\e(B ?\e$,1(3\e(B ?\e$,1(4\e(B ?\e$,1(5\e(B ?\e$,1(6\e(B ?\e$,1(7\e(B ?\e$,1(8\e(B ?\e$,1(9\e(B ?\e$,1(:\e(B ?\e$,1(;\e(B ?\e$,1(<\e(B ?\e$,1(=\e(B ?\e$,1(>\e(B ?\e$,1(?\e(B
-;; ?\e$,1(@\e(B ?\e$,1(A\e(B ?\e$,1(B\e(B ?\e$,1(C\e(B ?\e$,1(D\e(B ?\e$,1(E\e(B ?\e$,1(F\e(B ?\e$,1(G\e(B ?\e$,1(H\e(B ?\e$,1(I\e(B ?\e$,1(J\e(B ?\e$,1(K\e(B ?\e$,1(L\e(B ?\e$,1(M\e(B ?\e$,1(N\e(B ?\e$,1(O\e(B
-;; ?\e$,1(P\e(B ?\e$,1(Q\e(B ?\e$,1(R\e(B ?\e$,1(S\e(B ?\e$,1(T\e(B ?\e$,1(U\e(B ?\e$,1(V\e(B ?\e$,1(W\e(B ?\e$,1(X\e(B ?\e$,1(Y\e(B ?\e$,1(Z\e(B ?\e$,1([\e(B ?\e$,1(\\e(B ?\e$,1(]\e(B ?\e$,1(^\e(B ?\e$,1(_\e(B
-;; ?\e$,2!Q\e(B ?\e$,2!R\e(B ?\e$,2!S\e(B ?\e$,2 "\e(B ?\e$,2 D\e(B ?\e$,2!!\e(B ?\e$,2!"\e(B ?\e$,2 v\e(B ?\e$,2 u\e(B ?\e$,2!#\e(B ?\e$,2 q\e(B ?\e$,2 w\e(B ?\e$,2 }\e(B ?\e$,2 |\e(B ?\e$,2 {\e(B ?\e$,2 0\e(B
-;; ?\e$,2 4\e(B ?\e$,2 T\e(B ?\e$,2 L\e(B ?\e$,2 <\e(B ?\e$,2 \e(B ?\e$,2 \\e(B ?\e$,2 ~\e(B ?\e$,2 \7f\e(B ?\e$,2 z\e(B ?\e$,2 t\e(B ?\e$,2!)\e(B ?\e$,2!&\e(B ?\e$,2! \e(B ?\e$,2 p\e(B ?\e$,2!,\e(B ?\e$,2!'\e(B
-;; ?\e$,2!(\e(B ?\e$,2!$\e(B ?\e$,2!%\e(B ?\e$,2 y\e(B ?\e$,2 x\e(B ?\e$,2 r\e(B ?\e$,2 s\e(B ?\e$,2!+\e(B ?\e$,2!*\e(B ?\e$,2 8\e(B ?\e$,2 ,\e(B ?\e$,2!H\e(B ?\e$,2!D\e(B ?\e$,2!L\e(B ?\e$,2!P\e(B ?\e$,2!@\e(B
-;; ?\e$,1(`\e(B ?\e$,1(a\e(B ?\e$,1(b\e(B ?\e$,1(c\e(B ?\e$,1(d\e(B ?\e$,1(e\e(B ?\e$,1(f\e(B ?\e$,1(g\e(B ?\e$,1(h\e(B ?\e$,1(i\e(B ?\e$,1(j\e(B ?\e$,1(k\e(B ?\e$,1(l\e(B ?\e$,1(m\e(B ?\e$,1(n\e(B ?\e$,1(o\e(B
-;; ?\e$,1(!\e(B ?\e$,1(q\e(B ?\e$,1ry\e(B ?\e$,1rx\e(B ?\e$,1%A\e(B ?\e$,1%@\e(B ?\e$,1s:\e(B ?\e$,1s9\e(B ?\e$,1vq\e(B ?\e$,1vs\e(B ?\e,A1\e(B ?\e,Aw\e(B ?\e$,1uV\e(B ?\e,A$\e(B ?\e$,2!`\e(B ?\e,A \e(B ;
-;; 8859+Unicode
- ?\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
- ?\e$,2!Q\e(B ?\e$,2!R\e(B ?\e$,2!S\e(B ?\e$,2 "\e(B ?\e$,2 D\e(B ?\e$,2!!\e(B ?\e$,2!"\e(B ?\e$,2 v\e(B ?\e$,2 u\e(B ?\e$,2!#\e(B ?\e$,2 q\e(B ?\e$,2 w\e(B ?\e$,2 }\e(B ?\e$,2 |\e(B ?\e$,2 {\e(B ?\e$,2 0\e(B
- ?\e$,2 4\e(B ?\e$,2 T\e(B ?\e$,2 L\e(B ?\e$,2 <\e(B ?\e$,2 \e(B ?\e$,2 \\e(B ?\e$,2 ~\e(B ?\e$,2 \7f\e(B ?\e$,2 z\e(B ?\e$,2 t\e(B ?\e$,2!)\e(B ?\e$,2!&\e(B ?\e$,2! \e(B ?\e$,2 p\e(B ?\e$,2!,\e(B ?\e$,2!'\e(B
- ?\e$,2!(\e(B ?\e$,2!$\e(B ?\e$,2!%\e(B ?\e$,2 y\e(B ?\e$,2 x\e(B ?\e$,2 r\e(B ?\e$,2 s\e(B ?\e$,2!+\e(B ?\e$,2!*\e(B ?\e$,2 8\e(B ?\e$,2 ,\e(B ?\e$,2!H\e(B ?\e$,2!D\e(B ?\e$,2!L\e(B ?\e$,2!P\e(B ?\e$,2!@\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
- ;; Taken from http://www.cyrillic.com/ref/cyrillic/koi-8alt.html
- ;; with guesses for the Unicodes of the glyphs in the absence of a
- ;; table.
- ?\e,L!\e(B ?\e,Lq\e(B ?\e$,1ry\e(B ?\e$,1rx\e(B ?\e$,1%A\e(B ?\e$,1%@\e(B ?\e$,1s:\e(B ?\e$,1s9\e(B ?\e$,1vq\e(B ?\e$,1vs\e(B ?\e,A1\e(B ?\e,Aw\e(B ?\e,Lp\e(B ?\e,A$\e(B ?\e$,2!`\e(B ?\e,L \e(B]
- "Cyrillic ALTERNATIVNYJ decoding table.")
-
-(let ((table (make-translation-table-from-vector
- cyrillic-alternativnyj-decode-table)))
- (define-translation-table 'cyrillic-alternativnyj-nonascii-translation-table
- table)
- (define-translation-table 'cyrillic-alternativnyj-encode-table
- (char-table-extra-slot table 0)))
-
-(makunbound 'cyrillic-alternativnyj-decode-table)
-
-(define-ccl-program ccl-decode-alternativnyj
- `(4
- ((loop
- (r0 = 0)
- (read r1)
- (if (r1 < 128)
- (write-repeat r1)
- ((translate-character cyrillic-alternativnyj-nonascii-translation-table
- r0 r1)
- (translate-character ucs-translation-table-for-decode r0 r1)
- (write-multibyte-character r0 r1)
- (repeat))))))
- "CCL program to decode Alternativnyj.")
-
-(define-ccl-program ccl-encode-alternativnyj
- `(1
- ((loop
- (read-multibyte-character r0 r1)
- (translate-character cyrillic-alternativnyj-encode-table r0 r1)
- (if (r0 != ,(charset-id 'ascii))
- (if (r0 != ,(charset-id 'eight-bit-graphic))
- (if (r0 != ,(charset-id 'eight-bit-control))
- (r1 = ??))))
- (write-repeat r1))))
- "CCL program to encode Alternativnyj.")
-
-(cyrillic-unify-encoding 'cyrillic-alternativnyj-encode-table)
-
-(make-coding-system
- 'cyrillic-alternativnyj 4 ?A
- "ALTERNATIVNYJ 8-bit encoding for Cyrillic."
- '(ccl-decode-alternativnyj . ccl-encode-alternativnyj)
- `((safe-chars . cyrillic-alternativnyj-encode-table)
- (valid-codes (0 . 255))
- (dependency unify-8859-on-encoding-mode unify-8859-on-decoding-mode)))
+(define-coding-system 'cyrillic-alternativnyj
+ "ALTERNATIVNYJ 8-bit encoding for Cyrillic."
+ :coding-type 'charset
+ :mnemonic ?A
+ :charset-list '(alternativnyj))
(define-coding-system-alias 'alternativnyj 'cyrillic-alternativnyj)
-(define-ccl-program ccl-encode-alternativnyj-font
- `(0
- (translate-character cyrillic-alternativnyj-encode-table r0 r1))
- "CCL program to encode Cyrillic chars to Alternativnyj font.")
-
-(add-to-list 'font-ccl-encoder-alist
- '("alternativnyj" . ccl-encode-alternativnyj-font))
-
(set-language-info-alist
- "Cyrillic-ALT" `((charset cyrillic-iso8859-5)
- (nonascii-translation
- . ,(get 'cyrillic-alternativnyj-nonascii-translation-table
- 'translation-table))
+ "Cyrillic-ALT" `((charset alternativnyj)
(coding-system cyrillic-alternativnyj)
(coding-priority cyrillic-alternativnyj)
+ (nonascii-translation . alternativnyj)
(input-method . "russian-typewriter")
(features cyril-util)
(unibyte-display . cyrillic-alternativnyj)
(documentation . "Support for Cyrillic ALTERNATIVNYJ."))
'("Cyrillic"))
+(define-coding-system 'cp866
+ "CP866 encoding for Cyrillic."
+ :coding-type 'charset
+ :mnemonic ?*
+ :charset-list '(ibm866)
+ :mime-charset 'cp866)
+
+(define-coding-system 'koi8-u
+ "KOI8-U 8-bit encoding for Cyrillic (MIME: KOI8-U)"
+ :coding-type 'charset
+ :mnemonic ?U
+ :charset-list '(koi8-u)
+ :mime-charset 'koi8-u)
+
+(define-coding-system 'koi8-t
+ "KOI8-T 8-bit encoding for Cyrillic"
+ :coding-type 'charset
+ :mnemonic ?*
+ :charset-list '(koi8-t)
+ :mime-charset 'koi8-t)
+
+(define-coding-system 'windows-1251
+ "windows-1251 8-bit encoding for Cyrillic (MIME: WINDOWS-1251)"
+ :coding-type 'charset
+ :mnemonic ?b
+ :charset-list '(windows-1251)
+ :mime-charset 'windows-1251)
+(define-coding-system-alias 'cp1251 'windows-1251)
+
+(define-coding-system 'cp1125
+ "cp1125 8-bit encoding for Cyrillic"
+ :coding-type 'charset
+ :mnemonic ?*
+ :charset-list '(cp1125))
+(define-coding-system-alias 'ruscii 'cp1125)
+;; Original name for cp1125, says Serhii Hlodin <hlodin@lutsk.bank.gov.ua>
+(define-coding-system-alias 'cp866u 'cp1125)
+
+(define-coding-system 'cp855
+ "DOS codepage 855 (Russian)"
+ :coding-type 'charset
+ :mnemonic ?D
+ :charset-list '(cp855)
+ :mime-charset 'cp855)
+(define-coding-system-alias 'ibm855 'cp855)
+
+(define-coding-system 'mik
+ "Bulgarian DOS codepage"
+ :coding-type 'charset
+ :mnemonic ?D
+ :charset-list '(mik))
+
+(define-coding-system 'pt154
+ "Parattype Asian Cyrillic codepage"
+ :coding-type 'charset
+ :mnemonic ?D
+ :charset-list '(pt154))
+
+;; (set-language-info-alist
+;; "Windows-1251" `((coding-system windows-1251)
+;; (coding-priority windows-1251)
+;; (input-method . "russian-typewriter") ; fixme?
+;; (features code-pages)
+;; (documentation . "Support for windows-1251 character set."))
+;; '("Cyrillic"))
+
(set-language-info-alist
- "Tajik" `((coding-system cyrillic-koi8-t)
- (coding-priority cyrillic-koi8-t)
- (nonascii-translation
- . ,(get 'decode-koi8-t 'translation-table))
+ "Tajik" `((coding-system koi8-t)
+ (coding-priority koi8-t)
+ (nonascii-translation . cyrillic-koi8-t)
+ (charset koi8-t)
(input-method . "russian-typewriter") ; fixme?
(features code-pages)
(documentation . "Support for Tajik using KOI8-T."))
'("Cyrillic"))
-(eval-and-compile
- (setq
- non-iso-charset-alist
- (cp-make-coding-system
- windows-1251
- [?\\e$,1("\e(B ?\\e$,1(#\e(B ?\\e$,1rz\e(B ?\\e$,1(s\e(B ?\\e$,1r~\e(B ?\\e$,1s&\e(B ?\\e$,1s \e(B ?\\e$,1s!\e(B ?\\e$,1tL\e(B ?\\e$,1s0\e(B ?\\e$,1()\e(B ?\\e$,1s9\e(B ?\\e$,1(*\e(B ?\\e$,1(,\e(B ?\\e$,1(+\e(B ?\\e$,1(/\e(B ?\\e$,1(r\e(B
- ?\\e$,1rx\e(B ?\\e$,1ry\e(B ?\\e$,1r|\e(B ?\\e$,1r}\e(B ?\\e$,1s"\e(B ?\\e$,1rs\e(B ?\\e$,1rt\e(B nil ?\\e$,1ub\e(B ?\\e$,1(y\e(B ?\\e$,1s:\e(B ?\\e$,1(z\e(B ?\\e$,1(|\e(B ?\\e$,1({\e(B ?\\e$,1(\7f\e(B ?\\e,A \e(B ?\\e$,1(.\e(B
- ?\\e$,1(~\e(B ?\\e$,1((\e(B ?\\e,A$\e(B ?\\e$,1)P\e(B ?\\e,A&\e(B ?\\e,A'\e(B ?\\e$,1(!\e(B ?\\e,A)\e(B ?\\e$,1($\e(B ?\\e,A+\e(B ?\\e,A,\e(B ?\\e,A-\e(B ?\\e,A.\e(B ?\\e$,1('\e(B ?\\e,A0\e(B ?\\e,A1\e(B ?\\e$,1(&\e(B
- ?\\e$,1(v\e(B ?\\e$,1)Q\e(B ?\\e,A5\e(B ?\\e,A6\e(B ?\\e,A7\e(B ?\\e$,1(q\e(B ?\\e$,1uV\e(B ?\\e$,1(t\e(B ?\\e,A;\e(B ?\\e$,1(x\e(B ?\\e$,1(%\e(B ?\\e$,1(u\e(B ?\\e$,1(w\e(B ?\\e$,1(0\e(B ?\\e$,1(1\e(B ?\\e$,1(2\e(B ?\\e$,1(3\e(B
- ?\\e$,1(4\e(B ?\\e$,1(5\e(B ?\\e$,1(6\e(B ?\\e$,1(7\e(B ?\\e$,1(8\e(B ?\\e$,1(9\e(B ?\\e$,1(:\e(B ?\\e$,1(;\e(B ?\\e$,1(<\e(B ?\\e$,1(=\e(B ?\\e$,1(>\e(B ?\\e$,1(?\e(B ?\\e$,1(@\e(B ?\\e$,1(A\e(B ?\\e$,1(B\e(B ?\\e$,1(C\e(B ?\\e$,1(D\e(B
- ?\\e$,1(E\e(B ?\\e$,1(F\e(B ?\\e$,1(G\e(B ?\\e$,1(H\e(B ?\\e$,1(I\e(B ?\\e$,1(J\e(B ?\\e$,1(K\e(B ?\\e$,1(L\e(B ?\\e$,1(M\e(B ?\\e$,1(N\e(B ?\\e$,1(O\e(B ?\\e$,1(P\e(B ?\\e$,1(Q\e(B ?\\e$,1(R\e(B ?\\e$,1(S\e(B ?\\e$,1(T\e(B ?\\e$,1(U\e(B
- ?\\e$,1(V\e(B ?\\e$,1(W\e(B ?\\e$,1(X\e(B ?\\e$,1(Y\e(B ?\\e$,1(Z\e(B ?\\e$,1([\e(B ?\\e$,1(\\e(B ?\\e$,1(]\e(B ?\\e$,1(^\e(B ?\\e$,1(_\e(B ?\\e$,1(`\e(B ?\\e$,1(a\e(B ?\\e$,1(b\e(B ?\\e$,1(c\e(B ?\\e$,1(d\e(B ?\\e$,1(e\e(B ?\\e$,1(f\e(B
- ?\\e$,1(g\e(B ?\\e$,1(h\e(B ?\\e$,1(i\e(B ?\\e$,1(j\e(B ?\\e$,1(k\e(B ?\\e$,1(l\e(B ?\\e$,1(m\e(B ?\\e$,1(n\e(B ?\\e$,1(o\e(B] nil ?b)))
-
-;; Register cyrillic-iso8859-5 characters in the encode table of
-;; windows-1251.
-(let ((table (get 'encode-windows-1251 'translation-table))
- ;; Nth element is a cyrillic-iso8859-5 character encoded to a
- ;; code (128 + N), or nil.
- (vec [?\\e,L"\e(B ?\\e,L#\e(B nil ?\\e,Ls\e(B nil nil nil nil nil nil ?\\e,L)\e(B nil ?\\e,L*\e(B ?\\e,L,\e(B ?\\e,L+\e(B ?\\e,L/\e(B
- ?\\e,Lr\e(B nil nil nil nil nil nil nil nil nil ?\\e,Ly\e(B nil ?\\e,Lz\e(B ?\\e,L|\e(B ?\\e,L{\e(B ?\\e,L\7f\e(B
- nil ?\\e,L.\e(B ?\\e,L~\e(B ?\\e,L(\e(B nil nil nil nil ?\\e,L!\e(B nil ?\\e,L$\e(B nil nil nil nil ?\\e,L'\e(B
- nil nil ?\\e,L&\e(B ?\\e,Lv\e(B nil nil nil nil ?\\e,Lq\e(B ?\\e,Lp\e(B ?\\e,Lt\e(B nil ?\\e,Lx\e(B ?\\e,L%\e(B ?\\e,Lu\e(B ?\\e,Lw\e(B
- ?\\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
- ?\\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]))
- (dotimes (i (length vec))
- (if (aref vec i)
- (aset table (aref vec i) (+ 128 i)))))
-
-(define-coding-system-alias 'cp1251 'windows-1251)
-
(let ((elt `("microsoft-cp1251" windows-1251 1
,(get 'encode-windows-1251 'translation-table)))
(slot (assoc "microsoft-cp1251" ctext-non-standard-encodings-alist)))
(setcdr slot (cdr elt))
(push elt ctext-non-standard-encodings-alist)))
-(define-ccl-program ccl-encode-windows-1251-font
- `(0
- ((if (r0 == ,(charset-id 'mule-unicode-0100-24ff))
- ((r1 <<= 7)
- (r1 += r2)))
- (translate-character encode-windows-1251 r0 r1))))
-
-(add-to-list 'font-ccl-encoder-alist
- '("microsoft-cp1251" . ccl-encode-windows-1251-font))
-
(set-language-info-alist
"Bulgarian" `((coding-system windows-1251)
(coding-priority windows-1251)
+ (nonascii-translation . windows-1251)
+ (charset windows-1251)
(ctext-non-standard-encodings "microsoft-cp1251")
- (overriding-fontspec
- (,(get 'encode-windows-1251 'translation-table)
- . (nil . "microsoft-cp1251"))
- (,(get 'cyrillic-koi8-r-encode-table 'translation-table)
- . (nil . "koi8-r")))
- (nonascii-translation
- . ,(get 'decode-windows-1251 'translation-table))
(input-method . "bulgarian-bds")
(documentation
- . "Support for Bulgarian with windows-1251 character set.")
- (tutorial . "TUTORIAL.bg"))
+ . "Support for Bulgrian with windows-1251 character set."))
'("Cyrillic"))
(set-language-info-alist
"Belarusian" `((coding-system windows-1251)
(coding-priority windows-1251)
+ (nonascii-translation . windows-1251)
+ (charset windows-1251)
(ctext-non-standard-encodings "microsoft-cp1251")
- (overriding-fontspec
- (,(get 'encode-windows-1251 'translation-table)
- . (nil . "microsoft-cp1251"))
- (,(get 'cyrillic-koi8-r-encode-table 'translation-table)
- . (nil . "koi8-r")))
- (nonascii-translation
- . ,(get 'decode-windows-1251 'translation-table))
(input-method . "belarusian")
(documentation
. "Support for Belarusian with windows-1251 character set.
\(The name Belarusian replaced Byelorussian in the early 1990s.)"))
'("Cyrillic"))
+(set-language-info-alist
+ "Ukrainian" `((coding-system koi8-u)
+ (coding-priority koi8-u)
+ (input-method . "ukrainian-computer")
+ (documentation
+ . "Support for Ukrainian with koi8-u character set."))
+ '("Cyrillic"))
+
(provide 'cyrillic)
;;; arch-tag: bda71ae0-ba41-4cb6-a6e0-1dff542313d3
;;; czech.el --- support for Czech -*- coding: iso-2022-7bit; no-byte-compile: t -*-
- ;; Copyright (C) 1998, 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ ;; Copyright (C) 1998, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
;; Free Software Foundation.
;; Author: Milan Zamazal <pdm@zamazal.org>
(coding-system . (iso-8859-2))
(coding-priority . (iso-8859-2))
(input-method . "czech")
- (nonascii-translation . latin-iso8859-2)
- (unibyte-syntax . "latin-2")
+ (nonascii-translation . iso-8859-2)
(unibyte-display . iso-8859-2)
(tutorial . "TUTORIAL.cs")
(sample-text . "P\e,Bx\e(Bejeme v\e,Ba\e(Bm hezk\e,B}\e(B den!")
-;;; devan-util.el --- Support for composing Devanagari characters
+;;; devan-util.el --- Support for composing Devanagari characters -*-coding: iso-2022-7bit;-*-
- ;; Copyright (C) 1997, 1998, 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ ;; Copyright (C) 1997, 1998, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
;; Free Software Foundation, Inc.
- ;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ ;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
+ ;; 2007, 2008
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
;;; Code:
-;;;###autoload
-
;; Devanagari Composable Pattern
;; C .. Consonants
;; V .. Vowel
(defconst devanagari-consonant
"[\e$,15U\e(B-\e$,15y68\e(B-\e$,16?\e(B]")
+ ;;("\e$,16B\e(B" . nil)
+ ;;("\e$,16A\e(B" . nil)
+ ;;("\e$,16C\e(B" . nil)
+
+
(defconst devanagari-composable-pattern
(concat
"\\([\e$,15E\e(B-\e$,15T6@6A\e(B][\e$,15A5B\e(B]?\\)\\|[\e$,15C6D\e(B]"
"\\)")
"Regexp matching a composable sequence of Devanagari characters.")
+(dolist (range '((#x0903 . #x0903)
+ (#x0905 . #x0939)
+ (#x0958 . #x0961)))
+ (set-char-table-range indian-composable-pattern range
+ devanagari-composable-pattern))
+
;;;###autoload
(defun devanagari-compose-region (from to)
(interactive "r")
(narrow-to-region from to)
(goto-char (point-min))
(while (re-search-forward devanagari-composable-pattern nil t)
- (devanagari-compose-syllable-region (match-beginning 0)
- (match-end 0))))))
+ (devanagari-compose-syllable-region (match-beginning 0)
+ (match-end 0))))))
(defun devanagari-compose-string (string)
(with-temp-buffer
(insert (decompose-string string))
(set-buffer-modified-p buffer-modified-p)
(- (point-max) (point-min))))))
-(defun devanagari-range (from to)
- "Make the list of the integers of range FROM to TO."
- (let (result)
- (while (<= from to) (setq result (cons to result) to (1- to))) result))
-
(defun devanagari-regexp-of-hashtbl-keys (hashtbl)
"Return a regular expression that matches all keys in hashtable HASHTBL."
(let ((max-specpdl-size 1000))
dummy)
(function (lambda (x y) (> (length x) (length y))))))))
-(defun devanagari-composition-function (from to pattern &optional string)
- "Compose Devanagari characters in REGION, or STRING if specified.
-Assume that the REGION or STRING must fully match the composable
-PATTERN regexp."
- (if string (devanagari-compose-syllable-string string)
- (devanagari-compose-syllable-region from to))
- (- to from))
-
-;; Register a function to compose Devanagari characters.
-(mapc
- (function (lambda (ucs)
- (aset composition-function-table (decode-char 'ucs ucs)
- (list (cons devanagari-composable-pattern
- 'devanagari-composition-function)))))
- (nconc '(#x0903) (devanagari-range #x0905 #x0939) (devanagari-range #x0958 #x0961)))
+;;;###autoload
+(defun devanagari-composition-function (pos &optional string)
+ "Compose Devanagari characters after the position POS.
+If STRING is not nil, it is a string, and POS is an index to the string.
+In this case, compose characters after POS of the string."
+ (if string
+ (if auto-compose-current-font
+ (if (eq (string-match "[\e$,15@\e(B-\e$,16_\e(B]+" pos) pos)
+ (or (font-shape-text 0 (match-end 0) auto-compose-current-font
+ string)
+ pos)))
+ (goto-char pos)
+ (if auto-compose-current-font
+ (if (looking-at "[\e$,15@\e(B-\e$,16_\e(B]+")
+ (or (font-shape-text pos (match-end 0) auto-compose-current-font)
+ pos)
+ (if (looking-at devanagari-composable-pattern)
+ (prog1 (match-end 0)
+ (devanagari-compose-syllable-region pos (match-end 0))))))))
;; Notes on conversion steps.
(defvar dev-glyph-glyph-2-regexp
(devanagari-regexp-of-hashtbl-keys dev-glyph-glyph-2-hash))
-
(defun dev-charseq (from &optional to)
(if (null to) (setq to from))
- (mapcar (function (lambda (x) (indian-glyph-char x 'devanagari)))
- (devanagari-range from to)))
+ (number-sequence (decode-char 'devanagari-cdac from)
+ (decode-char 'devanagari-cdac to)))
(defvar dev-glyph-cvn
(append
;;; devanagari.el --- Support for Devanagari -*- coding: iso-2022-7bit; no-byte-compile: t -*-
- ;; Copyright (C) 1996, 1997, 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ ;; Copyright (C) 1996, 1997, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
;; Free Software Foundation, Inc.
;; Maintainer: KAWABATA, Taichi <kawabata@m17n.org>
"Devanagari" '((charset indian-is13194 mule-unicode-0100-24ff
indian-2-column indian-glyph ;; comment out later
)
- (coding-system in-is13194)
- (coding-priority in-is13194)
+ (coding-system in-is13194-devanagari)
+ (coding-priority in-is13194-devanagari)
(input-method . "dev-aiba")
(features devan-util)
(documentation . "\
are supported in this language environment."))
'("Indian"))
+;; For automatic composition.
+(dolist (range '((#x0903 . #x0903)
+ (#x0905 . #x0939)
+ (#x0958 . #x0961)))
+ (set-char-table-range composition-function-table range
+ '(("[\x0900-\x097F]+" . font-shape-text))))
+
(provide 'devanagari)
;;; arch-tag: fd13667d-868b-41e8-81ef-79dd28bbfed2
;;; english.el --- support for English -*- no-byte-compile: t -*-
- ;; Copyright (C) 1997, 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ ;; Copyright (C) 1997, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
;; Free Software Foundation, Inc.
- ;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ ;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
+ ;; 2006, 2007, 2008
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
+;; Copyright (C) 2003
+;; National Institute of Advanced Industrial Science and Technology (AIST)
+;; Registration Number H13PRO009
;; Keywords: multibyte character, character set, syntax, category
Nothing special is needed to handle English.")
))
+;; Mostly because we can now...
+(define-coding-system 'ebcdic-us
+ "US version of EBCDIC"
+ :coding-type 'charset
+ :charset-list '(ebcdic-us)
+ :mnemonic ?*)
+
+(define-coding-system 'ebcdic-uk
+ "UK version of EBCDIC"
+ :coding-type 'charset
+ :charset-list '(ebcdic-uk)
+ :mnemonic ?*)
+
+(define-coding-system 'ibm1047
+ "A version of EBCDIC used in OS/390 Unix" ; says Groff
+ :coding-type 'charset
+ :charset-list '(ibm1047)
+ :mnemonic ?*)
+(define-coding-system-alias 'cp1047 'ibm1047)
+
;; Make "ASCII" an alias of "English" language environment.
(set-language-info-alist
"ASCII" (cdr (assoc "English" language-info-alist)))
-;;; ethio-util.el --- utilities for Ethiopic -*- coding: iso-2022-7bit; -*-
+;;; ethio-util.el --- utilities for Ethiopic -*- coding: utf-8; -*-
- ;; Copyright (C) 1997, 1998, 2002, 2003, 2004, 2005, 2006, 2007
+ ;; Copyright (C) 1997, 1998, 2002, 2003, 2004, 2005, 2006, 2007, 2008
;; Free Software Foundation, Inc.
- ;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ ;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
+ ;; 2006, 2007, 2008
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
+;; Copyright (C) 2005, 2006
+;; National Institute of Advanced Industrial Science and Technology (AIST)
+;; Registration Number: H15PRO110
;; Keywords: mule, multilingual, Ethiopic
;;; Code:
+(require 'robin)
+
(defvar rmail-current-message)
(defvar rmail-message-vector)
(defun setup-ethiopic-environment-internal ()
(let ((key-bindings '((" " . ethio-insert-space)
([?\S- ] . ethio-insert-ethio-space)
- ([?\C-'] . ethio-gemination)
-
- ;; these old bindings conflict
- ;; with Emacs' binding policy
-
- ;; ([f2] . ethio-toggle-space)
- ;; ([S-f2] . ethio-replace-space) ; as requested
- ;; ([f3] . ethio-toggle-punctuation)
- ;; ([f4] . ethio-sera-to-fidel-buffer)
- ;; ([S-f4] . ethio-sera-to-fidel-region)
- ;; ([C-f4] . ethio-sera-to-fidel-mail-or-marker)
- ;; ([f5] . ethio-fidel-to-sera-buffer)
- ;; ([S-f5] . ethio-fidel-to-sera-region)
- ;; ([C-f5] . ethio-fidel-to-sera-mail-or-marker)
- ;; ([f6] . ethio-modify-vowel)
- ;; ([f7] . ethio-replace-space)
- ;; ([f8] . ethio-input-special-character)
-
- ;; this is the rewritten bindings
-
+ ;; ([?\C-'] . ethio-gemination)
([f3] . ethio-fidel-to-sera-buffer)
([S-f3] . ethio-fidel-to-sera-region)
- ([C-f3] . ethio-fidel-to-sera-mail-or-marker)
+ ([C-f3] . ethio-fidel-to-sera-marker)
([f4] . ethio-sera-to-fidel-buffer)
([S-f4] . ethio-sera-to-fidel-region)
- ([C-f4] . ethio-sera-to-fidel-mail-or-marker)
+ ([C-f4] . ethio-sera-to-fidel-marker)
([S-f5] . ethio-toggle-punctuation)
([S-f6] . ethio-modify-vowel)
([S-f7] . ethio-replace-space)
- ([S-f8] . ethio-input-special-character)
+ ;; ([S-f8] . ethio-input-special-character) ; deprecated
([C-f9] . ethio-toggle-space)
([S-f9] . ethio-replace-space) ; as requested
))
(global-set-key kb (cdr (car key-bindings)))
(setq key-bindings (cdr key-bindings))))
- (add-hook 'quail-activate-hook 'ethio-select-a-translation)
(add-hook 'find-file-hook 'ethio-find-file)
(add-hook 'write-file-functions 'ethio-write-file)
(add-hook 'after-save-hook 'ethio-find-file))
(setq exit-ethiopic-environment-data
(cdr exit-ethiopic-environment-data)))
- (remove-hook 'quail-activate-hook 'ethio-select-a-translation)
(remove-hook 'find-file-hook 'ethio-find-file)
(remove-hook 'write-file-functions 'ethio-write-file)
(remove-hook 'after-save-hook 'ethio-find-file))
;;
;; If the filename ends in ".tex", editing is done in fidel
;; but file I/O is done in EthioTeX format.
-;;
-;; To automatically convert Ethiopic text to SERA format when sending mail,
-;; (add-hook 'mail-send-hook 'ethio-fidel-to-sera-mail)
-;;
-;; To automatically convert SERA format to Ethiopic when receiving mail,
-;; (add-hook 'rmail-show-message-hook 'ethio-sera-to-fidel-mail)
-;;
-;; To automatically convert Ethiopic text to SERA format when posting news,
-;; (add-hook 'news-inews-hook 'ethio-fidel-to-sera-mail)
;;
;; users' preference
(defvar ethio-quote-vowel-always nil
"*Non-nil means always put an apostrophe before an isolated vowel (except at word initial) in FIDEL --> SERA conversion.
-If nil, put an apostrophe only between a sixth-form consonant and an
+If nil, put an apostrophe only between a 6th-form consonant and an
isolated vowel.")
(defvar ethio-W-sixth-always nil
`109100807 if `ethio-numeric-reduction' is 1,
`10900807 if `ethio-numeric-reduction' is 2.")
-(defvar ethio-implicit-period-conversion t
- "*Non-nil means replacing the Ethiopic dot at the end of an Ethiopic sentence
-with an Ethiopic full stop.")
-
(defvar ethio-java-save-lowercase nil
"*Non-nil means save Ethiopic characters in lowercase hex numbers to Java files.
If nil, use uppercases.")
+(defun ethio-prefer-amharic-p ()
+ (or (eq ethio-primary-language 'amharic)
+ (and (not (eq ethio-primary-language 'tigrigna))
+ (eq ethio-secondary-language 'amharic))))
+
+(defun ethio-prefer-amharic (arg)
+ (if arg
+ (progn
+ (robin-modify-package "ethiopic-sera" "'a" ?አ)
+ (robin-modify-package "ethiopic-sera" "a" "አ")
+ (robin-modify-package "ethiopic-sera" "'A" ?ኣ)
+ (robin-modify-package "ethiopic-sera" "A" "ኣ"))
+ (robin-modify-package "ethiopic-sera" "'A" ?አ)
+ (robin-modify-package "ethiopic-sera" "A" "አ")
+ (robin-modify-package "ethiopic-sera" "'a" ?ኣ)
+ (robin-modify-package "ethiopic-sera" "a" "ኣ")))
+
+(defun ethio-use-colon-for-colon (arg)
+ (if arg
+ (progn
+ (robin-modify-package "ethiopic-sera" ":" ?á¥)
+ (robin-modify-package "ethiopic-sera" "`:" ?á¡))
+ (robin-modify-package "ethiopic-sera" " : " ?á¡)
+ (robin-modify-package "ethiopic-sera" ":" "á¡")
+ (robin-modify-package "ethiopic-sera" "-:" ?á¥)))
+
+(defun ethio-use-three-dot-question (arg)
+ (if arg
+ (progn
+ (robin-modify-package "ethiopic-sera" "?" ?á§)
+ (robin-modify-package "ethiopic-sera" "`?" ??))
+ (robin-modify-package "ethiopic-sera" "?" ??)
+ (robin-modify-package "ethiopic-sera" "`?" ?á§)))
+
+(defun ethio-adjust-robin ()
+ (ethio-prefer-amharic (ethio-prefer-amharic-p))
+ (ethio-use-colon-for-colon ethio-use-colon-for-colon)
+ (ethio-use-three-dot-question ethio-use-three-dot-question))
+
+(add-hook 'robin-activate-hook 'ethio-adjust-robin)
+
;;
;; SERA to FIDEL
;;
-(defconst ethio-sera-to-fidel-table
- [
- nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
- nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
-;;; SP
- (" "
- (?: (if ethio-use-colon-for-colon " \e$(3$l\e(B" "\e$(3$h\e(B")
- (32 (if ethio-use-colon-for-colon " \e$(3$l\e(B " "\e$(3$h\e(B"))
- (?- " \e$(3$m\e(B")
- (?: " \e$(3$i\e(B")
- (?| (if ethio-use-colon-for-colon " \e$(3$l\e(B|" " \e$(3$h\e(B|")
- (?: " \e$(3$o\e(B"))))
-
-;;; ! " # $ % & '
- nil nil nil nil nil nil ("" (?' "\e$(3%s\e(B"))
-;;; ( ) * + , - .
- nil nil nil nil ("\e$(3$j\e(B") ("-" (?: "\e$(3$l\e(B")) ("\e$(3%u\e(B")
-;;; / 0 1 2 3 4 5 6 7 8 9
- nil nil nil nil nil nil nil nil nil nil nil
-;;; :
- ((if ethio-use-colon-for-colon "\e$(3$l\e(B" "\e$(3$h\e(B")
- (32 (if ethio-use-colon-for-colon "\e$(3$l\e(B " "\e$(3$h\e(B"))
- (?- "\e$(3$m\e(B")
- (?: "\e$(3$i\e(B")
- (?| (if ethio-use-colon-for-colon "\e$(3$l\e(B|" "\e$(3$h\e(B|")
- (?: "\e$(3$o\e(B")))
-;;; ; < = >
- ("\e$(3$k\e(B") ("<" (?< "\e$(3%v\e(B")) nil (">" (?> "\e$(3%w\e(B"))
-;;; ?
- ((if ethio-use-three-dot-question "\e$(3$n\e(B" "\e$(3%x\e(B"))
-;;; @
- nil
-;;; A
- ("\e$(3"f\e(B" (?2 "\e$(3#8\e(B"))
-;;; B
- ("\e$(3"(\e(B" (?e "\e$(3"#\e(B") (?u "\e$(3"$\e(B") (?i "\e$(3"%\e(B") (?a "\e$(3"&\e(B") (?E "\e$(3"'\e(B") (?o "\e$(3")\e(B")
- (?W "\e$(3%b\e(B" (?e "\e$(3%2\e(B") (?u "\e$(3%b\e(B") (?i "\e$(3%B\e(B") (?a "\e$(3"*\e(B") (?E "\e$(3%R\e(B")))
-;;; C
- ("\e$(3$4\e(B" (?e "\e$(3$/\e(B") (?u "\e$(3$0\e(B") (?i "\e$(3$1\e(B") (?a "\e$(3$2\e(B") (?E "\e$(3$3\e(B") (?o "\e$(3$5\e(B")
- (?W "\e$(3$6\e(B" (?a "\e$(3$6\e(B")
- (?e "\e$(3$4%n\e(B") (?u "\e$(3$4%r\e(B") (?i "\e$(3$4%o\e(B") (?E "\e$(3$4%q\e(B")))
-;;; D
- ("\e$(3#b\e(B" (?e "\e$(3#]\e(B") (?u "\e$(3#^\e(B") (?i "\e$(3#_\e(B") (?a "\e$(3#`\e(B") (?E "\e$(3#a\e(B") (?o "\e$(3#c\e(B")
- (?W "\e$(3#d\e(B" (?a "\e$(3#d\e(B")
- (?e "\e$(3#b%n\e(B") (?u "\e$(3#b%r\e(B") (?i "\e$(3#b%o\e(B") (?E "\e$(3#b%q\e(B")))
-;;; E
- ("\e$(3"g\e(B" (?2 "\e$(3#9\e(B"))
-;;; F
- ("\e$(3$T\e(B" (?e "\e$(3$O\e(B") (?u "\e$(3$P\e(B") (?i "\e$(3$Q\e(B") (?a "\e$(3$R\e(B") (?E "\e$(3$S\e(B") (?o "\e$(3$U\e(B")
- (?W "\e$(3%d\e(B" (?e "\e$(3%4\e(B") (?u "\e$(3%d\e(B") (?i "\e$(3%D\e(B") (?a "\e$(3$V\e(B") (?E "\e$(3%T\e(B"))
- (?Y "\e$(3$a\e(B" (?a "\e$(3$a\e(B")))
-;;; G
- ("\e$(3$$\e(B" (?e "\e$(3#}\e(B") (?u "\e$(3#~\e(B") (?i "\e$(3$!\e(B") (?a "\e$(3$"\e(B") (?E "\e$(3$#\e(B") (?o "\e$(3$%\e(B")
- (?W "\e$(3%c\e(B" (?e "\e$(3%3\e(B") (?u "\e$(3%c\e(B") (?i "\e$(3%C\e(B") (?a "\e$(3$&\e(B") (?E "\e$(3%S\e(B")))
-;;; H
- ("\e$(3!6\e(B" (?e "\e$(3!1\e(B") (?u "\e$(3!2\e(B") (?i "\e$(3!3\e(B") (?a "\e$(3!4\e(B") (?E "\e$(3!5\e(B") (?o "\e$(3!7\e(B")
- (?W "\e$(3!8\e(B" (?a "\e$(3!8\e(B")
- (?e "\e$(3!6%n\e(B") (?u "\e$(3!6%r\e(B") (?i "\e$(3!6%o\e(B") (?E "\e$(3!6%q\e(B")))
-;;; I
- ("\e$(3"h\e(B" (?2 "\e$(3#:\e(B"))
-;;; J
- ("\e$(3#j\e(B" (?e "\e$(3#e\e(B") (?u "\e$(3#f\e(B") (?i "\e$(3#g\e(B") (?a "\e$(3#h\e(B") (?E "\e$(3#i\e(B") (?o "\e$(3#k\e(B")
- (?W "\e$(3#l\e(B" (?a "\e$(3#l\e(B")
- (?e "\e$(3#j%n\e(B") (?u "\e$(3#j%r\e(B") (?i "\e$(3#j%o\e(B") (?E "\e$(3#j%q\e(B")))
-;;; K
- ("\e$(3#"\e(B" (?e "\e$(3"{\e(B") (?u "\e$(3"|\e(B") (?i "\e$(3"}\e(B") (?a "\e$(3"~\e(B") (?E "\e$(3#!\e(B") (?o "\e$(3##\e(B")
- (?W "\e$(3#*\e(B" (?e "\e$(3#%\e(B") (?u "\e$(3#*\e(B") (?i "\e$(3#'\e(B") (?a "\e$(3#(\e(B") (?E "\e$(3#)\e(B")))
-;;; L
- ("\e$(3!.\e(B" (?e "\e$(3!)\e(B") (?u "\e$(3!*\e(B") (?i "\e$(3!+\e(B") (?a "\e$(3!,\e(B") (?E "\e$(3!-\e(B") (?o "\e$(3!/\e(B")
- (?W "\e$(3!0\e(B" (?a "\e$(3!0\e(B")
- (?e "\e$(3!.%n\e(B") (?u "\e$(3!.%r\e(B") (?i "\e$(3!.%o\e(B") (?E "\e$(3!.%q\e(B")))
-;;; M
- ("\e$(3!>\e(B" (?e "\e$(3!9\e(B") (?u "\e$(3!:\e(B") (?i "\e$(3!;\e(B") (?a "\e$(3!<\e(B") (?E "\e$(3!=\e(B") (?o "\e$(3!?\e(B")
- (?W "\e$(3%a\e(B" (?e "\e$(3%1\e(B") (?u "\e$(3%a\e(B") (?i "\e$(3%A\e(B") (?a "\e$(3!@\e(B") (?E "\e$(3%Q\e(B"))
- (?Y "\e$(3$_\e(B" (?a "\e$(3$_\e(B")))
-;;; N
- ("\e$(3"`\e(B" (?e "\e$(3"[\e(B") (?u "\e$(3"\\e(B") (?i "\e$(3"]\e(B") (?a "\e$(3"^\e(B") (?E "\e$(3"_\e(B") (?o "\e$(3"a\e(B")
- (?W "\e$(3"b\e(B" (?a "\e$(3"b\e(B")
- (?e "\e$(3"`%n\e(B") (?u "\e$(3"`%r\e(B") (?i "\e$(3"`%o\e(B") (?E "\e$(3"`%q\e(B")))
-;;; O
- ("\e$(3"i\e(B" (?2 "\e$(3#;\e(B"))
-;;; P
- ("\e$(3$<\e(B" (?e "\e$(3$7\e(B") (?u "\e$(3$8\e(B") (?i "\e$(3$9\e(B") (?a "\e$(3$:\e(B") (?E "\e$(3$;\e(B") (?o "\e$(3$=\e(B")
- (?W "\e$(3$>\e(B" (?a "\e$(3$>\e(B")
- (?e "\e$(3$<%n\e(B") (?u "\e$(3$<%r\e(B") (?i "\e$(3$<%o\e(B") (?E "\e$(3$<%q\e(B")))
-;;; Q
- ("\e$(3!v\e(B" (?e "\e$(3!q\e(B") (?u "\e$(3!r\e(B") (?i "\e$(3!s\e(B") (?a "\e$(3!t\e(B") (?E "\e$(3!u\e(B") (?o "\e$(3!w\e(B")
- (?W "\e$(3!~\e(B" (?e "\e$(3!y\e(B") (?u "\e$(3!~\e(B") (?i "\e$(3!{\e(B") (?a "\e$(3!|\e(B") (?E "\e$(3!}\e(B")))
-;;; R
- ("\e$(3!N\e(B" (?e "\e$(3!I\e(B") (?u "\e$(3!J\e(B") (?i "\e$(3!K\e(B") (?a "\e$(3!L\e(B") (?E "\e$(3!M\e(B") (?o "\e$(3!O\e(B")
- (?W "\e$(3!P\e(B" (?a "\e$(3!P\e(B")
- (?e "\e$(3!N%n\e(B") (?u "\e$(3!N%r\e(B") (?i "\e$(3!N%o\e(B") (?E "\e$(3!N%q\e(B"))
- (?Y "\e$(3$`\e(B" (?a "\e$(3$`\e(B")))
-;;; S
- ("\e$(3$D\e(B" (?e "\e$(3$?\e(B") (?u "\e$(3$@\e(B") (?i "\e$(3$A\e(B") (?a "\e$(3$B\e(B") (?E "\e$(3$C\e(B") (?o "\e$(3$E\e(B")
- (?W "\e$(3$F\e(B" (?a "\e$(3$F\e(B")
- (?e "\e$(3$D%n\e(B") (?u "\e$(3$D%r\e(B") (?i "\e$(3$D%o\e(B") (?E "\e$(3$D%q\e(B"))
- (?2 "\e$(3$L\e(B"
- (?e "\e$(3$G\e(B") (?u "\e$(3$H\e(B") (?i "\e$(3$I\e(B") (?a "\e$(3$J\e(B") (?E "\e$(3$K\e(B") (?o "\e$(3$M\e(B")
- (?W "\e$(3$F\e(B" (?a "\e$(3$F\e(B")
- (?e "\e$(3$L%n\e(B") (?u "\e$(3$L%r\e(B") (?i "\e$(3$L%o\e(B") (?E "\e$(3$L%q\e(B"))))
-;;; T
- ("\e$(3$,\e(B" (?e "\e$(3$'\e(B") (?u "\e$(3$(\e(B") (?i "\e$(3$)\e(B") (?a "\e$(3$*\e(B") (?E "\e$(3$+\e(B") (?o "\e$(3$-\e(B")
- (?W "\e$(3$.\e(B" (?a "\e$(3$.\e(B")
- (?e "\e$(3$,%n\e(B") (?u "\e$(3$,%r\e(B") (?i "\e$(3$,%o\e(B") (?E "\e$(3$,%q\e(B")))
-;;; U
- ("\e$(3"d\e(B" (?2 "\e$(3#6\e(B"))
-;;; V
- ("\e$(3"0\e(B" (?e "\e$(3"+\e(B") (?u "\e$(3",\e(B") (?i "\e$(3"-\e(B") (?a "\e$(3".\e(B") (?E "\e$(3"/\e(B") (?o "\e$(3"1\e(B")
- (?W "\e$(3"2\e(B" (?a "\e$(3"2\e(B")
- (?e "\e$(3"0%n\e(B") (?u "\e$(3"0%r\e(B") (?i "\e$(3"0%o\e(B") (?E "\e$(3"0%q\e(B")))
-;;; W
- ("\e$(3%r\e(B" (?e "\e$(3%n\e(B") (?u "\e$(3%r\e(B") (?i "\e$(3%o\e(B") (?a "\e$(3%p\e(B") (?E "\e$(3%q\e(B"))
-;;; X
- ("\e$(3%N\e(B" (?e "\e$(3%I\e(B") (?u "\e$(3%J\e(B") (?i "\e$(3%K\e(B") (?a "\e$(3%L\e(B") (?E "\e$(3%M\e(B") (?o "\e$(3%O\e(B"))
-;;; Y
- ("\e$(3#R\e(B" (?e "\e$(3#M\e(B") (?u "\e$(3#N\e(B") (?i "\e$(3#O\e(B") (?a "\e$(3#P\e(B") (?E "\e$(3#Q\e(B") (?o "\e$(3#S\e(B")
- (?W "\e$(3#T\e(B" (?a "\e$(3#T\e(B")
- (?e "\e$(3#R%n\e(B") (?u "\e$(3#R%r\e(B") (?i "\e$(3#R%o\e(B") (?E "\e$(3#R%q\e(B")))
-;;; Z
- ("\e$(3#J\e(B" (?e "\e$(3#E\e(B") (?u "\e$(3#F\e(B") (?i "\e$(3#G\e(B") (?a "\e$(3#H\e(B") (?E "\e$(3#I\e(B") (?o "\e$(3#K\e(B")
- (?W "\e$(3#L\e(B" (?a "\e$(3#L\e(B")
- (?e "\e$(3#J%n\e(B") (?u "\e$(3#J%r\e(B") (?i "\e$(3#J%o\e(B") (?E "\e$(3#J%q\e(B")))
-;;; [ \ ] ^ _
- nil nil nil nil nil
-;;; `
- (""
- (?: "\e$(3$h\e(B")
- (?? (if ethio-use-three-dot-question "\e$(3%x\e(B" "\e$(3$n\e(B"))
- (?! "\e$(3%t\e(B")
- (?e "\e$(3#5\e(B") (?u "\e$(3#6\e(B") (?U "\e$(3#6\e(B") (?i "\e$(3#7\e(B") (?a "\e$(3#8\e(B") (?A "\e$(3#8\e(B")
- (?E "\e$(3#9\e(B") (?I "\e$(3#:\e(B") (?o "\e$(3#;\e(B") (?O "\e$(3#;\e(B")
- (?g "\e$(3%^\e(B"
- (?e "\e$(3%Y\e(B") (?u "\e$(3%Z\e(B") (?i "\e$(3%[\e(B") (?a "\e$(3%\\e(B") (?E "\e$(3%]\e(B") (?o "\e$(3%_\e(B"))
- (?h "\e$(3"H\e(B"
- (?e "\e$(3"C\e(B") (?u "\e$(3"D\e(B") (?i "\e$(3"E\e(B") (?a "\e$(3"F\e(B") (?E "\e$(3"G\e(B") (?o "\e$(3"I\e(B")
- (?W "\e$(3"P\e(B" (?e "\e$(3"K\e(B") (?u "\e$(3"P\e(B") (?i "\e$(3"M\e(B") (?a "\e$(3"N\e(B") (?E "\e$(3"O\e(B")))
- (?k "\e$(3%>\e(B"
- (?e "\e$(3%9\e(B") (?u "\e$(3%:\e(B") (?i "\e$(3%;\e(B") (?a "\e$(3%<\e(B") (?E "\e$(3%=\e(B") (?o "\e$(3%?\e(B"))
- (?s "\e$(3!F\e(B"
- (?e "\e$(3!A\e(B") (?u "\e$(3!B\e(B") (?i "\e$(3!C\e(B") (?a "\e$(3!D\e(B") (?E "\e$(3!E\e(B") (?o "\e$(3!G\e(B")
- (?W "\e$(3!H\e(B" (?a "\e$(3!H\e(B")
- (?e "\e$(3!F%n\e(B") (?u "\e$(3!F%r\e(B") (?i "\e$(3!F%o\e(B") (?E "\e$(3!F%q\e(B")))
- (?S "\e$(3$L\e(B"
- (?e "\e$(3$G\e(B") (?u "\e$(3$H\e(B") (?i "\e$(3$I\e(B") (?a "\e$(3$J\e(B") (?E "\e$(3$K\e(B") (?o "\e$(3$M\e(B")
- (?W "\e$(3$F\e(B" (?a "\e$(3$F\e(B")
- (?e "\e$(3$L%n\e(B") (?u "\e$(3$L%r\e(B") (?i "\e$(3$L%o\e(B") (?E "\e$(3$L%q\e(B")))
- (?q "\e$(3%.\e(B" (?e "\e$(3%)\e(B") (?u "\e$(3%*\e(B") (?i "\e$(3%+\e(B") (?a "\e$(3%,\e(B") (?E "\e$(3%-\e(B") (?o "\e$(3%/\e(B")))
-;;; a
- ("\e$(3"f\e(B" (?2 "\e$(3#8\e(B"))
-;;; b
- ("\e$(3"(\e(B" (?e "\e$(3"#\e(B") (?u "\e$(3"$\e(B") (?i "\e$(3"%\e(B") (?a "\e$(3"&\e(B") (?E "\e$(3"'\e(B") (?o "\e$(3")\e(B")
- (?W "\e$(3%b\e(B" (?e "\e$(3%2\e(B") (?u "\e$(3%b\e(B") (?i "\e$(3%B\e(B") (?a "\e$(3"*\e(B") (?E "\e$(3%R\e(B")))
-;;; c
- ("\e$(3"@\e(B" (?e "\e$(3";\e(B") (?u "\e$(3"<\e(B") (?i "\e$(3"=\e(B") (?a "\e$(3">\e(B") (?E "\e$(3"?\e(B") (?o "\e$(3"A\e(B")
- (?W "\e$(3"B\e(B" (?a "\e$(3"B\e(B")
- (?e "\e$(3"@%n\e(B") (?u "\e$(3"@%r\e(B") (?i "\e$(3"@%o\e(B") (?E "\e$(3"@%q\e(B")))
-;;; d
- ("\e$(3#Z\e(B" (?e "\e$(3#U\e(B") (?u "\e$(3#V\e(B") (?i "\e$(3#W\e(B") (?a "\e$(3#X\e(B") (?E "\e$(3#Y\e(B") (?o "\e$(3#[\e(B")
- (?W "\e$(3#\\e(B" (?a "\e$(3#\\e(B")
- (?e "\e$(3#Z%o\e(B") (?u "\e$(3#Z%r\e(B") (?i "\e$(3#Z%p\e(B") (?E "\e$(3#Z%q\e(B")))
-;;; e
- ("\e$(3"c\e(B" (?2 "\e$(3#5\e(B") (?a "\e$(3"j\e(B"))
-;;; f
- ("\e$(3$T\e(B" (?e "\e$(3$O\e(B") (?u "\e$(3$P\e(B") (?i "\e$(3$Q\e(B") (?a "\e$(3$R\e(B") (?E "\e$(3$S\e(B") (?o "\e$(3$U\e(B")
- (?W "\e$(3%d\e(B" (?e "\e$(3%4\e(B") (?u "\e$(3%d\e(B") (?i "\e$(3%D\e(B") (?a "\e$(3$V\e(B") (?E "\e$(3%T\e(B"))
- (?Y "\e$(3$a\e(B" (?a "\e$(3$a\e(B")))
-;;; g
- ("\e$(3#r\e(B" (?e "\e$(3#m\e(B") (?u "\e$(3#n\e(B") (?i "\e$(3#o\e(B") (?a "\e$(3#p\e(B") (?E "\e$(3#q\e(B") (?o "\e$(3#s\e(B")
- (?W "\e$(3#z\e(B" (?e "\e$(3#u\e(B") (?u "\e$(3#z\e(B") (?i "\e$(3#w\e(B") (?a "\e$(3#x\e(B") (?E "\e$(3#y\e(B"))
- (?2 "\e$(3%^\e(B" (?e "\e$(3%Y\e(B") (?u "\e$(3%Z\e(B") (?i "\e$(3%[\e(B") (?a "\e$(3%\\e(B") (?E "\e$(3%]\e(B") (?o "\e$(3%_\e(B")))
-;;; h
- ("\e$(3!&\e(B" (?e "\e$(3!!\e(B") (?u "\e$(3!"\e(B") (?i "\e$(3!#\e(B") (?a "\e$(3!$\e(B") (?E "\e$(3!%\e(B") (?o "\e$(3!'\e(B")
- (?W "\e$(3"P\e(B" (?e "\e$(3"K\e(B") (?u "\e$(3"P\e(B") (?i "\e$(3"M\e(B") (?a "\e$(3"N\e(B") (?E "\e$(3"O\e(B"))
- (?2 "\e$(3"H\e(B" (?e "\e$(3"C\e(B") (?u "\e$(3"D\e(B") (?i "\e$(3"E\e(B") (?a "\e$(3"F\e(B") (?E "\e$(3"G\e(B") (?o "\e$(3"I\e(B")
- (?W "\e$(3"P\e(B" (?e "\e$(3"K\e(B") (?u "\e$(3"P\e(B") (?i "\e$(3"M\e(B") (?a "\e$(3"N\e(B") (?E "\e$(3"O\e(B"))))
-;;; i
- ("\e$(3"e\e(B" (?2 "\e$(3#7\e(B"))
-;;; j
- ("\e$(3#j\e(B" (?e "\e$(3#e\e(B") (?u "\e$(3#f\e(B") (?i "\e$(3#g\e(B") (?a "\e$(3#h\e(B") (?E "\e$(3#i\e(B") (?o "\e$(3#k\e(B")
- (?W "\e$(3#l\e(B" (?a "\e$(3#l\e(B")
- (?e "\e$(3#j%n\e(B") (?u "\e$(3#j%r\e(B") (?i "\e$(3#j%o\e(B") (?E "\e$(3#j%q\e(B")))
-;;; k
- ("\e$(3"p\e(B" (?e "\e$(3"k\e(B") (?u "\e$(3"l\e(B") (?i "\e$(3"m\e(B") (?a "\e$(3"n\e(B") (?E "\e$(3"o\e(B") (?o "\e$(3"q\e(B")
- (?W "\e$(3"x\e(B" (?e "\e$(3"s\e(B") (?u "\e$(3"x\e(B") (?i "\e$(3"u\e(B") (?a "\e$(3"v\e(B") (?E "\e$(3"w\e(B"))
- (?2 "\e$(3%>\e(B" (?e "\e$(3%9\e(B") (?u "\e$(3%:\e(B") (?i "\e$(3%;\e(B") (?a "\e$(3%<\e(B") (?E "\e$(3%=\e(B") (?o "\e$(3%?\e(B")))
-;;; l
- ("\e$(3!.\e(B" (?e "\e$(3!)\e(B") (?u "\e$(3!*\e(B") (?i "\e$(3!+\e(B") (?a "\e$(3!,\e(B") (?E "\e$(3!-\e(B") (?o "\e$(3!/\e(B")
- (?W "\e$(3!0\e(B" (?a "\e$(3!0\e(B")
- (?e "\e$(3!.%n\e(B") (?u "\e$(3!.%r\e(B") (?i "\e$(3!.%o\e(B") (?E "\e$(3!.%q\e(B")))
-;;; m
- ("\e$(3!>\e(B" (?e "\e$(3!9\e(B") (?u "\e$(3!:\e(B") (?i "\e$(3!;\e(B") (?a "\e$(3!<\e(B") (?E "\e$(3!=\e(B") (?o "\e$(3!?\e(B")
- (?W "\e$(3%a\e(B" (?e "\e$(3%1\e(B") (?u "\e$(3%a\e(B") (?i "\e$(3%A\e(B") (?a "\e$(3!@\e(B") (?E "\e$(3%Q\e(B"))
- (?Y "\e$(3$_\e(B" (?a "\e$(3$_\e(B")))
-;;; n
- ("\e$(3"X\e(B" (?e "\e$(3"S\e(B") (?u "\e$(3"T\e(B") (?i "\e$(3"U\e(B") (?a "\e$(3"V\e(B") (?E "\e$(3"W\e(B") (?o "\e$(3"Y\e(B")
- (?W "\e$(3"Z\e(B" (?a "\e$(3"Z\e(B")
- (?e "\e$(3"X%n\e(B") (?u "\e$(3"X%r\e(B") (?i "\e$(3"X%o\e(B") (?E "\e$(3"X%q\e(B")))
-;;; o
- ("\e$(3"i\e(B" (?2 "\e$(3#;\e(B"))
-;;; p
- ("\e$(3$\\e(B" (?e "\e$(3$W\e(B") (?u "\e$(3$X\e(B") (?i "\e$(3$Y\e(B") (?a "\e$(3$Z\e(B") (?E "\e$(3$[\e(B") (?o "\e$(3$]\e(B")
- (?W "\e$(3%e\e(B" (?e "\e$(3%5\e(B") (?u "\e$(3%e\e(B") (?i "\e$(3%E\e(B") (?a "\e$(3$^\e(B") (?E "\e$(3%U\e(B")))
-;;; q
- ("\e$(3!f\e(B" (?e "\e$(3!a\e(B") (?u "\e$(3!b\e(B") (?i "\e$(3!c\e(B") (?a "\e$(3!d\e(B") (?E "\e$(3!e\e(B") (?o "\e$(3!g\e(B")
- (?W "\e$(3!n\e(B" (?e "\e$(3!i\e(B") (?u "\e$(3!n\e(B") (?i "\e$(3!k\e(B") (?a "\e$(3!l\e(B") (?E "\e$(3!m\e(B"))
- (?2 "\e$(3%.\e(B" (?e "\e$(3%)\e(B") (?u "\e$(3%*\e(B") (?i "\e$(3%+\e(B") (?a "\e$(3%,\e(B") (?E "\e$(3%-\e(B") (?o "\e$(3%/\e(B")))
-;;; r
- ("\e$(3!N\e(B" (?e "\e$(3!I\e(B") (?u "\e$(3!J\e(B") (?i "\e$(3!K\e(B") (?a "\e$(3!L\e(B") (?E "\e$(3!M\e(B") (?o "\e$(3!O\e(B")
- (?W "\e$(3!P\e(B" (?a "\e$(3!P\e(B")
- (?e "\e$(3!N%n\e(B") (?u "\e$(3!N%r\e(B") (?i "\e$(3!N%o\e(B") (?E "\e$(3!N%q\e(B"))
- (?Y "\e$(3$`\e(B" (?a "\e$(3$`\e(B")))
-;;; s
- ("\e$(3!V\e(B" (?e "\e$(3!Q\e(B") (?u "\e$(3!R\e(B") (?i "\e$(3!S\e(B") (?a "\e$(3!T\e(B") (?E "\e$(3!U\e(B") (?o "\e$(3!W\e(B")
- (?W "\e$(3!X\e(B" (?a "\e$(3!X\e(B")
- (?e "\e$(3!V%n\e(B") (?u "\e$(3!V%r\e(B") (?i "\e$(3!V%o\e(B") (?E "\e$(3!V%q\e(B"))
- (?2 "\e$(3!F\e(B" (?e "\e$(3!A\e(B") (?u "\e$(3!B\e(B") (?i "\e$(3!C\e(B") (?a "\e$(3!D\e(B") (?E "\e$(3!E\e(B") (?o "\e$(3!G\e(B")
- (?W "\e$(3!H\e(B" (?a "\e$(3!H\e(B")
- (?e "\e$(3!F%n\e(B") (?u "\e$(3!F%r\e(B") (?i "\e$(3!F%o\e(B") (?E "\e$(3!F%q\e(B"))))
-;;; t
- ("\e$(3"8\e(B" (?e "\e$(3"3\e(B") (?u "\e$(3"4\e(B") (?i "\e$(3"5\e(B") (?a "\e$(3"6\e(B") (?E "\e$(3"7\e(B") (?o "\e$(3"9\e(B")
- (?W "\e$(3":\e(B" (?a "\e$(3":\e(B")
- (?e "\e$(3"8%n\e(B") (?u "\e$(3"8%r\e(B") (?i "\e$(3"8%o\e(B") (?E "\e$(3"8%q\e(B")))
-;;; u
- ("\e$(3"d\e(B" (?2 "\e$(3#6\e(B"))
-;;; v
- ("\e$(3"0\e(B" (?e "\e$(3"+\e(B") (?u "\e$(3",\e(B") (?i "\e$(3"-\e(B") (?a "\e$(3".\e(B") (?E "\e$(3"/\e(B") (?o "\e$(3"1\e(B")
- (?W "\e$(3"2\e(B" (?a "\e$(3"2\e(B")
- (?e "\e$(3"0%n\e(B") (?u "\e$(3"0%r\e(B") (?i "\e$(3"0%o\e(B") (?E "\e$(3"0%q\e(B")))
-;;; w
- ("\e$(3#2\e(B" (?e "\e$(3#-\e(B") (?u "\e$(3#.\e(B") (?i "\e$(3#/\e(B") (?a "\e$(3#0\e(B") (?E "\e$(3#1\e(B") (?o "\e$(3#3\e(B")
- (?W "\e$(3%p\e(B" (?e "\e$(3%n\e(B") (?u "\e$(3%r\e(B") (?i "\e$(3%o\e(B") (?a "\e$(3%p\e(B") (?E "\e$(3%q\e(B")))
-;;; x
- ("\e$(3!^\e(B" (?e "\e$(3!Y\e(B") (?u "\e$(3!Z\e(B") (?i "\e$(3![\e(B") (?a "\e$(3!\\e(B") (?E "\e$(3!]\e(B") (?o "\e$(3!_\e(B")
- (?W "\e$(3!`\e(B" (?a "\e$(3!`\e(B")
- (?e "\e$(3!^%n\e(B") (?u "\e$(3!^%r\e(B") (?i "\e$(3!^%o\e(B") (?E "\e$(3!^%q\e(B")))
-;;; y
- ("\e$(3#R\e(B" (?e "\e$(3#M\e(B") (?u "\e$(3#N\e(B") (?i "\e$(3#O\e(B") (?a "\e$(3#P\e(B") (?E "\e$(3#Q\e(B") (?o "\e$(3#S\e(B")
- (?W "\e$(3#T\e(B" (?a "\e$(3#T\e(B")
- (?e "\e$(3#R%n\e(B") (?u "\e$(3#R%r\e(B") (?i "\e$(3#R%o\e(B") (?E "\e$(3#R%q\e(B")))
-;;; z
- ("\e$(3#B\e(B" (?e "\e$(3#=\e(B") (?u "\e$(3#>\e(B") (?i "\e$(3#?\e(B") (?a "\e$(3#@\e(B") (?E "\e$(3#A\e(B") (?o "\e$(3#C\e(B")
- (?W "\e$(3#D\e(B" (?a "\e$(3#D\e(B")
- (?e "\e$(3#B%n\e(B") (?u "\e$(3#B%r\e(B") (?i "\e$(3#B%o\e(B") (?E "\e$(3#B%q\e(B")))
-;;; { | } ~ DEL
- nil nil nil nil nil
- ])
-
-;; To avoid byte-compiler warnings. It should never be set globally.
-(defvar ethio-sera-being-called-by-w3)
-;; This variable will be bound by some third-party package.
-(defvar sera-being-called-by-w3)
-
;;;###autoload
-(defun ethio-sera-to-fidel-region (beg end &optional secondary force)
- "Convert the characters in region from SERA to FIDEL.
-The variable `ethio-primary-language' specifies the primary language
-and `ethio-secondary-language' specifies the secondary.
+(defun ethio-sera-to-fidel-buffer (&optional secondary force)
+ "Convert the current buffer from SERA to FIDEL.
+
+The variable `ethio-primary-language' specifies the primary
+language and `ethio-secondary-language' specifies the secondary.
-If the 3rd parameter SECONDARY is given and non-nil, assume the region
-begins with the secondary language; otherwise with the primary
-language.
+If the 1st optional argument SECONDARY is non-nil, assume the
+buffer begins with the secondary language; otherwise with the
+primary language.
-If the 4th parameter FORCE is given and non-nil, perform conversion
+If the 2nd optional argument FORCE is non-nil, perform conversion
even if the buffer is read-only.
See also the descriptions of the variables
-`ethio-use-colon-for-colon' and
-`ethio-use-three-dot-question'."
+`ethio-use-colon-for-colon' and `ethio-use-three-dot-question'."
- (interactive "r\nP")
- (save-restriction
- (narrow-to-region beg end)
- (ethio-sera-to-fidel-buffer secondary force)))
+ (interactive "P")
+ (ethio-sera-to-fidel-region (point-min) (point-max) secondary force))
+
+;; To avoid byte-compiler warnings. It should never be set globally.
+(defvar ethio-sera-being-called-by-w3)
+;; This variable will be bound by some third-party package.
+(defvar sera-being-called-by-w3)
;;;###autoload
-(defun ethio-sera-to-fidel-buffer (&optional secondary force)
- "Convert the current buffer from SERA to FIDEL.
+(defun ethio-sera-to-fidel-region (begin end &optional secondary force)
+ "Convert the characters in region from SERA to FIDEL.
The variable `ethio-primary-language' specifies the primary
language and `ethio-secondary-language' specifies the secondary.
-If the 1st optional parameter SECONDARY is non-nil, assume the buffer
-begins with the secondary language; otherwise with the primary
-language.
+If the 3rd argument SECONDARY is given and non-nil, assume the
+region begins with the secondary language; otherwise with the
+primary language.
-If the 2nd optional parametr FORCE is non-nil, perform conversion even if the
-buffer is read-only.
+If the 4th argument FORCE is given and non-nil, perform
+conversion even if the buffer is read-only.
See also the descriptions of the variables
-`ethio-use-colon-for-colon' and
-`ethio-use-three-dot-question'."
-
- (interactive "P")
+`ethio-use-colon-for-colon' and `ethio-use-three-dot-question'."
+ (interactive "r\nP")
(if (and buffer-read-only
(not force)
(not (y-or-n-p "Buffer is read-only. Force to convert? ")))
(let ((ethio-primary-language ethio-primary-language)
(ethio-secondary-language ethio-secondary-language)
- (ethio-use-colon-for-colon ethio-use-colon-for-colon)
- (ethio-use-three-dot-question ethio-use-three-dot-question)
- ;; The above four variables may be changed temporary
- ;; by tilde escapes during conversion. So we bind them to other
- ;; variables but of the same names.
+ ;; The above two variables may be changed temporarily by tilde
+ ;; escapes during conversion. We bind them to the variables
+ ;; of the same names so that the original values are restored
+ ;; when this function exits.
(buffer-read-only nil)
- (case-fold-search nil)
- current-language
- next-language)
+ (lang (if secondary ethio-secondary-language ethio-primary-language))
+ ret)
- (setq current-language
- (if secondary
- ethio-secondary-language
- ethio-primary-language))
+ (ethio-use-colon-for-colon ethio-use-colon-for-colon)
+ (ethio-use-three-dot-question ethio-use-three-dot-question)
- (goto-char (point-min))
-
- (while (not (eobp))
- (setq next-language
- (cond
- ((eq current-language 'english)
- (ethio-sera-to-fidel-english))
- ((eq current-language 'amharic)
- (ethio-sera-to-fidel-ethio 'amharic))
- ((eq current-language 'tigrigna)
- (ethio-sera-to-fidel-ethio 'tigrigna))
- (t ; we don't know what to do
- (ethio-sera-to-fidel-english))))
-
- (setq current-language
- (cond
-
- ;; when language tag is explicitly specified
- ((not (eq next-language 'toggle))
- next-language)
-
- ;; found a toggle in a primary language section
- ((eq current-language ethio-primary-language)
- ethio-secondary-language)
-
- ;; found a toggle in a secondary, third, fourth, ...
- ;; language section
- (t
- ethio-primary-language))))
-
- ;; If ethio-implicit-period-conversion is non-nil, the
- ;; Ethiopic dot "\e$(3%u\e(B" at the end of an Ethiopic sentence is
- ;; replaced with the Ethiopic full stop "\e$(3$i\e(B".
- (if ethio-implicit-period-conversion
- (progn
- (goto-char (point-min))
- (while (re-search-forward "\\([\e$(3!!\e(B-\e$(3$a%)\e(B-\e$(3%e%n\e(B-\e$(3%r%s\e(B]\\)\e$(3%u\e(B\\([ \t]\\)"
- nil t)
- (replace-match "\\1\e$(3$i\e(B\\2"))
- (goto-char (point-min))
- (while (re-search-forward "\\([\e$(3!!\e(B-\e$(3$a%)\e(B-\e$(3%e%n\e(B-\e$(3%r%s\e(B]\\)\e$(3%u\e(B$" nil t)
- (replace-match "\\1\e$(3$i\e(B"))))
-
- ;; gemination
- (goto-char (point-min))
- (while (re-search-forward "\\ce\e$(3%s\e(B" nil 0)
- (compose-region
- (save-excursion (backward-char 2) (point))
- (point)))
- ))
-
-(defun ethio-sera-to-fidel-english nil
- "Handle English section in SERA to FIDEL conversion.
-Conversion stops when a language switch is found. Then delete that
-switch and return the name of the new language as a symbol."
- (let ((new-language nil))
-
- (while (and (not (eobp)) (null new-language))
- (cond
-
- ;; if no more "\", nothing to do.
- ((not (search-forward "\\" nil 0)))
-
- ;; hereafter point is put after a "\".
- ;; first delete that "\", then check the following chars
-
- ;; "\\" : leave the second "\"
- ((progn
- (delete-backward-char 1)
- (= (following-char) ?\\ ))
- (forward-char 1))
-
- ;; "\ " : delete the following " "
- ((= (following-char) 32)
- (delete-char 1)
- (setq new-language 'toggle))
-
- ;; a language flag
- ((setq new-language (ethio-process-language-flag)))
-
- ;; just a "\" : not special sequence.
- (t
- (setq new-language 'toggle))))
+ (save-restriction
+ (narrow-to-region begin end)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (setq ret
+ (cond
+ ((eq lang 'amharic)
+ (ethio-prefer-amharic t)
+ (ethio-sera-to-fidel-region-ethio 'amharic))
+ ((eq lang 'tigrigna)
+ (ethio-prefer-amharic nil)
+ (ethio-sera-to-fidel-region-ethio 'tigrigna))
+ (t
+ (ethio-sera-to-fidel-region-noethio))))
+ (setq lang
+ (if (eq ret 'toggle)
+ (if (eq lang ethio-primary-language)
+ ethio-secondary-language
+ ethio-primary-language)
+ ret)))))
+
+ ;; Restore user's preference.
+ (ethio-adjust-robin))
+
+(defun ethio-sera-to-fidel-region-noethio ()
+ "Return next language as symbol: amharic, tigrigna, toggle or nil."
+ (let (lflag)
+ (cond
- new-language))
+ ;; No more "\", i.e. nothing to do.
+ ((not (search-forward "\\" nil 0))
+ nil)
-(defun ethio-sera-to-fidel-ethio (lang)
- "Handle Ethiopic section in SERA to FIDEL conversion.
-Conversion stops when a language switch is found. Then delete that
-switch and return the name of the new language as a symbol.
+ ;; Hereafter point is put after a "\".
+ ;; First delete that "\", then check the following chars.
-The parameter LANG (symbol, either `amharic' or `tigrigna') affects
-the conversion of \"a\"."
+ ;; A language flag.
+ ((progn (delete-char -1) (setq lflag (ethio-process-language-flag)))
+ lflag)
- (let ((new-language nil)
- (verbatim nil)
- start table table2 ch)
+ ;; "\\" : leave the second "\" and continue in the same language.
+ ((= (following-char) ?\\)
+ (forward-char 1)
+ nil)
- (setcar (aref ethio-sera-to-fidel-table ?a)
- (if (eq lang 'tigrigna) "\e$(3"f\e(B" "\e$(3"c\e(B"))
+ ;; "\ " : delete the following " " and toggle the language.
+ ((= (following-char) 32)
+ (delete-char 1)
+ 'toggle)
- (while (and (not (eobp)) (null new-language))
- (setq ch (following-char))
- (cond
+ ;; A "\" but not a special sequence: simply toggle the language.
+ (t
+ 'toggle))))
- ;; skip from "<" to ">" (or from "&" to ";") if in w3-mode
- ((and (or (= ch ?<) (= ch ?&))
- (or (and (boundp 'ethio-sera-being-called-by-w3)
- ethio-sera-being-called-by-w3)
- (and (boundp 'sera-being-called-by-w3)
- sera-being-called-by-w3)))
- (search-forward (if (= ch ?<) ">" ";")
- nil 0))
-
- ;; leave non-ASCII characters as they are
- ((>= ch 128)
+(defun ethio-sera-to-fidel-region-ethio (lang)
+ "Return next language as symbol: amharic, tigrigna, toggle or nil."
+ (save-restriction
+ (narrow-to-region
+ (point)
+ (if (re-search-forward "\\(`[1-9][0-9]*\\)\\|[\\<&]" nil t)
+ (match-beginning 0)
+ (point-max)))
+ (robin-convert-region (point-min) (point-max) "ethiopic-sera")
+ (goto-char (point-max)))
+
+ (let (lflag)
+ (cond
+ ((= (following-char) ?`)
+ (delete-char 1)
+ (ethio-process-digits)
+ lang)
+
+ ((looking-at "[<&]")
+ (if (or (and (boundp 'ethio-sera-being-called-by-w3)
+ ethio-sera-being-called-by-w3)
+ (and (boundp 'sera-being-called-by-w3)
+ sera-being-called-by-w3))
+ (search-forward (if (= (following-char) ?<) ">" ";") nil 0)
(forward-char 1))
+ lang)
- ;; ethiopic digits
- ((looking-at "`[1-9][0-9]*")
- (delete-char 1)
- (ethio-convert-digit))
+ ((eobp)
+ nil)
- ;; if not seeing a "\", do sera to fidel conversion
- ((/= ch ?\\ )
- (setq start (point))
- (forward-char 1)
- (setq table (aref ethio-sera-to-fidel-table ch))
- (while (setq table2 (cdr (assoc (following-char) table)))
- (setq table table2)
- (forward-char 1))
- (if (setq ch (car table))
- (progn
- (delete-region start (point))
- (if (stringp ch)
- (insert ch)
- (insert (eval ch))))))
+ ;; Now we must be looking at a "\".
+ ;; First delete that "\", then check the following chars.
- ;; if control reaches here, we must be looking at a "\"
+ ((progn (delete-char 1) (= (following-char) 32))
+ (delete-char 1)
+ 'toggle)
- ;; verbatim mode
- (verbatim
- (if (looking-at "\\\\~! ?")
+ ((looking-at "[,.;:'`?\\]+")
+ (goto-char (match-end 0))
+ lang)
- ;; "\~!" or "\~! ". switch to non-verbatim mode
- (progn
- (replace-match "")
- (setq verbatim nil))
+ ((/= (following-char) ?~)
+ 'toggle)
- ;; "\" but not "\~!" nor "\~! ". skip the current "\".
- (forward-char 1)))
+ ;; Now we must be looking at a "~".
- ;; hereafter, non-verbatim mode and looking at a "\"
- ;; first delete that "\", then check the following chars.
+ ((setq lflag (ethio-process-language-flag))
+ lflag)
- ;; "\ " : delete the following " "
- ((progn
- (delete-char 1)
- (setq ch (following-char))
- (= ch 32))
- (delete-char 1)
- (setq new-language 'toggle))
+ ;; Delete the following "~" and check the following chars.
- ;; "\~!" or "\~! " : switch to verbatim mode
- ((looking-at "~! ?")
- (replace-match "")
- (setq verbatim t))
+ ((progn (delete-char 1) (looking-at "! ?"))
+ (replace-match "")
+ (if (re-search-forward "\\\\~! ?" nil 0)
+ (replace-match ""))
+ lang)
- ;; a language flag
- ((setq new-language (ethio-process-language-flag)))
+ ((looking-at "-: ?")
+ (replace-match "")
+ (ethio-use-colon-for-colon t)
+ lang)
- ;; "\~" but not "\~!" nor a language flag
- ((= ch ?~)
- (delete-char 1)
- (ethio-tilde-escape))
+ ((looking-at "`: ?")
+ (replace-match "")
+ (ethio-use-colon-for-colon nil)
+ lang)
- ;; ASCII punctuation escape. skip
- ((looking-at "\\(,\\|\\.\\|;\\|:\\|'\\|`\\|\?\\|\\\\\\)+")
- (goto-char (match-end 0)))
+ ((looking-at "`| ?")
+ (replace-match "")
+ (ethio-use-three-dot-question t)
+ lang)
- ;; "\", but not special sequence
- (t
- (setq new-language 'toggle))))
+ ((looking-at "\\? ?")
+ (replace-match "")
+ (ethio-use-three-dot-question nil)
+ lang)
- new-language))
+ ;; Unknown tilde escape. Recover the deleted chars.
+ (t
+ (insert "\\~")
+ lang))))
(defun ethio-process-language-flag nil
"Process a language flag of the form \"~lang\" or \"~lang1~lang2\".
If looking at \"~lang1~lang2\", set `ethio-primary-language' and
-`ethio-une-secondary-language' based on \"lang1\" and \"lang2\".
+`ethio-secondary-language' based on \"lang1\" and \"lang2\".
Then delete the language flag \"~lang1~lang2\" from the buffer.
Return value is the new primary language.
-If looking at \"~lang\", delete that language flag \"~lang\" from the
-buffer and return that language. In this case
-`ethio-primary-language' and `ethio-uni-secondary-language'
-are left unchanged.
+If looking at \"~lang\", delete that language flag \"~lang\" from
+the buffer and return that language. In this case
+`ethio-primary-language' and `ethio-secondary-language' are left
+unchanged.
If an unsupported language flag is found, just return nil without
changing anything."
;; ~lang1~lang2
((and (looking-at
"~\\([a-z][a-z][a-z]?\\)~\\([a-z][a-z][a-z]?\\)[ \t\n\\]")
- (setq lang1
- (ethio-flag-to-language
- (buffer-substring (match-beginning 1) (match-end 1))))
- (setq lang2
- (ethio-flag-to-language
- (buffer-substring (match-beginning 2) (match-end 2)))))
+ (setq lang1 (ethio-flag-to-language (match-string 1)))
+ (setq lang2 (ethio-flag-to-language (match-string 2))))
(setq ethio-primary-language lang1
ethio-secondary-language lang2)
(delete-region (point) (match-end 2))
;; ~lang
((and (looking-at "~\\([a-z][a-z][a-z]?\\)[ \t\n\\]")
- (setq lang1
- (ethio-flag-to-language
- (buffer-substring (match-beginning 1) (match-end 1)))))
+ (setq lang1 (ethio-flag-to-language (match-string 1))))
(delete-region (point) (match-end 1))
(if (= (following-char) 32)
(delete-char 1))
(t
nil))))
-(defun ethio-tilde-escape nil
- "Handle a SERA tilde escape in Ethiopic section and delete it.
-Delete the escape even it is not recognized."
-
- (let ((p (point)) command)
- (skip-chars-forward "^ \t\n\\\\")
- (setq command (buffer-substring p (point)))
- (delete-region p (point))
- (if (= (following-char) 32)
- (delete-char 1))
-
- (cond
-
- ;; \~-:
- ((string= command "-:")
- (setq ethio-use-colon-for-colon t))
-
- ;; \~`:
- ((string= command "`:")
- (setq ethio-use-colon-for-colon nil))
-
- ;; \~?
- ((string= command "?")
- (setq ethio-use-three-dot-question nil))
-
- ;; \~`|
- ((string= command "`|")
- (setq ethio-use-three-dot-question t))
-
- ;; \~e
- ((string= command "e")
- (insert "\e$(3%j\e(B"))
-
- ;; \~E
- ((string= command "E")
- (insert "\e$(3%k\e(B"))
-
- ;; \~a
- ((string= command "a")
- (insert "\e$(3%l\e(B"))
-
- ;; \~A
- ((string= command "A")
- (insert "\e$(3%m\e(B"))
-
- ;; \~X
- ((string= command "X")
- (insert "\e$(3%i\e(B"))
-
- ;; unsupported tilde escape
- (t
- nil))))
-
(defun ethio-flag-to-language (flag)
(cond
((or (string= flag "en") (string= flag "eng")) 'english)
((or (string= flag "am") (string= flag "amh")) 'amharic)
(t nil)))
-(defun ethio-convert-digit nil
+(defun ethio-process-digits nil
"Convert Arabic digits to Ethiopic digits."
(let (ch z)
(while (and (>= (setq ch (following-char)) ?1)
;; first digit is 10, 20, ..., or 90
((= (mod z 2) 1)
- (insert (aref [?\e$(3$y\e(B ?\e$(3$z\e(B ?\e$(3${\e(B ?\e$(3$|\e(B ?\e$(3$}\e(B ?\e$(3$~\e(B ?\e$(3%!\e(B ?\e$(3%"\e(B ?\e$(3%#\e(B] (- ch ?1)))
+ (insert (aref [?á² ?á³ ?á´ ?áµ ?ᶠ?á· ?Ḡ?á¹ ?áº] (- ch ?1)))
(setq z (1- z)))
;; first digit is 2, 3, ..., or 9
((/= ch ?1)
- (insert (aref [?\e$(3$q\e(B ?\e$(3$r\e(B ?\e$(3$s\e(B ?\e$(3$t\e(B ?\e$(3$u\e(B ?\e$(3$v\e(B ?\e$(3$w\e(B ?\e$(3$x\e(B] (- ch ?2))))
+ (insert (aref [?᪠?á« ?ᬠ?á ?á® ?ᯠ?á° ?á±] (- ch ?2))))
;; single 1
((= z 0)
- (insert "\e$(3$p\e(B")))
+ (insert "á©")))
;; 100
(if (= (mod z 4) 2)
- (insert "\e$(3%$\e(B"))
+ (insert "á»"))
;; 10000
- (insert-char ?\e$(3%%\e(B (/ z 4)))))
-
-;;;###autoload
-(defun ethio-sera-to-fidel-mail-or-marker (&optional arg)
- "Execute `ethio-sera-to-fidel-mail' or `ethio-sera-to-fidel-marker' depending on the current major mode.
-If in rmail-mode or in mail-mode, execute the former; otherwise latter."
-
- (interactive "P")
- (if (or (eq major-mode 'rmail-mode)
- (eq major-mode 'mail-mode))
- (ethio-sera-to-fidel-mail (prefix-numeric-value arg))
- (ethio-sera-to-fidel-marker arg)))
-
-;;;###autoload
-(defun ethio-sera-to-fidel-mail (&optional arg)
- "Convert SERA to FIDEL to read/write mail and news.
-
-If the buffer contains the markers \"<sera>\" and \"</sera>\",
-convert the segments between them into FIDEL.
-
-If invoked interactively and there is no marker, convert the subject field
-and the body into FIDEL using `ethio-sera-to-fidel-region'."
-
- (interactive "p")
- (let ((buffer-read-only nil)
- border)
- (save-excursion
-
- ;; follow RFC822 rules instead of looking for a fixed separator
- (rfc822-goto-eoh)
- (forward-line 1)
- (setq border (point))
-
- ;; note that the point is placed at the border
- (if (or (re-search-forward "^<sera>$" nil t)
- (progn
- (goto-char (point-min))
- (re-search-forward "^Subject: <sera>" border t)))
-
- ;; there are markers
- (progn
- ;; we start with the body so that the border will not change
- ;; use "^<sera>\n" instead of "^<sera>$" not to leave a blank line
- (goto-char border)
- (while (re-search-forward "^<sera>\n" nil t)
- (replace-match "")
- (ethio-sera-to-fidel-region
- (point)
- (progn
- (if (re-search-forward "^</sera>\n" nil 0)
- (replace-match ""))
- (point))))
- ;; now process the subject
- (goto-char (point-min))
- (if (re-search-forward "^Subject: <sera>" border t)
- (ethio-sera-to-fidel-region
- (progn (delete-backward-char 6) (point))
- (progn
- (if (re-search-forward "</sera>$" (line-end-position) 0)
- (replace-match ""))
- (point)))))
-
- ;; in case there are no marks but invoked interactively
- (if arg
- (progn
- (ethio-sera-to-fidel-region border (point-max))
- (goto-char (point-min))
- (if (re-search-forward "^Subject: " border t)
- (ethio-sera-to-fidel-region (point) (line-end-position))))))
-
- ;; adjust the rmail marker
- (if (eq major-mode 'rmail-mode)
- (set-marker
- (aref rmail-message-vector (1+ rmail-current-message))
- (point-max))))))
+ (insert-char ?á¼ (/ z 4)))))
;;;###autoload
(defun ethio-sera-to-fidel-marker (&optional force)
(error ""))
(save-excursion
(goto-char (point-min))
- (while (re-search-forward "<sera>" nil t)
+ (while (search-forward "<sera>" nil t)
(ethio-sera-to-fidel-region
(point)
- (if (re-search-forward "</sera>" nil t)
+ (if (search-forward "</sera>" nil t)
(match-beginning 0)
(point-max))
nil
;; FIDEL to SERA
;;
-(defconst ethio-fidel-to-sera-map
- [ "he" "hu" "hi" "ha" "hE" "h" "ho" "" ;; 0 - 7
- "le" "lu" "li" "la" "lE" "l" "lo" "lWa" ;; 8
- "He" "Hu" "Hi" "Ha" "HE" "H" "Ho" "HWa" ;; 16
- "me" "mu" "mi" "ma" "mE" "m" "mo" "mWa" ;; 24
- "`se" "`su" "`si" "`sa" "`sE" "`s" "`so" "`sWa" ;; 32
- "re" "ru" "ri" "ra" "rE" "r" "ro" "rWa" ;; 40
- "se" "su" "si" "sa" "sE" "s" "so" "sWa" ;; 48
- "xe" "xu" "xi" "xa" "xE" "x" "xo" "xWa" ;; 56
- "qe" "qu" "qi" "qa" "qE" "q" "qo" "" ;; 64
- "qWe" "" "qWi" "qWa" "qWE" "qW'" "" "" ;; 72
- "Qe" "Qu" "Qi" "Qa" "QE" "Q" "Qo" "" ;; 80
- "QWe" "" "QWi" "QWa" "QWE" "QW'" "" "" ;; 88
- "be" "bu" "bi" "ba" "bE" "b" "bo" "bWa" ;; 96
- "ve" "vu" "vi" "va" "vE" "v" "vo" "vWa" ;; 104
- "te" "tu" "ti" "ta" "tE" "t" "to" "tWa" ;; 112
- "ce" "cu" "ci" "ca" "cE" "c" "co" "cWa" ;; 120
- "`he" "`hu" "`hi" "`ha" "`hE" "`h" "`ho" "" ;; 128
- "hWe" "" "hWi" "hWa" "hWE" "hW'" "" "" ;; 136
- "ne" "nu" "ni" "na" "nE" "n" "no" "nWa" ;; 144
- "Ne" "Nu" "Ni" "Na" "NE" "N" "No" "NWa" ;; 152
- "e" "u" "i" "A" "E" "I" "o" "ea" ;; 160
- "ke" "ku" "ki" "ka" "kE" "k" "ko" "" ;; 168
- "kWe" "" "kWi" "kWa" "kWE" "kW'" "" "" ;; 176
- "Ke" "Ku" "Ki" "Ka" "KE" "K" "Ko" "" ;; 184
- "KWe" "" "KWi" "KWa" "KWE" "KW'" "" "" ;; 192
- "we" "wu" "wi" "wa" "wE" "w" "wo" "" ;; 200
- "`e" "`u" "`i" "`a" "`E" "`I" "`o" "" ;; 208
- "ze" "zu" "zi" "za" "zE" "z" "zo" "zWa" ;; 216
- "Ze" "Zu" "Zi" "Za" "ZE" "Z" "Zo" "ZWa" ;; 224
- "ye" "yu" "yi" "ya" "yE" "y" "yo" "yWa" ;; 232
- "de" "du" "di" "da" "dE" "d" "do" "dWa" ;; 240
- "De" "Du" "Di" "Da" "DE" "D" "Do" "DWa" ;; 248
- "je" "ju" "ji" "ja" "jE" "j" "jo" "jWa" ;; 256
- "ge" "gu" "gi" "ga" "gE" "g" "go" "" ;; 264
- "gWe" "" "gWi" "gWa" "gWE" "gW'" "" "" ;; 272
- "Ge" "Gu" "Gi" "Ga" "GE" "G" "Go" "GWa" ;; 280
- "Te" "Tu" "Ti" "Ta" "TE" "T" "To" "TWa" ;; 288
- "Ce" "Cu" "Ci" "Ca" "CE" "C" "Co" "CWa" ;; 296
- "Pe" "Pu" "Pi" "Pa" "PE" "P" "Po" "PWa" ;; 304
- "Se" "Su" "Si" "Sa" "SE" "S" "So" "SWa" ;; 312
- "`Se" "`Su" "`Si" "`Sa" "`SE" "`S" "`So" "" ;; 320
- "fe" "fu" "fi" "fa" "fE" "f" "fo" "fWa" ;; 328
- "pe" "pu" "pi" "pa" "pE" "p" "po" "pWa" ;; 336
- "mYa" "rYa" "fYa" "" "" "" "" "" ;; 344
- " " " : " "::" "," ";" "-:" ":-" "`?" ;; 352
- ":|:" "1" "2" "3" "4" "5" "6" "7" ;; 360
- "8" "9" "10" "20" "30" "40" "50" "60" ;; 368
- "70" "80" "90" "100" "10000" "" "" "" ;; 376
- "`qe" "`qu" "`qi" "`qa" "`qE" "`q" "`qo" "" ;; 384
- "mWe" "bWe" "GWe" "fWe" "pWe" "" "" "" ;; 392
- "`ke" "`ku" "`ki" "`ka" "`kE" "`k" "`ko" "" ;; 400
- "mWi" "bWi" "GWi" "fWi" "pWi" "" "" "" ;; 408
- "Xe" "Xu" "Xi" "Xa" "XE" "X" "Xo" "" ;; 416
- "mWE" "bWE" "GWE" "fWE" "pWE" "" "" "" ;; 424
- "`ge" "`gu" "`gi" "`ga" "`gE" "`g" "`go" "" ;; 432
- "mW'" "bW'" "GW'" "fW'" "pW'" "" "" "" ;; 440
- "\\~X " "\\~e " "\\~E " "\\~a " "\\~A " "wWe" "wWi" "wWa" ;; 448
- "wWE" "wW'" "''" "`!" "." "<<" ">>" "?" ]) ;; 456
-
-(defun ethio-prefer-amharic-p nil
- (or (eq ethio-primary-language 'amharic)
- (and (not (eq ethio-primary-language 'tigrigna))
- (eq ethio-secondary-language 'amharic))))
-
(defun ethio-language-to-flag (lang)
(cond
((eq lang 'english) "eng")
(t "")))
;;;###autoload
-(defun ethio-fidel-to-sera-region (begin end &optional secondary force)
- "Replace all the FIDEL characters in the region to the SERA format.
+(defun ethio-fidel-to-sera-buffer (&optional secondary force)
+ "Replace all the FIDEL characters in the current buffer to the SERA format.
The variable `ethio-primary-language' specifies the primary
language and `ethio-secondary-language' specifies the secondary.
-If the 3dr parameter SECONDARY is given and non-nil, try to convert
-the region so that it begins in the secondary language; otherwise with
-the primary language.
+If the 1st optional argument SECONDARY is non-nil, try to convert the
+region so that it begins with the secondary language; otherwise with the
+primary language.
-If the 4th parameter FORCE is given and non-nil, convert even if the
+If the 2nd optional argument FORCE is non-nil, convert even if the
buffer is read-only.
See also the descriptions of the variables
`ethio-use-colon-for-colon', `ethio-use-three-dot-question',
`ethio-quote-vowel-always' and `ethio-numeric-reduction'."
- (interactive "r\nP")
- (save-restriction
- (narrow-to-region begin end)
- (ethio-fidel-to-sera-buffer secondary force)))
+ (interactive "P")
+ (ethio-fidel-to-sera-region (point-min) (point-max) secondary force))
;;;###autoload
-(defun ethio-fidel-to-sera-buffer (&optional secondary force)
- "Replace all the FIDEL characters in the current buffer to the SERA format.
+(defun ethio-fidel-to-sera-region (begin end &optional secondary force)
+ "Replace all the FIDEL characters in the region to the SERA format.
+
The variable `ethio-primary-language' specifies the primary
language and `ethio-secondary-language' specifies the secondary.
-If the 1st optional parameter SECONDARY is non-nil, try to convert the
-region so that it begins in the secondary language; otherwise with the
-primary language.
+If the 3rd argument SECONDARY is given and non-nil, convert
+the region so that it begins with the secondary language; otherwise with
+the primary language.
-If the 2nd optional parameter FORCE is non-nil, convert even if the
+If the 4th argument FORCE is given and non-nil, convert even if the
buffer is read-only.
See also the descriptions of the variables
`ethio-use-colon-for-colon', `ethio-use-three-dot-question',
`ethio-quote-vowel-always' and `ethio-numeric-reduction'."
- (interactive "P")
+ (interactive "r\nP")
(if (and buffer-read-only
(not force)
(not (y-or-n-p "Buffer is read-only. Force to convert? ")))
(error ""))
- (let ((buffer-read-only nil)
- (case-fold-search nil)
- (lonec nil) ;; t means previous char was a lone consonant
- (fidel nil) ;; t means previous char was a FIDEL
- (digit nil) ;; t means previous char was an Ethiopic digit
- (flag (if (ethio-prefer-amharic-p) "\\~amh " "\\~tir "))
- mode ch)
-
- ;; user's preference in transcription
- (if ethio-use-colon-for-colon
- (progn
- (aset ethio-fidel-to-sera-map 353 "`:")
- (aset ethio-fidel-to-sera-map 357 ":"))
- (aset ethio-fidel-to-sera-map 353 " : ")
- (aset ethio-fidel-to-sera-map 357 "-:"))
-
- (if ethio-use-three-dot-question
- (progn
- (aset ethio-fidel-to-sera-map 359 "?")
- (aset ethio-fidel-to-sera-map 463 "`?"))
- (aset ethio-fidel-to-sera-map 359 "`?")
- (aset ethio-fidel-to-sera-map 463 "?"))
-
- (mapc
- '(lambda (x)
- (aset (aref ethio-fidel-to-sera-map x)
- 2
- (if ethio-W-sixth-always ?' ?u)))
- '(77 93 141 181 197 277 440 441 442 443 444 457))
-
- (if (ethio-prefer-amharic-p)
- (aset ethio-fidel-to-sera-map 160 "a")
- (aset ethio-fidel-to-sera-map 160 "e"))
- ;; end of user's preference
-
- ;; first, decompose geminated characters
- (decompose-region (point-min) (point-max))
-
- ;; main conversion routine
- (goto-char (point-min))
- (while (not (eobp))
- (setq ch (following-char))
-
- (cond ; ethiopic, english, neutral
-
- ;; ethiopic character. must go to ethiopic mode, if not in it.
- ((eq (char-charset ch) 'ethiopic)
- (setq ch (ethio-char-to-ethiocode ch))
- (delete-char 1)
- (if (not (eq mode 'ethiopic))
- (progn
- (insert flag)
- (setq mode 'ethiopic)))
-
- (cond ; fidel, punc, digit
-
- ;; fidels
- ((or (<= ch 346) ; he - fYa
- (and (>= ch 384) (<= ch 444)) ; `qe - pw
- (and (>= ch 453) (<= ch 457))) ; wWe - wW
- (if (and (memq ch '(160 161 162 163 164 166 167)) ; (e - ea)
- (or lonec
- (and ethio-quote-vowel-always
- fidel)))
- (insert "'"))
- (insert (aref ethio-fidel-to-sera-map ch))
- (setq lonec (ethio-lone-consonant-p ch)
- fidel t
- digit nil))
-
- ;; punctuations or icons
- ((or (and (>= ch 353) (<= ch 360)) ; : - :|:
- (>= ch 458) ; '' - ?
- (and (>= ch 448) (<= ch 452))) ; \~X \~e \~E \~a \~A
- (insert (aref ethio-fidel-to-sera-map ch))
- (setq lonec nil
- fidel nil
- digit nil))
-
- ;; now CH must be an ethiopic digit
-
- ;; reduction = 0 or not preceded by Ethiopic number(s)
- ((or (= ethio-numeric-reduction 0)
- (not digit))
- (insert "`" (aref ethio-fidel-to-sera-map ch))
- (setq lonec nil
- fidel nil
- digit t))
-
- ;; reduction = 2 and following 10s, 100s, 10000s
- ((and (= ethio-numeric-reduction 2)
- (memq ch '(370 379 380)))
- (insert (substring (aref ethio-fidel-to-sera-map ch) 1))
- (setq lonec nil
- fidel nil
- digit t))
-
- ;; ordinary following digits
- (t
- (insert (aref ethio-fidel-to-sera-map ch))
- (setq lonec nil
- fidel nil
- digit t))))
-
- ;; english character. must go to english mode, if not in it.
- ((or (and (>= ch ?a) (<= ch ?z))
- (and (>= ch ?A) (<= ch ?Z)))
- (if (not (eq mode 'english))
- (insert "\\~eng "))
- (forward-char 1)
- (setq mode 'english
- lonec nil
- fidel nil
- digit nil))
+ (save-restriction
+ (narrow-to-region begin end)
- ;; ch can appear both in ethiopic section and in english section.
- (t
+ (let ((buffer-read-only nil)
+ (mode (if secondary
+ ethio-secondary-language
+ ethio-primary-language))
+ (flag (if (ethio-prefer-amharic-p) "\\~amh " "\\~tir "))
+ p ch)
- ;; we must decide the mode, if not decided yet
- (if (null mode)
+ (goto-char (point-min))
+ (ethio-adjust-robin)
+ (unless (eq mode 'english)
+ (setq mode 'ethiopic))
+ (if (and (eq mode 'english) (looking-at "\\ce"))
+ (setq mode 'ethiopic))
+ (if (and (eq mode 'ethiopic) (looking-at "\\Ce"))
+ (setq mode 'english))
+ (insert (if (eq mode 'english) "\\~eng " flag))
+
+ (while (not (eobp))
+
+ (if (eq mode 'english)
(progn
- (setq mode
- (if secondary
- ethio-secondary-language
- ethio-primary-language))
- (if (eq mode 'english)
- (insert "\\~eng ")
+ (if (re-search-forward "\\(\\ce\\|\\\\\\)" nil 0)
+ (forward-char -1))
+ (cond
+ ((eq (following-char) ?\\)
+ (insert "\\")
+ (forward-char 1))
+ ((looking-at "\\ce")
(insert flag)
- (setq mode 'ethiopic)))) ; tigrigna & amharic --> ethiopic
-
- (cond ; \ , eng-mode , punc , w3 , other
+ (setq mode 'ethiopic))))
- ;; backslash is always quoted
- ((= ch ?\\ )
- (insert "\\")
- (forward-char 1))
+ ;; If we reach here, mode is ethiopic.
+ (setq p (point))
+ (if (re-search-forward "[a-z,.;:'`?\\<&]" nil 0)
+ (forward-char -1))
+ (save-restriction
+ (narrow-to-region p (point))
+ (robin-invert-region (point-min) (point-max) "ethiopic-sera")
- ;; nothing to do if in english mode
- ((eq mode 'english)
- (forward-char 1))
-
- ;; now we must be in ethiopic mode and seeing a non-"\"
-
- ;; ascii punctuations in ethiopic mode
- ((looking-at "[,.;:'`?]+")
- (insert "\\")
- (goto-char (1+ (match-end 0)))) ; because we inserted one byte (\)
-
- ;; skip from "<" to ">" (or from "&" to ";") if called from w3
- ((and (or (= ch ?<) (= ch ?&))
- (or (and (boundp 'ethio-sera-being-called-by-w3)
- ethio-sera-being-called-by-w3)
- (and (boundp 'sera-being-called-by-w3)
- sera-being-called-by-w3)))
- (search-forward (if (= ch ?<) ">" ";")
- nil 0))
-
- ;; neutral character. no need to quote. just skip it.
- (t
- (forward-char 1)))
-
- (setq lonec nil
- fidel nil
- digit nil)))
- ;; end of main conversion routine
- )))
-
-(defun ethio-lone-consonant-p (ethiocode)
- "If ETHIOCODE is an Ethiopic lone consonant, return t."
- (or (and (< ethiocode 344) (= (% ethiocode 8) 5))
-
- ;; `q `k X `g mW bW GW fW pW wW
- (memq ethiocode '(389 405 421 437 440 441 442 443 444 457))))
-
-;;;###autoload
-(defun ethio-fidel-to-sera-mail-or-marker (&optional arg)
- "Execute `ethio-fidel-to-sera-mail' or `ethio-fidel-to-sera-marker' depending on the current major mode.
-If in rmail-mode or in mail-mode, execute the former; otherwise latter."
-
- (interactive "P")
- (if (or (eq major-mode 'rmail-mode)
- (eq major-mode 'mail-mode))
- (ethio-fidel-to-sera-mail)
- (ethio-fidel-to-sera-marker arg)))
-
-;;;###autoload
-(defun ethio-fidel-to-sera-mail nil
- "Convert FIDEL to SERA to read/write mail and news.
-
-If the body contains at least one Ethiopic character,
- 1) insert the string \"<sera>\" at the beginning of the body,
- 2) insert \"</sera>\" at the end of the body, and
- 3) convert the body into SERA.
-
-The very same procedure applies to the subject field, too."
-
- (interactive)
- (let ((buffer-read-only nil)
- border)
- (save-excursion
-
- ;; follow RFC822 rules instead of looking for a fixed separator
- (rfc822-goto-eoh)
- (forward-line 1)
- (setq border (point))
-
- ;; process body first not to change the border
- ;; note that the point is already at the border
- (if (re-search-forward "\\ce" nil t)
- (progn
- (ethio-fidel-to-sera-region border (point-max))
- (goto-char border)
- (insert "<sera>")
- (goto-char (point-max))
- (insert "</sera>")))
+ ;; ethio-quote-vowel-alwyas
+ (goto-char (point-min))
+ (while (re-search-forward "'[eauio]" nil t)
+ (save-excursion
+ (forward-char -2)
+ (setq ch (preceding-char))
+ (if (or (and (>= ch ?a) (<= ch ?z))
+ (and (>= ch ?A) (<= ch ?Z)))
+ (if (and (not ethio-quote-vowel-always)
+ (memq ch '(?e ?a ?u ?i ?o ?E ?A ?I)))
+ (delete-char 1))
+ (delete-char 1))))
+
+ ;; ethio-W-sixth-always
+ (unless ethio-W-sixth-always
+ (goto-char (point-min))
+ (while (search-forward "W'" nil t)
+ (delete-char -1)
+ (insert "u")))
- ;; process subject
- (goto-char (point-min))
- (if (re-search-forward "^Subject: " border t)
- (let ((beg (point))
- (end (line-end-position)))
- (if (re-search-forward "\\ce" end t)
- (progn
- (ethio-fidel-to-sera-region beg end)
- (goto-char beg)
- (insert "<sera>")
- (end-of-line)
- (insert "</sera>")))))
-
- ;; adjust the rmail marker
- (if (eq major-mode 'rmail-mode)
- (set-marker
- (aref rmail-message-vector (1+ rmail-current-message))
- (point-max))))))
+ ;; ethio-numeric-reduction
+ (when (> ethio-numeric-reduction 0)
+ (goto-char (point-min))
+ (while (re-search-forward "\\([0-9]\\)`\\([0-9]\\)" nil t)
+ (replace-match "\\1\\2")
+ (forward-char -1)))
+ (when (= ethio-numeric-reduction 2)
+ (goto-char (point-min))
+ (while (re-search-forward "\\([0-9]\\)1\\(0+\\)" nil t)
+ (replace-match "\\1\\2")))
+
+ (goto-char (point-max)))
+
+ (cond
+ ((looking-at "[a-z]")
+ (insert"\\~eng ")
+ (setq mode 'english))
+ ((looking-at "[,.;:'`\\]+")
+ (insert "\\")
+ (goto-char (1+ (match-end 0))))
+ ((= (following-char) ??)
+ (if ethio-use-three-dot-question
+ (insert "\\"))
+ (forward-char 1))
+ ((looking-at "[<&]")
+ (if (or (and (boundp 'ethio-sera-being-called-by-w3)
+ ethio-sera-being-called-by-w3)
+ (and (boundp 'sera-being-called-by-w3)
+ sera-being-called-by-w3))
+ (search-forward (if (= (following-char) ?<) ">" "&") nil 0)
+ (forward-char 1)))))))))
;;;###autoload
(defun ethio-fidel-to-sera-marker (&optional force)
(error ""))
(save-excursion
(goto-char (point-min))
- (while (re-search-forward "<sera>" nil t)
+ (while (search-forward "<sera>" nil t)
(ethio-fidel-to-sera-region
(point)
- (if (re-search-forward "</sera>" nil t)
+ (if (search-forward "</sera>" nil t)
(match-beginning 0)
(point-max))
nil
(defun ethio-modify-vowel nil
"Modify the vowel of the FIDEL that is under the cursor."
(interactive)
- (let ((ch (following-char))
- (composite nil) ; geminated or not
- newch base vowel modulo)
-
- (cond
- ;; in case of gemination
- ((eq (char-charset ch) 'composition)
- (setq ch (string-to-char (char-to-string ch))
- composite t))
- ;; neither gemination nor fidel
- ((not (eq (char-charset ch) 'ethiopic))
- (error "Not a valid character")))
-
- ;; set frequently referred character features
- (setq ch (ethio-char-to-ethiocode ch)
- base (* (/ ch 8) 8)
- modulo (% ch 8))
-
- (if (or (and (>= ch 344) (<= ch 380)) ;; mYa - `10000
- (and (>= ch 448) (<= ch 452)) ;; \~X - \~A
- (>= ch 458)) ;; private punctuations
- (error "Not a valid character"))
-
- (setq
- newch
- (cond
-
- ;; first standalone vowels
- ((= base 160)
- (if (ethio-prefer-amharic-p)
- (message "Modify vowel to: [auiAEIoW\"] ")
- (message "Modify vowel to: [euiAEIoW\"] "))
- (setq vowel (read-char))
- (cond
- ((= vowel ?e) 160)
- ((= vowel ?u) 161)
- ((= vowel ?i) 162)
- ((= vowel ?A) 163)
- ((= vowel ?E) 164)
- ((= vowel ?I) 165)
- ((= vowel ?o) 166)
- ((= vowel ?W) 167)
- ((= vowel ?a) (if (ethio-prefer-amharic-p) 160 163))
- ((= vowel ?\") (setq composite t) ch)
- (t nil)))
-
- ;; second standalone vowels
- ((= base 208)
- (message "Modify vowel to: [euiaEIo\"] ")
- (setq vowel (read-char))
- (cond
- ((= vowel ?e) 208)
- ((= vowel ?u) 209)
- ((= vowel ?i) 210)
- ((= vowel ?a) 211)
- ((= vowel ?E) 212)
- ((= vowel ?I) 213)
- ((= vowel ?o) 214)
- ((= vowel ?\") (setq composite t) ch)
- (t nil)))
-
- ;; 12-form consonants, *W* form
- ((memq base '(72 88 136 176 192 272)) ; qW QW hW kW KW gW
- (message "Modify vowel to: [euiaE'\"] ")
- (setq vowel (read-char))
- (cond
- ((= vowel ?e) base)
- ((= vowel ?u) (+ base 5))
- ((= vowel ?i) (+ base 2))
- ((= vowel ?a) (+ base 3))
- ((= vowel ?E) (+ base 4))
- ((= vowel ?') (+ base 5))
- ((= vowel ?\") (setq composite t) ch)
- (t nil)))
-
- ;; extended 12-form consonants, mWa bWa GWa fWa pWa
- ((= ch 31) ; mWa
- (message "Modify vowel to: [euiaE'\"] ")
- (setq vowel (read-char))
- (cond
- ((= vowel ?e) 392)
- ((= vowel ?u) 440)
- ((= vowel ?i) 408)
- ((= vowel ?a) ch)
- ((= vowel ?E) 424)
- ((= vowel ?') 440)
- ((= vowel ?\") (setq composite t) ch)
- (t nil)))
- ((= ch 103) ; bWa
- (message "Modify vowel to: [euiaE'\"] ")
- (setq vowel (read-char))
- (cond
- ((= vowel ?e) 393)
- ((= vowel ?u) 441)
- ((= vowel ?i) 409)
- ((= vowel ?a) ch)
- ((= vowel ?E) 425)
- ((= vowel ?') 441)
- ((= vowel ?\") (setq composite t) ch)
- (t nil)))
- ((= ch 287) ; GWa
- (message "Modify vowel to: [euiaE'\"] ")
- (setq vowel (read-char))
- (cond
- ((= vowel ?e) 394)
- ((= vowel ?u) 442)
- ((= vowel ?i) 410)
- ((= vowel ?a) ch)
- ((= vowel ?E) 426)
- ((= vowel ?') 442)
- ((= vowel ?\") (setq composite t) ch)
- (t nil)))
- ((= ch 335) ; fWa
- (message "Modify vowel to: [euiaE'\"] ")
- (setq vowel (read-char))
- (cond
- ((= vowel ?e) 395)
- ((= vowel ?u) 443)
- ((= vowel ?i) 411)
- ((= vowel ?a) ch)
- ((= vowel ?E) 427)
- ((= vowel ?') 443)
- ((= vowel ?\") (setq composite t) ch)
- (t nil)))
- ((= ch 343) ; pWa
- (message "Modify vowel to: [euiaE'\"] ")
- (setq vowel (read-char))
- (cond
- ((= vowel ?e) 396)
- ((= vowel ?u) 444)
- ((= vowel ?i) 412)
- ((= vowel ?a) ch)
- ((= vowel ?E) 428)
- ((= vowel ?') 444)
- ((= vowel ?\") (setq composite t) ch)
- (t nil)))
-
- ;; extended 12-form consonatns, mW* bW* GW* fW* pW*
- ((memq base '(392 408 424 440)) ; *We *Wi *WE *W
- (message "Modify vowel to: [eiEau'\"] ")
- (setq vowel (read-char))
- (cond
- ((= vowel ?e) (+ 392 modulo))
- ((= vowel ?i) (+ 408 modulo))
- ((= vowel ?E) (+ 424 modulo))
- ((= vowel ?a) (cond
- ((= modulo 0) 31) ; mWa
- ((= modulo 1) 103) ; bWa
- ((= modulo 2) 287) ; GWa
- ((= modulo 3) 335) ; fWa
- ((= modulo 4) 343) ; pWa
- (t nil))) ; never reach here
- ((= vowel ?') (+ 440 modulo))
- ((= vowel ?u) (+ 440 modulo))
- ((= vowel ?\") (setq composite t) ch)
- (t nil)))
-
- ((and (>= ch 453) (<= ch 457)) ; wWe wWi wWa wWE wW
- (message "Modify vowel to: [eiaE'u\"] ")
- (setq vowel (read-char))
- (cond
- ((= vowel ?e) 453)
- ((= vowel ?i) 454)
- ((= vowel ?a) 455)
- ((= vowel ?E) 456)
- ((= vowel ?') 457)
- ((= vowel ?u) 457)
- ((= vowel ?\") (setq composite t) ch)
- (t nil)))
-
- ;; 7-form consonants, or
- ;; first 7 of 8-form consonants
- ((<= modulo 6)
- (message "Modify vowel to: [euiaE'o\"] ")
- (setq vowel (read-char))
- (cond
- ((= vowel ?e) base)
- ((= vowel ?u) (+ base 1))
- ((= vowel ?i) (+ base 2))
- ((= vowel ?a) (+ base 3))
- ((= vowel ?E) (+ base 4))
- ((= vowel ?') (+ base 5))
- ((= vowel ?o) (+ base 6))
- ((= vowel ?\") (setq composite t) ch)
- (t nil)))
-
- ;; otherwise
- (t
- nil)))
-
- (cond
-
- ;; could not get new character
- ((null newch)
- (error "Invalid vowel"))
-
- ;; vowel changed on a composite Fidel
- (composite
+ (ethio-adjust-robin)
+ (let ((consonant (ethio-get-consonant (following-char)))
+ vowel)
+ (if (null consonant)
+ (error "") ; not an Ethiopic char
+ (setq vowel (read-char "Modify vowel to: "))
(delete-char 1)
- (insert
- (compose-string
- (concat (char-to-string (ethio-ethiocode-to-char newch)) "\e$(3%s\e(B"))))
-
- ;; simple vowel modification
- (t
- (delete-char 1)
- (insert (ethio-ethiocode-to-char newch))))))
-
-(defun ethio-ethiocode-to-char (ethiocode)
- (make-char
- 'ethiopic
- (+ (/ ethiocode 94) 33)
- (+ (mod ethiocode 94) 33)))
-
-(defun ethio-char-to-ethiocode (ch)
- (and (eq (char-charset ch) 'ethiopic)
- (let ((char-components (split-char ch)))
- (+ (* (- (nth 1 char-components) 33) 94)
- (- (nth 2 char-components) 33)))))
+ (if (and (string= consonant "'") (= vowel ?W))
+ (insert ?ኧ)
+ (save-restriction
+ (narrow-to-region (point) (point))
+ (insert consonant vowel)
+ (robin-convert-region (point-min) (point-max) "ethiopic-sera"))))))
+
+(defun ethio-get-consonant (ch)
+ "Return the consonant part of CH's SERA spelling in ethiopic-sera."
+ (let ((sera (get-char-code-property ch 'ethiopic-sera)))
+ (cond
+ ((null sera) nil)
+ ((= ch ?ኧ) "'") ; Only this has two vowel letters.
+ (t (with-temp-buffer
+ (insert sera)
+ (if (memq (preceding-char) '(?e ?u ?i ?a ?o ?E ?I ?A ?'))
+ (delete-char -1))
+ (buffer-substring (point-min) (point-max)))))))
;;
;; space replacement
"Replace ASCII spaces with Ethiopic word separators in the region.
In the specified region, replace word separators surrounded by two
-Ethiopic characters, depending on the first parameter CH, which should
+Ethiopic characters, depending on the first argument CH, which should
be 1, 2, or 3.
If CH = 1, word separator will be replaced with an ASCII space.
If CH = 2, with two ASCII spaces.
If CH = 3, with the Ethiopic colon-like word separator.
-The second and third parameters BEGIN and END specify the region."
+The 2nd and 3rd arguments BEGIN and END specify the region."
(interactive "*cReplace spaces to: 1 (sg col), 2 (dbl col), 3 (Ethiopic)\nr")
(if (not (memq ch '(?1 ?2 ?3)))
((= ch ?1)
;; an Ethiopic word separator --> an ASCII space
(goto-char (point-min))
- (while (search-forward "\e$(3$h\e(B" nil t)
- (replace-match " " nil t))
+ (while (search-forward "á¡" nil t)
+ (replace-match " "))
;; two ASCII spaces between Ethiopic characters --> an ASCII space
(goto-char (point-min))
(while (re-search-forward "\\(\\ce\\) \\(\\ce\\)" nil t)
(replace-match "\\1 \\2")
- (goto-char (match-beginning 2))))
+ (forward-char -1)))
((= ch ?2)
;; An Ethiopic word separator --> two ASCII spaces
(goto-char (point-min))
- (while (search-forward "\e$(3$h\e(B" nil t)
+ (while (search-forward "á¡" nil t)
(replace-match " "))
;; An ASCII space between Ethiopic characters --> two ASCII spaces
(goto-char (point-min))
(while (re-search-forward "\\(\\ce\\) \\(\\ce\\)" nil t)
(replace-match "\\1 \\2")
- (goto-char (match-beginning 2))))
+ (forward-char -1)))
(t
;; One or two ASCII spaces between Ethiopic characters
;; --> An Ethiopic word separator
(goto-char (point-min))
(while (re-search-forward "\\(\\ce\\) ?\\(\\ce\\)" nil t)
- (replace-match "\\1\e$(3$h\e(B\\2")
- (goto-char (match-beginning 2)))
+ (replace-match "\\1á¡\\2")
+ (forward-char -1))
;; Three or more ASCII spaces between Ethiopic characters
;; --> An Ethiopic word separator + (N - 2) ASCII spaces
(goto-char (point-min))
- (while (re-search-forward "\\(\\ce\\) \\( *\\ce\\)" nil t)
- (replace-match "\\1\e$(3$h\e(B\\2")
- (goto-char (match-beginning 2))))))))
+ (while (re-search-forward "\\(\\ce\\) \\( +\\ce\\)" nil t)
+ (replace-match "\\1á¡\\2")
+ (forward-char -1)))))))
;;
;; special icons
;;
+;; This function is deprecated.
;;;###autoload
(defun ethio-input-special-character (arg)
- "Allow the user to input special characters."
- (interactive "*cInput number: 1.\e$(3%j\e(B 2.\e$(3%k\e(B 3.\e$(3%l\e(B 4.\e$(3%m\e(B 5.\e$(3%i\e(B")
+ "This function is deprecated."
+ (interactive "*cInput number: 1.ö ‡ 2.ö ‡‚ 3.ö ‡ƒ 4.ö ‡„ 5.ö ‡€")
(cond
((= arg ?1)
- (insert "\e$(3%j\e(B"))
+ (insert "ö ‡"))
((= arg ?2)
- (insert "\e$(3%k\e(B"))
+ (insert "ö ‡‚"))
((= arg ?3)
- (insert "\e$(3%l\e(B"))
+ (insert "ö ‡ƒ"))
((= arg ?4)
- (insert "\e$(3%m\e(B"))
+ (insert "ö ‡„"))
((= arg ?5)
- (insert "\e$(3%i\e(B"))
+ (insert "ö ‡€"))
(t
(error ""))))
;; TeX support
;;
-(defconst ethio-fidel-to-tex-map
- [ "heG" "huG" "hiG" "haG" "hEG" "hG" "hoG" "" ;; 0 - 7
- "leG" "luG" "liG" "laG" "lEG" "lG" "loG" "lWaG" ;; 8
- "HeG" "HuG" "HiG" "HaG" "HEG" "HG" "HoG" "HWaG" ;; 16
- "meG" "muG" "miG" "maG" "mEG" "mG" "moG" "mWaG" ;; 24
- "sseG" "ssuG" "ssiG" "ssaG" "ssEG" "ssG" "ssoG" "ssWaG" ;; 32
- "reG" "ruG" "riG" "raG" "rEG" "rG" "roG" "rWaG" ;; 40
- "seG" "suG" "siG" "saG" "sEG" "sG" "soG" "sWaG" ;; 48
- "xeG" "xuG" "xiG" "xaG" "xEG" "xG" "xoG" "xWaG" ;; 56
- "qeG" "quG" "qiG" "qaG" "qEG" "qG" "qoG" "" ;; 64
- "qWeG" "" "qWiG" "qWaG" "qWEG" "qWG" "" "" ;; 72
- "QeG" "QuG" "QiG" "QaG" "QEG" "QG" "QoG" "" ;; 80
- "QWeG" "" "QWiG" "QWaG" "QWEG" "QWG" "" "" ;; 88
- "beG" "buG" "biG" "baG" "bEG" "bG" "boG" "bWaG" ;; 96
- "veG" "vuG" "viG" "vaG" "vEG" "vG" "voG" "vWaG" ;; 104
- "teG" "tuG" "tiG" "taG" "tEG" "tG" "toG" "tWaG" ;; 112
- "ceG" "cuG" "ciG" "caG" "cEG" "cG" "coG" "cWaG" ;; 120
- "hheG" "hhuG" "hhiG" "hhaG" "hhEG" "hhG" "hhoG" "" ;; 128
- "hWeG" "" "hWiG" "hWaG" "hWEG" "hWG" "" "" ;; 136
- "neG" "nuG" "niG" "naG" "nEG" "nG" "noG" "nWaG" ;; 144
- "NeG" "NuG" "NiG" "NaG" "NEG" "NG" "NoG" "NWaG" ;; 152
- "eG" "uG" "iG" "AG" "EG" "IG" "oG" "eaG" ;; 160
- "keG" "kuG" "kiG" "kaG" "kEG" "kG" "koG" "" ;; 168
- "kWeG" "" "kWiG" "kWaG" "kWEG" "kWG" "" "" ;; 176
- "KeG" "KuG" "KiG" "KaG" "KEG" "KG" "KoG" "" ;; 184
- "KWeG" "" "KWiG" "KWaG" "KWEG" "KWG" "" "" ;; 192
- "weG" "wuG" "wiG" "waG" "wEG" "wG" "woG" "" ;; 200
- "eeG" "uuG" "iiG" "aaG" "EEG" "IIG" "ooG" "" ;; 208
- "zeG" "zuG" "ziG" "zaG" "zEG" "zG" "zoG" "zWaG" ;; 216
- "ZeG" "ZuG" "ZiG" "ZaG" "ZEG" "ZG" "ZoG" "ZWaG" ;; 224
- "yeG" "yuG" "yiG" "yaG" "yEG" "yG" "yoG" "yWaG" ;; 232
- "deG" "duG" "diG" "daG" "dEG" "dG" "doG" "dWaG" ;; 240
- "DeG" "DuG" "DiG" "DaG" "DEG" "DG" "DoG" "DWaG" ;; 248
- "jeG" "juG" "jiG" "jaG" "jEG" "jG" "joG" "jWaG" ;; 256
- "geG" "guG" "giG" "gaG" "gEG" "gG" "goG" "" ;; 264
- "gWeG" "" "gWiG" "gWaG" "gWEG" "gWG" "" "" ;; 272
- "GeG" "GuG" "GiG" "GaG" "GEG" "GG" "GoG" "GWaG" ;; 280
- "TeG" "TuG" "TiG" "TaG" "TEG" "TG" "ToG" "TWaG" ;; 288
- "CeG" "CuG" "CiG" "CaG" "CEG" "CG" "CoG" "CWaG" ;; 296
- "PeG" "PuG" "PiG" "PaG" "PEG" "PG" "PoG" "PWaG" ;; 304
- "SeG" "SuG" "SiG" "SaG" "SEG" "SG" "SoG" "SWaG" ;; 312
- "SSeG" "SSuG" "SSiG" "SSaG" "SSEG" "SSG" "SSoG" "" ;; 320
- "feG" "fuG" "fiG" "faG" "fEG" "fG" "foG" "fWaG" ;; 328
- "peG" "puG" "piG" "paG" "pEG" "pG" "poG" "pWaG" ;; 336
- "mYaG" "rYaG" "fYaG" "" "" "" "" "" ;; 344
- "" "spaceG" "periodG" "commaG" ;; 352
- "semicolonG" "colonG" "precolonG" "oldqmarkG" ;; 356
- "pbreakG" "andG" "huletG" "sostG" "aratG" "amstG" "sadstG" "sabatG" ;; 360
- "smntG" "zeteNG" "asrG" "heyaG" "selasaG" "arbaG" "hemsaG" "slsaG" ;; 368
- "sebaG" "semanyaG" "zeTanaG" "metoG" "asrxiG" "" "" "" ;; 376
- "qqeG" "qquG" "qqiG" "qqaG" "qqEG" "qqG" "qqoG" "" ;; 384
- "mWeG" "bWeG" "GWeG" "fWeG" "pWeG" "" "" "" ;; 392
- "kkeG" "kkuG" "kkiG" "kkaG" "kkEG" "kkG" "kkoG" "" ;; 400
- "mWiG" "bWiG" "GWiG" "fWiG" "pWiG" "" "" "" ;; 408
- "XeG" "XuG" "GXiG" "XaG" "XEG" "XG" "XoG" "" ;; 416
- "mWEG" "bWEG" "GWEG" "fWEG" "pWEG" "" "" "" ;; 424
- "ggeG" "gguG" "ggiG" "ggaG" "ggEG" "ggG" "ggoG" "" ;; 432
- "mWG" "bWG" "GWG" "fWG" "pWG" "" "" "" ;; 440
- "ornamentG" "flandG" "iflandG" "africaG" ;; 448
- "iafricaG" "wWeG" "wWiG" "wWaG" ;; 452
- "wWEG" "wWG" "" "slaqG" "dotG" "lquoteG" "rquoteG" "qmarkG" ]) ;; 456
-
-;;
-;; To make tex-to-fidel mapping.
-;; The following code makes
-;; (get 'ethio-tex-command-he 'ethio-fidel-char) ==> ?\e$(3!!\e(B
-;; etc.
-;;
-
-(let ((i 0) str)
- (while (< i (length ethio-fidel-to-tex-map))
- (setq str (aref ethio-fidel-to-tex-map i))
- (if (not (string= str ""))
- (put
- (intern (concat "ethio-tex-command-" (aref ethio-fidel-to-tex-map i)))
- 'ethio-fidel-char
- (ethio-ethiocode-to-char i)))
- (setq i (1+ i))))
-
;;;###autoload
(defun ethio-fidel-to-tex-buffer nil
- "Convert each fidel characters in the current buffer into a fidel-tex command.
-Each command is always surrounded by braces."
+ "Convert each fidel characters in the current buffer into a fidel-tex command."
(interactive)
- (let ((buffer-read-only nil))
+ (let ((buffer-read-only nil)
+ comp ch)
- ;; Isolated gemination marks need special treatement
+ ;; Special treatment for geminated characters.
+ ;; Geminated characters la", etc. change into \geminateG{\laG}, etc.
(goto-char (point-min))
- (while (search-forward "\e$(3%s\e(B" nil t)
- (replace-match "\\geminateG{}" t t))
-
- ;; First, decompose geminations
- ;; Here we assume that each composed character consists of
- ;; one Ethiopic character and the Ethiopic gemination mark.
- (decompose-region (point-min) (point-max))
+ (while (re-search-forward "áŸ\\|ö ‡Š" nil t)
+ (setq comp (find-composition (match-beginning 0)))
+ (if (null comp)
+ (replace-match "\\\\geminateG{}" t)
+ (decompose-region (car comp) (cadr comp))
+ (delete-char -1)
+ (forward-char -1)
+ (insert "\\geminateG{")
+ (forward-char 1)
+ (insert "}")))
- ;; Special treatment for geminated characters
- ;; The geminated character (la'') will be "\geminateG{\la}".
+ ;; Special Ethiopic punctuations.
(goto-char (point-min))
- (while (search-forward "\e$(3%s\e(B" nil t)
- (delete-backward-char 1)
- (backward-char 1)
- (insert "\\geminateG")
- (forward-char 1))
+ (while (re-search-forward "\\ce[»\\.\\?]\\|«\\ce" nil t)
+ (cond
+ ((= (setq ch (preceding-char)) ?\»)
+ (delete-char -1)
+ (insert "\\rquoteG"))
+ ((= ch ?.)
+ (delete-char -1)
+ (insert "\\dotG"))
+ ((= ch ??)
+ (delete-char -1)
+ (insert "\\qmarkG"))
+ (t
+ (forward-char -1)
+ (delete-char -1)
+ (insert "\\lquoteG")
+ (forward-char 1))))
;; Ethiopic characters to TeX macros
- (goto-char (point-min))
- (while (re-search-forward "\\ce" nil t)
- (insert
- "{\\"
- (aref ethio-fidel-to-tex-map
- (prog1 (ethio-char-to-ethiocode (preceding-char))
- (backward-delete-char 1)))
- "}"))
+ (robin-invert-region (point-min) (point-max) "ethiopic-tex")
+
(goto-char (point-min))
(set-buffer-modified-p nil)))
(let ((buffer-read-only nil)
(p) (ch))
- ;; Special treatment for gemination
- ;; "\geminateG{\la}" or "\geminateG{{\la}}" will be "\la\e$(3%s\e(B"
- ;; "\geminateG{}" remains unchanged.
- (goto-char (point-min))
- (while (re-search-forward "\\\\geminateG{\\(\\\\[a-zA-Z]+\\)}" nil t)
- (replace-match "\\1\e$(3%s\e(B"))
-
;; TeX macros to Ethiopic characters
- (goto-char (point-min))
- (while (search-forward "\\" nil t)
- (setq p (point))
- (skip-chars-forward "a-zA-Z")
- (setq ch
- (get (intern (concat "ethio-tex-command-"
- (buffer-substring p (point))))
- 'ethio-fidel-char))
- (if ch
- (progn
- (delete-region (1- p) (point)) ; don't forget the preceding "\"
- (if (and (= (preceding-char) ?{)
- (= (following-char) ?}))
- (progn
- (backward-delete-char 1)
- (delete-char 1)))
- (insert ch))))
+ (robin-convert-region (point-min) (point-max) "ethiopic-tex")
;; compose geminated characters
(goto-char (point-min))
- (while (re-search-forward "\\ce\e$(3%s\e(B" nil 0)
- (compose-region
- (save-excursion (backward-char 2) (point))
- (point)))
+ (while (re-search-forward "\\\\geminateG{\\(\\ce?\\)}" nil t)
+ (replace-match "\\1áŸ"))
- ;; Now it's time to convert isolated gemination marks.
+ ;; remove redundant braces, if any
(goto-char (point-min))
- (while (search-forward "\\geminateG{}" nil t)
- (replace-match "\e$(3%s\e(B"))
+ (while (re-search-forward "{\\(\\ce\\)}" nil t)
+ (replace-match "\\1"))
(goto-char (point-min))
(set-buffer-modified-p nil)))
Otherwise, [0-9A-F]."
(let ((ucode))
- ;; first, decompose geminations
- (decompose-region (point-min) (point-max))
-
(goto-char (point-min))
- (while (re-search-forward "\\ce" nil t)
- (setq ucode (+ ?\x1200 (ethio-char-to-ethiocode (preceding-char))))
- (if (> ucode ?\x13bc)
- (setq ucode (+ ucode 59952)))
+ (while (re-search-forward "[ሀ-á¼]" nil t)
+ (setq ucode (preceding-char))
(delete-backward-char 1)
- (if ethio-java-save-lowercase
- (insert (format "\\u%4x" ucode))
- (insert (upcase (format "\\u%4x" ucode)))))))
+ (insert
+ (format (if ethio-java-save-lowercase "\\u%4x" "\\u%4X")
+ ucode)))))
;;;###autoload
(defun ethio-java-to-fidel-buffer nil
"Convert the Java escape sequences into corresponding Ethiopic characters."
- (let ((ucode))
- (goto-char (point-min))
- (while (re-search-forward "\\\\u\\([0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]\\)" nil t)
- (setq ucode
- (read
- (concat
- "?\\x"
- (buffer-substring (match-beginning 1) (match-end 1)))))
- (cond
- ((and (>= ucode ?\x1200) (<= ucode ?\x13bc))
- (replace-match "")
- (insert (ethio-ethiocode-to-char (- ucode ?\x1200))))
- ((and (>= ucode ?\xfdf1) (<= ucode ?\xfdff))
- (replace-match "")
- (insert (ethio-ethiocode-to-char (- ucode 64560))))
- (t
- nil)))
-
- ;; gemination
+ (let ((case-fold-search t)
+ (ucode))
(goto-char (point-min))
- (while (re-search-forward "\\ce\e$(3%s\e(B" nil 0)
- (compose-region
- (save-excursion (backward-char 2) (point))
- (point)))
- ))
+ (while (re-search-forward "\\\\u\\([0-9a-f][0-9a-f][0-9a-f][0-9a-f]\\)" nil t)
+ (setq ucode (read (concat "#x" (match-string 1))))
+ (when (and (>= ucode #x1200) (<= ucode #x137f))
+ (replace-match (char-to-string ucode))))))
;;
;; file I/O hooks
;;;###autoload
(defun ethio-find-file nil
- "Transcribe file content into Ethiopic depending on filename suffix."
+ "Transliterate file content into Ethiopic dependig on filename suffix."
(cond
((string-match "\\.sera$" (buffer-file-name))
(save-excursion
(ethio-sera-to-fidel-marker 'force)
(goto-char (point-min))
- (while (re-search-forward "&[lr]aquote;" nil t)
+ (while (re-search-forward "&[lr]aquo;" nil t)
(if (= (char-after (1+ (match-beginning 0))) ?l)
- (replace-match "\e$(3%v\e(B")
- (replace-match "\e$(3%w\e(B")))
+ (replace-match "«")
+ (replace-match "»")))
(set-buffer-modified-p nil))))
((string-match "\\.tex$" (buffer-file-name))
;;;###autoload
(defun ethio-write-file nil
- "Transcribe Ethiopic characters in ASCII depending on the file extension."
+ "Transliterate Ethiopic characters in ASCII depending on the file extension."
(cond
((string-match "\\.sera$" (buffer-file-name))
((string-match "\\.html$" (buffer-file-name))
(save-excursion
- (let ((ethio-sera-being-called-by-w3 t)
- (lq (aref ethio-fidel-to-sera-map 461))
- (rq (aref ethio-fidel-to-sera-map 462)))
- (aset ethio-fidel-to-sera-map 461 "«te;")
- (aset ethio-fidel-to-sera-map 462 "»te;")
+ (let ((ethio-sera-being-called-by-w3 t))
(ethio-fidel-to-sera-marker 'force)
(goto-char (point-min))
+ (while (re-search-forward "[«»]" nil t)
+ (replace-match (if (= (preceding-char) ?«) "«" "»")))
+ (goto-char (point-min))
(if (search-forward "<sera>" nil t)
(ethio-record-user-preference))
- (aset ethio-fidel-to-sera-map 461 lq)
- (aset ethio-fidel-to-sera-map 462 rq)
(set-buffer-modified-p nil))))
((string-match "\\.tex$" (buffer-file-name))
nil)))
(defun ethio-record-user-preference nil
- (if (looking-at "\\\\~\\(tir?\\|amh?\\) ")
- (goto-char (match-end 0))
- (insert (if (ethio-prefer-amharic-p) "\\~amh " "\\~tir ")))
(insert (if ethio-use-colon-for-colon "\\~-: " "\\~`: ")
- (if ethio-use-three-dot-question "\\~`| " "\\~`? ")))
+ (if ethio-use-three-dot-question "\\~`| " "\\~? ")))
;;
;; Ethiopic word separator vs. ASCII space
"Toggle ASCII space and Ethiopic separator for keyboard input."
(interactive)
(setq ethio-prefer-ascii-space
- (not ethio-prefer-ascii-space))
- (if (equal current-input-method "ethiopic")
- (setq current-input-method-title (quail-title)))
- (force-mode-line-update))
+ (not ethio-prefer-ascii-space)))
(defun ethio-insert-space (arg)
"Insert ASCII spaces or Ethiopic word separators depending on context.
((save-excursion
(skip-chars-backward " ")
(memq (preceding-char)
- '(?\e$(3$h\e(B ?\e$(3$i\e(B ?\e$(3$j\e(B ?\e$(3$k\e(B ?\e$(3$l\e(B ?\e$(3$m\e(B ?\e$(3$n\e(B ?\e$(3$o\e(B ?\e$(3%t\e(B ?\e$(3%u\e(B ?\e$(3%v\e(B ?\e$(3%w\e(B ?\e$(3%x\e(B)))
+ '(?á¡ ?ᢠ?ᣠ?ᤠ?ᥠ?ᦠ?᧠?ᨠ?ö ‡‹ ?ö ‡Œ ?ö ‡ ?ö ‡Ž ?ö ‡)))
(insert-char 32 arg))
(t
- (insert-char ?\e$(3$h\e(B arg))))
+ (insert-char ?á¡ arg))))
+;;;###autoload
(defun ethio-insert-ethio-space (arg)
"Insert the Ethiopic word delimiter (the colon-like character).
With ARG, insert that many delimiters."
(interactive "*p")
- (insert-char ?\e$(3$h\e(B arg))
-
-;;
-;; Ethiopic punctuation vs. ASCII punctuation
-;;
-
-(defvar ethio-prefer-ascii-punctuation nil)
-(make-variable-buffer-local 'ethio-prefer-ascii-punctuation)
-
-(defun ethio-toggle-punctuation nil
- "Toggle Ethiopic punctuations and ASCII punctuations for keyboard input."
- (interactive)
- (setq ethio-prefer-ascii-punctuation
- (not ethio-prefer-ascii-punctuation))
- (let* ((keys '("." ".." "..." "," ",," ";" ";;" ":" "::" ":::" "*" "**"))
- (puncs
- (if ethio-prefer-ascii-punctuation
- '(?. [".."] ["..."] ?, [",,"] ?\; [";;"] ?: ["::"] [":::"] ?* ["**"])
- '(?\e$(3$i\e(B ?\e$(3%u\e(B ?. ?\e$(3$j\e(B ?, ?\e$(3$k\e(B ?\; ?\e$(3$h\e(B ?\e$(3$i\e(B ?: ?* ?\e$(3$o\e(B))))
- (while keys
- (quail-defrule (car keys) (car puncs) "ethiopic")
- (setq keys (cdr keys)
- puncs (cdr puncs)))
- (if (equal current-input-method "ethiopic")
- (setq current-input-method-title (quail-title)))
- (force-mode-line-update)))
+ (insert-char ?á¡ arg))
;;
;; Gemination
;;
+;;;###autoload
+(defun ethio-composition-function (pos to font-object string)
+ (setq pos (1- pos))
+ (let ((pattern "\\ce\\(áŸ\\|ö ‡Š\\)"))
+ (if string
+ (if (and (>= pos 0)
+ (eq (string-match pattern string pos) pos))
+ (prog1 (match-end 0)
+ (compose-string string pos (match-end 0))))
+ (if (>= pos (point-min))
+ (progn
+ (goto-char pos)
+ (if (looking-at pattern)
+ (prog1 (match-end 0)
+ (compose-region pos (match-end 0)))))))))
+
+;; This function is not used any more.
(defun ethio-gemination nil
"Compose the character before the point with the Ethiopic gemination mark.
If the character is already composed, decompose it and remove the gemination
mark."
(interactive "*")
- (cond
- ((eq (char-charset (preceding-char)) 'ethiopic)
- (insert "\e$(3%s\e(B")
- (compose-region
- (save-excursion (backward-char 2) (point))
- (point))
- (forward-char 1))
- ((eq (char-charset (preceding-char)) 'leading-code-composition)
- (decompose-region
- (save-excursion (backward-char 1) (point))
- (point))
- (delete-backward-char 1))
- (t
- (error ""))))
+ (let ((ch (preceding-char)))
+ (cond
+ ((and (= ch ?ö ‡Š) (find-composition (1- (point))))
+ (decompose-region (- (point) 2) (point)))
+ ((and (>= ch #x1200) (<= ch #x137f))
+ (insert "ö ‡Š")
+ (compose-region (- (point) 2) (point)))
+ (t
+ (error "")))))
+
+;;;
+;;; Robin packages
+;;;
+
+(robin-define-package "ethiopic-sera"
+ "SERA transliteration system for Ethiopic."
+
+ ("he" ?ሀ)
+ ("hu" ?áˆ)
+ ("hi" ?ሂ)
+ ("ha" ?ሃ)
+ ("hE" ?ሄ) ("hee" "ሄ")
+ ("h" ?ህ)
+ ("ho" ?ሆ)
+
+ ("le" ?ለ) ("Le" "ለ")
+ ("lu" ?ሉ) ("Lu" "ሉ")
+ ("li" ?ሊ) ("Li" "ሊ")
+ ("la" ?ላ) ("La" "ላ")
+ ("lE" ?ሌ) ("LE" "ሌ") ("lee" "ሌ") ("Lee" "ሌ")
+ ("l" ?áˆ) ("L" "áˆ")
+ ("lo" ?ሎ) ("Lo" "ሎ")
+ ("lWa" ?áˆ) ("LWa" "áˆ") ("lW" "áˆ") ("LW" "áˆ")
+
+ ("He" ?áˆ)
+ ("Hu" ?ሑ)
+ ("Hi" ?ሒ)
+ ("Ha" ?ሓ)
+ ("HE" ?ሔ) ("Hee" "ሔ")
+ ("H" ?ሕ)
+ ("Ho" ?ሖ)
+ ("HWa" ?ሗ) ("HW" "ሗ")
+
+ ("me" ?መ) ("Me" "መ")
+ ("mu" ?ሙ) ("Mu" "ሙ")
+ ("mi" ?ሚ) ("Mi" "ሚ")
+ ("ma" ?ማ) ("Ma" "ማ")
+ ("mE" ?ሜ) ("ME" "ሜ") ("mee" "ሜ") ("Mee" "ሜ")
+ ("m" ?áˆ) ("M" "áˆ")
+ ("mo" ?ሞ) ("Mo" "ሞ")
+ ("mWa" ?ሟ) ("MWa" "ሟ") ("mW" "ሟ") ("MW" "ሟ")
+
+ ("`se" ?ሠ) ("sse" "ሠ") ("s2e" "ሠ")
+ ("`su" ?ሡ) ("ssu" "ሡ") ("s2u" "ሡ")
+ ("`si" ?ሢ) ("ssi" "ሢ") ("s2i" "ሢ")
+ ("`sa" ?ሣ) ("ssa" "ሣ") ("s2a" "ሣ")
+ ("`sE" ?ሤ) ("ssE" "ሤ") ("s2E" "ሤ")
+ ("`see" "ሤ") ("ssee" "ሤ") ("s2ee" "ሤ")
+ ("`s" ?ሥ) ("ss" "ሥ") ("s2" "ሥ")
+ ("`so" ?ሦ) ("sso" "ሦ") ("s2o" "ሦ")
+ ("`sWa" ?ሧ) ("ssWa" "ሧ") ("s2Wa" "ሧ")
+ ("`sW" "ሧ") ("ssW" "ሧ") ("s2W" "ሧ")
+
+ ("re" ?ረ) ("Re" "ረ")
+ ("ru" ?ሩ) ("Ru" "ሩ")
+ ("ri" ?ሪ) ("Ri" "ሪ")
+ ("ra" ?ራ) ("Ra" "ራ")
+ ("rE" ?ሬ) ("RE" "ሬ") ("ree" "ሬ") ("Ree" "ሬ")
+ ("r" ?áˆ) ("R" "áˆ")
+ ("ro" ?ሮ) ("Ro" "ሮ")
+ ("rWa" ?ሯ) ("RWa" "ሯ") ("rW" "ሯ") ("RW" "ሯ")
+
+ ("se" ?ሰ)
+ ("su" ?ሱ)
+ ("si" ?ሲ)
+ ("sa" ?ሳ)
+ ("sE" ?ሴ) ("see" "ሴ")
+ ("s" ?ስ)
+ ("so" ?ሶ)
+ ("sWa" ?ሷ) ("sW" "ሷ")
+
+ ("xe" ?ሸ)
+ ("xu" ?ሹ)
+ ("xi" ?ሺ)
+ ("xa" ?ሻ)
+ ("xE" ?ሼ) ("xee" "ሼ")
+ ("x" ?ሽ)
+ ("xo" ?ሾ)
+ ("xWa" ?ሿ) ("xW" "ሿ")
+
+ ("qe" ?ቀ)
+ ("qu" ?á‰)
+ ("qi" ?ቂ)
+ ("qa" ?ቃ)
+ ("qE" ?ቄ) ("qee" "ቄ")
+ ("q" ?ቅ)
+ ("qo" ?ቆ)
+ ("qWe" ?ቈ)
+ ("qWi" ?ቊ)
+ ("qWa" ?ቋ) ("qW" "ቋ")
+ ("qWE" ?ቌ) ("qWee" "ቌ")
+ ("qW'" ?á‰) ("qWu" "á‰")
+
+ ("Qe" ?á‰)
+ ("Qu" ?ቑ)
+ ("Qi" ?ቒ)
+ ("Qa" ?ቓ)
+ ("QE" ?ቔ) ("Qee" "ቔ")
+ ("Q" ?ቕ)
+ ("Qo" ?ቖ)
+ ("QWe" ?ቘ)
+ ("QWi" ?ቚ)
+ ("QWa" ?ቛ) ("QW" "ቛ")
+ ("QWE" ?ቜ) ("QWee" "ቜ")
+ ("QW'" ?á‰) ("QWu" "á‰")
+
+ ("be" ?በ) ("Be" "በ")
+ ("bu" ?ቡ) ("Bu" "ቡ")
+ ("bi" ?ቢ) ("Bi" "ቢ")
+ ("ba" ?ባ) ("Ba" "ባ")
+ ("bE" ?ቤ) ("BE" "ቤ") ("bee" "ቤ") ("Bee" "ቤ")
+ ("b" ?ብ) ("B" "ብ")
+ ("bo" ?ቦ) ("Bo" "ቦ")
+ ("bWa" ?ቧ) ("BWa" "ቧ") ("bW" "ቧ") ("BW" "ቧ")
+
+ ("ve" ?ቨ) ("Ve" "ቨ")
+ ("vu" ?ቩ) ("Vu" "ቩ")
+ ("vi" ?ቪ) ("Vi" "ቪ")
+ ("va" ?ቫ) ("Va" "ቫ")
+ ("vE" ?ቬ) ("VE" "ቬ") ("vee" "ቬ") ("Vee" "ቬ")
+ ("v" ?á‰) ("V" "á‰")
+ ("vo" ?ቮ) ("Vo" "ቮ")
+ ("vWa" ?ቯ) ("VWa" "ቯ") ("vW" "ቯ") ("VW" "ቯ")
+
+ ("te" ?ተ)
+ ("tu" ?ቱ)
+ ("ti" ?ቲ)
+ ("ta" ?ታ)
+ ("tE" ?ቴ) ("tee" "ቴ")
+ ("t" ?ት)
+ ("to" ?ቶ)
+ ("tWa" ?ቷ) ("tW" "ቷ")
+
+ ("ce" ?ቸ)
+ ("cu" ?ቹ)
+ ("ci" ?ቺ)
+ ("ca" ?ቻ)
+ ("cE" ?ቼ) ("cee" "ቼ")
+ ("c" ?ች)
+ ("co" ?ቾ)
+ ("cWa" ?ቿ) ("cW" "ቿ")
+
+ ("`he" ?ኀ) ("hhe" "ኀ") ("h2e" "ኀ")
+ ("`hu" ?áŠ) ("hhu" "áŠ") ("h2u" "áŠ")
+ ("`hi" ?ኂ) ("hhi" "ኂ") ("h2i" "ኂ")
+ ("`ha" ?ኃ) ("hha" "ኃ") ("h2a" "ኃ")
+ ("`hE" ?ኄ) ("hhE" "ኄ") ("h2E" "ኄ")
+ ("`hee" "ኄ") ("hhee" "ኄ") ("h2ee" "ኄ")
+ ("`h" ?ኅ) ("hh" "ኅ") ("h2" "ኅ")
+ ("`ho" ?ኆ) ("hho" "ኆ") ("h2o" "ኆ")
+ ("`hWe" ?ኈ) ("hhWe" "ኈ") ("h2We" "ኈ") ("hWe" "ኈ")
+ ("`hWi" ?ኊ) ("hhWi" "ኊ") ("h2Wi" "ኊ") ("hWi" "ኊ")
+ ("`hWa" ?ኋ) ("hhWa" "ኋ") ("h2Wa" "ኋ") ("hWa" "ኋ")
+ ("`hW" "ኋ") ("hhW" "ኋ") ("h2W" "ኋ")
+ ("`hWE" ?ኌ) ("hhWE" "ኌ") ("h2WE" "ኌ") ("hWE" "ኌ")
+ ("`hWee" "ኌ") ("hhWee" "ኌ") ("h2Wee" "ኌ") ("hWee" "ኌ")
+ ("`hW'" ?áŠ) ("hhW'" "áŠ") ("h2W'" "áŠ") ("hW'" "áŠ")
+ ("`hWu" "áŠ") ("hhWu" "áŠ") ("h2Wu" "áŠ") ("hWu" "áŠ")
+
+ ("ne" ?áŠ)
+ ("nu" ?ኑ)
+ ("ni" ?ኒ)
+ ("na" ?ና)
+ ("nE" ?ኔ) ("nee" "ኔ")
+ ("n" ?ን)
+ ("no" ?ኖ)
+ ("nWa" ?ኗ) ("nW" "ኗ")
+
+ ("Ne" ?ኘ)
+ ("Nu" ?ኙ)
+ ("Ni" ?ኚ)
+ ("Na" ?ኛ)
+ ("NE" ?ኜ) ("Nee" "ኜ")
+ ("N" ?áŠ)
+ ("No" ?ኞ)
+ ("NWa" ?ኟ) ("NW" "ኟ")
+
+ ("'A" ?አ) ("A" "አ")
+ ("'u" ?ኡ) ("u" "ኡ") ("'U" "ኡ") ("U" "ኡ")
+ ("'i" ?ኢ) ("i" "ኢ")
+ ("'a" ?ኣ) ("a" "ኣ")
+ ("'E" ?ኤ) ("E" "ኤ")
+ ("'I" ?እ) ("I" "እ") ("'e" "እ") ("e" "እ")
+ ("'o" ?ኦ) ("o" "ኦ") ("'O" "ኦ") ("O" "ኦ")
+ ("'ea" ?ኧ) ("ea" "ኧ")
+
+ ("ke" ?ከ)
+ ("ku" ?ኩ)
+ ("ki" ?ኪ)
+ ("ka" ?ካ)
+ ("kE" ?ኬ) ("kee" "ኬ")
+ ("k" ?áŠ)
+ ("ko" ?ኮ)
+ ("kWe" ?ኰ)
+ ("kWi" ?ኲ)
+ ("kWa" ?ኳ) ("kW" "ኳ")
+ ("kWE" ?ኴ) ("kWee" "ኴ")
+ ("kW'" ?ኵ) ("kWu" "ኵ")
+
+ ("Ke" ?ኸ)
+ ("Ku" ?ኹ)
+ ("Ki" ?ኺ)
+ ("Ka" ?ኻ)
+ ("KE" ?ኼ) ("Kee" "ኼ")
+ ("K" ?ኽ)
+ ("Ko" ?ኾ)
+ ("KWe" ?á‹€)
+ ("KWi" ?á‹‚)
+ ("KWa" ?ዃ) ("KW" "ዃ")
+ ("KWE" ?á‹„) ("KWee" "á‹„")
+ ("KW'" ?á‹…) ("KWu" "á‹…")
+
+ ("we" ?ወ)
+ ("wu" ?ዉ)
+ ("wi" ?á‹Š)
+ ("wa" ?á‹‹)
+ ("wE" ?ዌ) ("wee" "ዌ")
+ ("w" ?á‹)
+ ("wo" ?á‹Ž)
+
+ ("`e" ?á‹) ("ae" "á‹") ("aaa" "á‹") ("e2" "á‹")
+ ("`u" ?á‹‘) ("uu" "á‹‘") ("u2" "á‹‘") ("`U" "á‹‘") ("UU" "á‹‘") ("U2" "á‹‘")
+ ("`i" ?á‹’) ("ii" "á‹’") ("i2" "á‹’")
+ ("`a" ?á‹“) ("aa" "á‹“") ("a2" "á‹“") ("`A" "á‹“") ("AA" "á‹“") ("A2" "á‹“")
+ ("`E" ?á‹”) ("EE" "á‹”") ("E2" "á‹”")
+ ("`I" ?á‹•) ("II" "á‹•") ("I2" "á‹•") ("ee" "á‹•")
+ ("`o" ?á‹–) ("oo" "á‹–") ("o2" "á‹–") ("`O" "á‹–") ("OO" "á‹–") ("O2" "á‹–")
+
+ ("ze" ?ዘ)
+ ("zu" ?á‹™)
+ ("zi" ?á‹š)
+ ("za" ?á‹›)
+ ("zE" ?ዜ) ("zee" "ዜ")
+ ("z" ?á‹)
+ ("zo" ?á‹ž)
+ ("zWa" ?á‹Ÿ) ("zW" "á‹Ÿ")
+
+ ("Ze" ?á‹ )
+ ("Zu" ?á‹¡)
+ ("Zi" ?á‹¢)
+ ("Za" ?á‹£)
+ ("ZE" ?ዤ) ("Zee" "ዤ")
+ ("Z" ?á‹¥)
+ ("Zo" ?ዦ)
+ ("ZWa" ?ዧ) ("ZW" "ዧ")
+
+ ("ye" ?የ) ("Ye" "የ")
+ ("yu" ?á‹©) ("Yu" "á‹©")
+ ("yi" ?ዪ) ("Yi" "ዪ")
+ ("ya" ?á‹«) ("Ya" "á‹«")
+ ("yE" ?ዬ) ("YE" "ዬ") ("yee" "ዬ") ("Yee" "ዬ")
+ ("y" ?á‹) ("Y" "á‹")
+ ("yo" ?á‹®) ("Yo" "á‹®")
+
+ ("de" ?á‹°)
+ ("du" ?ዱ)
+ ("di" ?ዲ)
+ ("da" ?ዳ)
+ ("dE" ?á‹´) ("dee" "á‹´")
+ ("d" ?ድ)
+ ("do" ?ዶ)
+ ("dWa" ?á‹·) ("dW" "á‹·")
+
+ ("De" ?ዸ)
+ ("Du" ?ዹ)
+ ("Di" ?ዺ)
+ ("Da" ?á‹»)
+ ("DE" ?ዼ) ("Dee" "ዼ")
+ ("D" ?ዽ)
+ ("Do" ?ዾ)
+ ("DWa" ?á‹¿) ("DW" "á‹¿")
+
+ ("je" ?ጀ) ("Je" "ጀ")
+ ("ju" ?áŒ) ("Ju" "áŒ")
+ ("ji" ?ጂ) ("Ji" "ጂ")
+ ("ja" ?ጃ) ("Ja" "ጃ")
+ ("jE" ?ጄ) ("JE" "ጄ") ("jee" "ጄ") ("Jee" "ጄ")
+ ("j" ?ጅ) ("J" "ጅ")
+ ("jo" ?ጆ) ("Jo" "ጆ")
+ ("jWa" ?ጇ) ("jW" "ጇ") ("JWa" "ጇ") ("JW" "ጇ")
+
+ ("ge" ?ገ)
+ ("gu" ?ጉ)
+ ("gi" ?ጊ)
+ ("ga" ?ጋ)
+ ("gE" ?ጌ) ("gee" "ጌ")
+ ("g" ?áŒ)
+ ("go" ?ጎ)
+ ("gWe" ?áŒ)
+ ("gWi" ?ጒ)
+ ("gWa" ?ጓ) ("gW" "ጓ")
+ ("gWE" ?ጔ) ("gWee" "ጔ")
+ ("gW'" ?ጕ) ("gWu" "ጕ")
+
+ ("Ge" ?ጘ)
+ ("Gu" ?ጙ)
+ ("Gi" ?ጚ)
+ ("Ga" ?ጛ)
+ ("GE" ?ጜ) ("Gee" "ጜ")
+ ("G" ?áŒ)
+ ("Go" ?ጞ)
+
+ ("Te" ?ጠ)
+ ("Tu" ?ጡ)
+ ("Ti" ?ጢ)
+ ("Ta" ?ጣ)
+ ("TE" ?ጤ) ("Tee" "ጤ")
+ ("T" ?ጥ)
+ ("To" ?ጦ)
+ ("TWa" ?ጧ) ("TW" "ጧ")
+
+ ("Ce" ?ጨ)
+ ("Cu" ?ጩ)
+ ("Ci" ?ጪ)
+ ("Ca" ?ጫ)
+ ("CE" ?ጬ) ("Cee" "ጬ")
+ ("C" ?áŒ)
+ ("Co" ?ጮ)
+ ("CWa" ?ጯ) ("CW" "ጯ")
+
+ ("Pe" ?ጰ)
+ ("Pu" ?ጱ)
+ ("Pi" ?ጲ)
+ ("Pa" ?ጳ)
+ ("PE" ?ጴ) ("Pee" "ጴ")
+ ("P" ?ጵ)
+ ("Po" ?ጶ)
+ ("PWa" ?ጷ) ("PW" "ጷ")
+
+ ("Se" ?ጸ)
+ ("Su" ?ጹ)
+ ("Si" ?ጺ)
+ ("Sa" ?ጻ)
+ ("SE" ?ጼ) ("See" "ጼ")
+ ("S" ?ጽ)
+ ("So" ?ጾ)
+ ("SWa" ?ጿ) ("`SWa" "ጿ") ("SSWa" "ጿ") ("S2Wa" "ጿ")
+ ("SW" "ጿ") ("`SW" "ጿ") ("SSW" "ጿ") ("S2W" "ጿ")
+
+ ("`Se" ?á€) ("SSe" "á€") ("S2e" "á€")
+ ("`Su" ?á) ("SSu" "á") ("S2u" "á")
+ ("`Si" ?á‚) ("SSi" "á‚") ("S2i" "á‚")
+ ("`Sa" ?áƒ) ("SSa" "áƒ") ("S2a" "áƒ")
+ ("`SE" ?á„) ("SSE" "á„") ("S2E" "á„")
+ ("`See" "á„") ("SSee" "á„") ("S2ee" "á„")
+ ("`S" ?á…) ("SS" "á…") ("S2" "á…")
+ ("`So" ?á†) ("SSo" "á†") ("S2o" "á†")
+
+ ("fe" ?áˆ) ("Fe" "áˆ")
+ ("fu" ?á‰) ("Fu" "á‰")
+ ("fi" ?áŠ) ("Fi" "áŠ")
+ ("fa" ?á‹) ("Fa" "á‹")
+ ("fE" ?áŒ) ("FE" "áŒ") ("fee" "áŒ") ("Fee" "áŒ")
+ ("f" ?á) ("F" "á")
+ ("fo" ?áŽ) ("Fo" "áŽ")
+ ("fWa" ?á) ("FWa" "á") ("fW" "á") ("FW" "á")
+
+ ("pe" ?á)
+ ("pu" ?á‘)
+ ("pi" ?á’)
+ ("pa" ?á“)
+ ("pE" ?á”) ("pee" "á”")
+ ("p" ?á•)
+ ("po" ?á–)
+ ("pWa" ?á—) ("pW" "á—")
+
+ ("rYa" ?á˜) ("RYa" "á˜") ("rY" "á˜") ("RY" "á˜")
+ ("mYa" ?á™) ("MYa" "á™") ("mY" "á™") ("MY" "á™")
+ ("fYa" ?áš) ("FYa" "áš") ("fY" "áš") ("FY" "áš")
+
+ (" : " ?á¡) (":" "á¡") ("`:" "á¡")
+ ("::" ?á¢) ("." "á¢")
+ ("," ?á£)
+ (";" ?á¤)
+ ("-:" ?á¥)
+ (":-" ?á¦)
+ ("`?" ?á§) ("??" "á§")
+ (":|:" ?á¨) ("**" "á¨")
+
+ ;; Explicit syllable delimiter
+ ("'" "")
+
+ ;; Quick ASCII input
+ ("''" "'")
+ (":::" ":")
+ (".." ".")
+ (",," ",")
+ (";;" ";")
+
+ ("`1" ?á©)
+ ("`2" ?áª)
+ ("`3" ?á«)
+ ("`4" ?á¬)
+ ("`5" ?á)
+ ("`6" ?á®)
+ ("`7" ?á¯)
+ ("`8" ?á°)
+ ("`9" ?á±)
+ ("`10" ?á²)
+ ("`20" ?á³)
+ ("`30" ?á´)
+ ("`40" ?áµ)
+ ("`50" ?á¶)
+ ("`60" ?á·)
+ ("`70" ?á¸)
+ ("`80" ?á¹)
+ ("`90" ?áº)
+ ("`100" ?á»)
+ ("`10000" ?á¼)
+
+ ("`200" "áªá»")
+ ("`300" "á«á»")
+ ("`400" "á¬á»")
+ ("`500" "áá»")
+ ("`600" "á®á»")
+ ("`700" "á¯á»")
+ ("`800" "á°á»")
+ ("`900" "á±á»")
+ ("`1000" "á²á»")
+ ("`2000" "á³á»")
+ ("`3000" "á´á»")
+ ("`4000" "áµá»")
+ ("`5000" "á¶á»")
+ ("`6000" "á·á»")
+ ("`7000" "á¸á»")
+ ("`8000" "á¹á»")
+ ("`9000" "áºá»")
+ ("`20000" "áªá¼")
+ ("`30000" "á«á¼")
+ ("`40000" "á¬á¼")
+ ("`50000" "áá¼")
+ ("`60000" "á®á¼")
+ ("`70000" "á¯á¼")
+ ("`80000" "á°á¼")
+ ("`90000" "á±á¼")
+ ("`100000" "á²á¼")
+ ("`200000" "á³á¼")
+ ("`300000" "á´á¼")
+ ("`400000" "áµá¼")
+ ("`500000" "á¶á¼")
+ ("`600000" "á·á¼")
+ ("`700000" "á¸á¼")
+ ("`800000" "á¹á¼")
+ ("`900000" "áºá¼")
+ ("`1000000" "á»á¼")
+ )
+
+(register-input-method
+ "ethiopic-sera" "Ethiopic"
+ 'robin-use-package "et" "An input method for Ethiopic.")
+
+(robin-define-package "ethiopic-tex"
+ "TeX transliteration system for Ethiopic."
+
+ ("\\heG" ?ሀ) ; U+1200 ..
+ ("\\huG" ?áˆ)
+ ("\\hiG" ?ሂ)
+ ("\\haG" ?ሃ)
+ ("\\hEG" ?ሄ)
+ ("\\hG" ?ህ)
+ ("\\hoG" ?ሆ)
+ ;; reserved
+ ("\\leG" ?ለ)
+ ("\\luG" ?ሉ)
+ ("\\liG" ?ሊ)
+ ("\\laG" ?ላ)
+ ("\\lEG" ?ሌ)
+ ("\\lG" ?áˆ)
+ ("\\loG" ?ሎ)
+ ("\\lWaG" ?áˆ)
+
+ ("\\HeG" ?áˆ) ; U+1210 ..
+ ("\\HuG" ?ሑ)
+ ("\\HiG" ?ሒ)
+ ("\\HaG" ?ሓ)
+ ("\\HEG" ?ሔ)
+ ("\\HG" ?ሕ)
+ ("\\HoG" ?ሖ)
+ ("\\HWaG" ?ሗ)
+ ("\\meG" ?መ)
+ ("\\muG" ?ሙ)
+ ("\\miG" ?ሚ)
+ ("\\maG" ?ማ)
+ ("\\mEG" ?ሜ)
+ ("\\mG" ?áˆ)
+ ("\\moG" ?ሞ)
+ ("\\mWaG" ?ሟ)
+
+ ("\\sseG" ?ሠ) ; U+1220 ..
+ ("\\ssuG" ?ሡ)
+ ("\\ssiG" ?ሢ)
+ ("\\ssaG" ?ሣ)
+ ("\\ssEG" ?ሤ)
+ ("\\ssG" ?ሥ)
+ ("\\ssoG" ?ሦ)
+ ("\\ssWaG" ?ሧ)
+ ("\\reG" ?ረ)
+ ("\\ruG" ?ሩ)
+ ("\\riG" ?ሪ)
+ ("\\raG" ?ራ)
+ ("\\rEG" ?ሬ)
+ ("\\rG" ?áˆ)
+ ("\\roG" ?ሮ)
+ ("\\rWaG" ?ሯ)
+
+ ("\\seG" ?ሰ) ; U+1230 ..
+ ("\\suG" ?ሱ)
+ ("\\siG" ?ሲ)
+ ("\\saG" ?ሳ)
+ ("\\sEG" ?ሴ)
+ ("\\sG" ?ስ)
+ ("\\soG" ?ሶ)
+ ("\\sWaG" ?ሷ)
+ ("\\xeG" ?ሸ)
+ ("\\xuG" ?ሹ)
+ ("\\xiG" ?ሺ)
+ ("\\xaG" ?ሻ)
+ ("\\xEG" ?ሼ)
+ ("\\xG" ?ሽ)
+ ("\\xoG" ?ሾ)
+ ("\\xWaG" ?ሿ)
+
+ ("\\qeG" ?ቀ) ; U+1240 ..
+ ("\\quG" ?á‰)
+ ("\\qiG" ?ቂ)
+ ("\\qaG" ?ቃ)
+ ("\\qEG" ?ቄ)
+ ("\\qG" ?ቅ)
+ ("\\qoG" ?ቆ)
+ ;; reserved
+ ("\\qWeG" ?ቈ)
+ ;; reserved
+ ("\\qWiG" ?ቊ)
+ ("\\qWaG" ?ቋ)
+ ("\\qWEG" ?ቌ)
+ ("\\qWG" ?á‰)
+ ;; reserved
+ ;; reserved
+
+ ("\\QeG" ?á‰) ; U+1250 ..
+ ("\\QuG" ?ቑ)
+ ("\\QiG" ?ቒ)
+ ("\\QaG" ?ቓ)
+ ("\\QEG" ?ቔ)
+ ("\\QG" ?ቕ)
+ ("\\QoG" ?ቖ)
+ ;; reserved
+ ("\\QWeG" ?ቘ)
+ ;; reserved
+ ("\\QWiG" ?ቚ)
+ ("\\QWaG" ?ቛ)
+ ("\\QWEG" ?ቜ)
+ ("\\QWG" ?á‰)
+ ;; reserved
+ ;; reserved
+
+ ("\\beG" ?በ) ; U+1260 ..
+ ("\\buG" ?ቡ)
+ ("\\biG" ?ቢ)
+ ("\\baG" ?ባ)
+ ("\\bEG" ?ቤ)
+ ("\\bG" ?ብ)
+ ("\\boG" ?ቦ)
+ ("\\bWaG" ?ቧ)
+ ("\\veG" ?ቨ)
+ ("\\vuG" ?ቩ)
+ ("\\viG" ?ቪ)
+ ("\\vaG" ?ቫ)
+ ("\\vEG" ?ቬ)
+ ("\\vG" ?á‰)
+ ("\\voG" ?ቮ)
+ ("\\vWaG" ?ቯ)
+
+ ("\\teG" ?ተ) ; U+1270 ..
+ ("\\tuG" ?ቱ)
+ ("\\tiG" ?ቲ)
+ ("\\taG" ?ታ)
+ ("\\tEG" ?ቴ)
+ ("\\tG" ?ት)
+ ("\\toG" ?ቶ)
+ ("\\tWaG" ?ቷ)
+ ("\\ceG" ?ቸ)
+ ("\\cuG" ?ቹ)
+ ("\\ciG" ?ቺ)
+ ("\\caG" ?ቻ)
+ ("\\cEG" ?ቼ)
+ ("\\cG" ?ች)
+ ("\\coG" ?ቾ)
+ ("\\cWaG" ?ቿ)
+
+ ("\\hheG" ?ኀ) ; U+1280 ..
+ ("\\hhuG" ?áŠ)
+ ("\\hhiG" ?ኂ)
+ ("\\hhaG" ?ኃ)
+ ("\\hhEG" ?ኄ)
+ ("\\hhG" ?ኅ)
+ ("\\hhoG" ?ኆ)
+ ;; reserved
+ ("\\hWeG" ?ኈ)
+ ;; reserved
+ ("\\hWiG" ?ኊ)
+ ("\\hWaG" ?ኋ)
+ ("\\hWEG" ?ኌ)
+ ("\\hWG" ?áŠ)
+ ;; reserved
+ ;; reserved
+
+ ("\\neG" ?áŠ) ; U+1290 ..
+ ("\\nuG" ?ኑ)
+ ("\\niG" ?ኒ)
+ ("\\naG" ?ና)
+ ("\\nEG" ?ኔ)
+ ("\\nG" ?ን)
+ ("\\noG" ?ኖ)
+ ("\\nWaG" ?ኗ)
+ ("\\NeG" ?ኘ)
+ ("\\NuG" ?ኙ)
+ ("\\NiG" ?ኚ)
+ ("\\NaG" ?ኛ)
+ ("\\NEG" ?ኜ)
+ ("\\NG" ?áŠ)
+ ("\\NoG" ?ኞ)
+ ("\\NWaG" ?ኟ)
+
+ ("\\eG" ?አ) ; U+12A0 ..
+ ("\\uG" ?ኡ)
+ ("\\iG" ?ኢ)
+ ("\\AG" ?ኣ)
+ ("\\EG" ?ኤ)
+ ("\\IG" ?እ)
+ ("\\oG" ?ኦ)
+ ("\\eaG" ?ኧ)
+ ("\\keG" ?ከ)
+ ("\\kuG" ?ኩ)
+ ("\\kiG" ?ኪ)
+ ("\\kaG" ?ካ)
+ ("\\kEG" ?ኬ)
+ ("\\kG" ?áŠ)
+ ("\\koG" ?ኮ)
+ ;; reserved
+
+ ("\\kWeG" ?ኰ) ; U+12B0 ..
+ ;; reserved
+ ("\\kWiG" ?ኲ)
+ ("\\kWaG" ?ኳ)
+ ("\\kWEG" ?ኴ)
+ ("\\kWG" ?ኵ)
+ ;; reserved
+ ;; reserved
+ ("\\KeG" ?ኸ)
+ ("\\KuG" ?ኹ)
+ ("\\KiG" ?ኺ)
+ ("\\KaG" ?ኻ)
+ ("\\KEG" ?ኼ)
+ ("\\KG" ?ኽ)
+ ("\\KoG" ?ኾ)
+ ;; reserved
+
+ ("\\KWeG" ?á‹€) ; U+12C0 ..
+ ;; reserved
+ ("\\KWiG" ?á‹‚)
+ ("\\KWaG" ?ዃ)
+ ("\\KWEG" ?á‹„)
+ ("\\KWG" ?á‹…)
+ ;; reserved
+ ;; reserved
+ ("\\weG" ?ወ)
+ ("\\wuG" ?ዉ)
+ ("\\wiG" ?á‹Š)
+ ("\\waG" ?á‹‹)
+ ("\\wEG" ?ዌ)
+ ("\\wG" ?á‹)
+ ("\\woG" ?á‹Ž)
+ ;; reserved
+
+ ("\\eeG" ?á‹) ; U+12D0 ..
+ ("\\uuG" ?á‹‘)
+ ("\\iiG" ?á‹’)
+ ("\\aaG" ?á‹“)
+ ("\\EEG" ?á‹”)
+ ("\\IIG" ?á‹•)
+ ("\\ooG" ?á‹–)
+ ;; reserved
+ ("\\zeG" ?ዘ)
+ ("\\zuG" ?á‹™)
+ ("\\ziG" ?á‹š)
+ ("\\zaG" ?á‹›)
+ ("\\zEG" ?ዜ)
+ ("\\zG" ?á‹)
+ ("\\zoG" ?á‹ž)
+ ("\\zWaG" ?á‹Ÿ)
+
+ ("\\ZeG" ?á‹ ) ; U+12E0 ..
+ ("\\ZuG" ?á‹¡)
+ ("\\ZiG" ?á‹¢)
+ ("\\ZaG" ?á‹£)
+ ("\\ZEG" ?ዤ)
+ ("\\ZG" ?á‹¥)
+ ("\\ZoG" ?ዦ)
+ ("\\ZWaG" ?ዧ)
+ ("\\yeG" ?የ)
+ ("\\yuG" ?á‹©)
+ ("\\yiG" ?ዪ)
+ ("\\yaG" ?á‹«)
+ ("\\yEG" ?ዬ)
+ ("\\yG" ?á‹)
+ ("\\yoG" ?á‹®)
+ ;; reserved
+
+ ("\\deG" ?á‹°) ; U+12F0 ..
+ ("\\duG" ?ዱ)
+ ("\\diG" ?ዲ)
+ ("\\daG" ?ዳ)
+ ("\\dEG" ?á‹´)
+ ("\\dG" ?ድ)
+ ("\\doG" ?ዶ)
+ ("\\dWaG" ?á‹·)
+ ("\\DeG" ?ዸ)
+ ("\\DuG" ?ዹ)
+ ("\\DiG" ?ዺ)
+ ("\\DaG" ?á‹»)
+ ("\\DEG" ?ዼ)
+ ("\\DG" ?ዽ)
+ ("\\DoG" ?ዾ)
+ ("\\DWaG" ?á‹¿)
+
+ ("\\jeG" ?ጀ) ; U+1300 ..
+ ("\\juG" ?áŒ)
+ ("\\jiG" ?ጂ)
+ ("\\jaG" ?ጃ)
+ ("\\jEG" ?ጄ)
+ ("\\jG" ?ጅ)
+ ("\\joG" ?ጆ)
+ ("\\jWaG" ?ጇ)
+ ("\\geG" ?ገ)
+ ("\\guG" ?ጉ)
+ ("\\giG" ?ጊ)
+ ("\\gaG" ?ጋ)
+ ("\\gEG" ?ጌ)
+ ("\\gG" ?áŒ)
+ ("\\goG" ?ጎ)
+ ;; reserved
+
+ ("\\gWeG" ?áŒ) ; U+1310 ..
+ ;; reserved
+ ("\\gWiG" ?ጒ)
+ ("\\gWaG" ?ጓ)
+ ("\\gWEG" ?ጔ)
+ ("\\gWG" ?ጕ)
+ ;; reserved
+ ;; reserved
+ ("\\GeG" ?ጘ)
+ ("\\GuG" ?ጙ)
+ ("\\GiG" ?ጚ)
+ ("\\GaG" ?ጛ)
+ ("\\GEG" ?ጜ)
+ ("\\GG" ?áŒ)
+ ("\\GoG" ?ጞ)
+ ;; reserved
+
+ ("\\TeG" ?ጠ) ; U+1320 ..
+ ("\\TuG" ?ጡ)
+ ("\\TiG" ?ጢ)
+ ("\\TaG" ?ጣ)
+ ("\\TEG" ?ጤ)
+ ("\\TG" ?ጥ)
+ ("\\ToG" ?ጦ)
+ ("\\TWaG" ?ጧ)
+ ("\\CeG" ?ጨ)
+ ("\\CuG" ?ጩ)
+ ("\\CiG" ?ጪ)
+ ("\\CaG" ?ጫ)
+ ("\\CEG" ?ጬ)
+ ("\\CG" ?áŒ)
+ ("\\CoG" ?ጮ)
+ ("\\CWaG" ?ጯ)
+
+ ("\\PeG" ?ጰ) ; U+1330 ..
+ ("\\PuG" ?ጱ)
+ ("\\PiG" ?ጲ)
+ ("\\PaG" ?ጳ)
+ ("\\PEG" ?ጴ)
+ ("\\PG" ?ጵ)
+ ("\\PoG" ?ጶ)
+ ("\\PWaG" ?ጷ)
+ ("\\SeG" ?ጸ)
+ ("\\SuG" ?ጹ)
+ ("\\SiG" ?ጺ)
+ ("\\SaG" ?ጻ)
+ ("\\SEG" ?ጼ)
+ ("\\SG" ?ጽ)
+ ("\\SoG" ?ጾ)
+ ("\\SWaG" ?ጿ)
+
+ ("\\SSeG" ?á€) ; U+1340 ..
+ ("\\SSuG" ?á)
+ ("\\SSiG" ?á‚)
+ ("\\SSaG" ?áƒ)
+ ("\\SSEG" ?á„)
+ ("\\SSG" ?á…)
+ ("\\SSoG" ?á†)
+ ;; reserved
+ ("\\feG" ?áˆ)
+ ("\\fuG" ?á‰)
+ ("\\fiG" ?áŠ)
+ ("\\faG" ?á‹)
+ ("\\fEG" ?áŒ)
+ ("\\fG" ?á)
+ ("\\foG" ?áŽ)
+ ("\\fWaG" ?á)
+
+ ("\\peG" ?á) ; U+1350 ..
+ ("\\puG" ?á‘)
+ ("\\piG" ?á’)
+ ("\\paG" ?á“)
+ ("\\pEG" ?á”)
+ ("\\pG" ?á•)
+ ("\\poG" ?á–)
+ ("\\pWaG" ?á—)
+ ("\\mYaG" ?á˜)
+ ("\\rYaG" ?á™)
+ ("\\fYaG" ?áš)
+ ;; reserved
+ ;; reserved
+ ;; reserved
+ ;; reserved
+ ;; reserved
+
+ ;; reserved ; U+1360 ..
+ ("\\spaceG" ?á¡)
+ ("\\periodG" ?á¢)
+ ("\\commaG" ?á£)
+ ("\\semicolonG" ?á¤)
+ ("\\colonG" ?á¥)
+ ("\\precolonG" ?á¦)
+ ("\\oldqmarkG" ?á§)
+ ("\\pbreakG" ?á¨)
+ ("\\andG" ?á©)
+ ("\\huletG" ?áª)
+ ("\\sostG" ?á«)
+ ("\\aratG" ?á¬)
+ ("\\amstG" ?á)
+ ("\\sadstG" ?á®)
+ ("\\sabatG" ?á¯)
+
+ ("\\smntG" ?á°) ; U+1370 ..
+ ("\\zeteNG" ?á±)
+ ("\\asrG" ?á²)
+ ("\\heyaG" ?á³)
+ ("\\selasaG" ?á´)
+ ("\\arbaG" ?áµ)
+ ("\\hemsaG" ?á¶)
+ ("\\slsaG" ?á·)
+ ("\\sebaG" ?á¸)
+ ("\\semanyaG" ?á¹)
+ ("\\zeTanaG" ?áº)
+ ("\\metoG" ?á»)
+ ("\\asrxiG" ?á¼)
+ ;; reserved
+ ;; reserved
+ ;; reserved
+
+ ;;
+ ;; private extension
+ ;;
+
+ ("\\yWaG" ?ö ƒ¯) ; U+1A00EF (was U+12EF)
+
+ ("\\GWaG" ?ö „Ÿ) ; U+1A011F (was U+131F)
+
+ ("\\qqeG" ?ö †€) ; U+1A0180 .. (was U+1380 ..)
+ ("\\qquG" ?ö †)
+ ("\\qqiG" ?ö †‚)
+ ("\\qqaG" ?ö †ƒ)
+ ("\\qqEG" ?ö †„)
+ ("\\qqG" ?ö †…)
+ ("\\qqoG" ?ö ††)
+ ;; unused
+ ("\\MWeG" ?ö †ˆ)
+ ("\\bWeG" ?ö †‰)
+ ("\\GWeG" ?ö †Š)
+ ("\\fWeG" ?ö †‹)
+ ("\\pWeG" ?ö †Œ)
+ ;; unused
+ ;; unused
+ ;; unused
+
+ ("\\kkeG" ?ö †) ; U+1A0190 .. (was U+1390 ..)
+ ("\\kkuG" ?ö †‘)
+ ("\\kkiG" ?ö †’)
+ ("\\kkaG" ?ö †“)
+ ("\\kkEG" ?ö †”)
+ ("\\kkG" ?ö †•)
+ ("\\kkoG" ?ö †–)
+ ;; unused
+ ("\\mWiG" ?ö †˜)
+ ("\\bWiG" ?ö †™)
+ ("\\GWiG" ?ö †š)
+ ("\\fWiG" ?ö †›)
+ ("\\pWiG" ?ö †œ)
+ ;; unused
+ ;; unused
+ ;; unused
+
+ ("\\XeG" ?ö † ) ; U+1A01A0 .. (was U+13A0 ..)
+ ("\\XuG" ?ö †¡)
+ ("\\XiG" ?ö †¢)
+ ("\\XaG" ?ö †£)
+ ("\\XEG" ?ö †¤)
+ ("\\XG" ?ö †¥)
+ ("\\XoG" ?ö †¦)
+ ;; unused
+ ("\\mWEG" ?ö †¨)
+ ("\\bWEG" ?ö †©)
+ ("\\GWEG" ?ö †ª)
+ ("\\fWEG" ?ö †«)
+ ("\\pWEG" ?ö †¬)
+ ;; unused
+ ;; unused
+ ;; unused
+
+ ("\\ggeG" ?ö †°) ; U+1A01B0 .. (was U+13B0 ..)
+ ("\\gguG" ?ö †±)
+ ("\\ggiG" ?ö †²)
+ ("\\ggaG" ?ö †³)
+ ("\\ggEG" ?ö †´)
+ ("\\ggG" ?ö †µ)
+ ("\\ggoG" ?ö †¶)
+ ;; unused
+ ("\\mWG" ?ö †¸)
+ ("\\bWG" ?ö †¹)
+ ("\\GWG" ?ö †º)
+ ("\\fWG" ?ö †»)
+ ("\\pWG" ?ö †¼)
+ ;; unused
+ ;; unused
+ ;; unused
+
+ ("\\ornamentG" ?ö ‡€) ; U+1A01C0 .. (was U+FDF0 ..)
+ ("\\flandG" ?ö ‡)
+ ("\\iflandG" ?ö ‡‚)
+ ("\\africaG" ?ö ‡ƒ)
+ ("\\iafricaG" ?ö ‡„)
+ ("\\wWeG" ?ö ‡…)
+ ("\\wWiG" ?ö ‡†)
+ ("\\wWaG" ?ö ‡‡)
+ ("\\wWEG" ?ö ‡ˆ)
+ ("\\wWG" ?ö ‡‰)
+ ;; Gemination (ö ‡Š) is handled in a special way.
+ ("\\slaqG" ?ö ‡‹)
+
+ ;; Assign reverse conversion to Fidel chars.
+ ;; Then override forward conversion with ASCII chars.
+ ;; ASCII chars should not have reverse conversions.
+ ("\\dotG" ?ö ‡Œ) ("\\dotG" ".")
+ ("\\lquoteG" ?ö ‡) ("\\lquoteG" "«")
+ ("\\rquoteG" ?ö ‡Ž) ("\\rquoteG" "»")
+ ("\\qmarkG" ?ö ‡) ("\\qmarkG" "?")
+
+ ;;
+ ;; New characters in Unicode 4.1.
+ ;;
+ ;; In forward conversion, these characters override the old private
+ ;; extensions above. The old private extensions still keep their
+ ;; reverse conversion.
+ ;;
+
+ ("\\ornamentG" ?á )
+ ("\\yWaG" ?ዯ)
+ ("\\GWaG" ?ጟ)
+ ("\\MWeG" ?ᎀ)
+ ("\\mWiG" ?áŽ)
+ ("\\mWEG" ?ᎂ)
+ ("\\mWG" ?ᎃ)
+ ("\\bWeG" ?ᎄ)
+ ("\\bWiG" ?ᎅ)
+ ("\\bWEG" ?ᎆ)
+ ("\\bWG" ?ᎇ)
+ ("\\fWeG" ?ᎈ)
+ ("\\fWiG" ?ᎉ)
+ ("\\fWEG" ?ᎊ)
+ ("\\fWG" ?ᎋ)
+ ("\\pWeG" ?ᎌ)
+ ("\\pWiG" ?áŽ)
+ ("\\pWEG" ?ᎎ)
+ ("\\pWG" ?áŽ)
+ ("\\GWeG" ?ⶓ)
+ ("\\GWiG" ?ⶔ)
+ ("\\GWEG" ?ⶕ)
+ ("\\GWG" ?ⶖ)
+ ("\\qqeG" ?â·€)
+ ("\\qquG" ?â·)
+ ("\\qqiG" ?â·‚)
+ ("\\qqaG" ?â·ƒ)
+ ("\\qqEG" ?â·„)
+ ("\\qqG" ?â·…)
+ ("\\qqoG" ?â·†)
+ ("\\kkeG" ?â·ˆ)
+ ("\\kkuG" ?â·‰)
+ ("\\kkiG" ?â·Š)
+ ("\\kkaG" ?â·‹)
+ ("\\kkEG" ?ⷌ)
+ ("\\kkG" ?â·)
+ ("\\kkoG" ?â·Ž)
+ ("\\XeG" ?â·)
+ ("\\XuG" ?â·‘)
+ ("\\XiG" ?â·’)
+ ("\\XaG" ?â·“)
+ ("\\XEG" ?â·”)
+ ("\\XG" ?â·•)
+ ("\\XoG" ?â·–)
+ ("\\ggeG" ?â·˜)
+ ("\\gguG" ?â·™)
+ ("\\ggiG" ?â·š)
+ ("\\ggaG" ?â·›)
+ ("\\ggEG" ?ⷜ)
+ ("\\ggG" ?â·)
+ ("\\ggoG" ?â·ž)
+ )
+
+;; The ethiopic-tex package is not used for keyboard input, therefore
+;; not registered with the register-input-method function.
-;;
(provide 'ethio-util)
+;;; ethio-util.el ends here
+
;;; arch-tag: c8feb3d6-39bf-4b0a-b6ef-26f03fbc8140
;;; ethio-util.el ends here
-;;; ethiopic.el --- support for Ethiopic -*- coding: iso-2022-7bit; -*-
+;;; ethiopic.el --- support for Ethiopic -*- coding: utf-8-emacs; -*-
- ;; Copyright (C) 1997, 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ ;; Copyright (C) 1997, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
;; Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- ;; 2005, 2006, 2007
+ ;; 2005, 2006, 2007, 2008
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
(r1 *= 94)
(r2 += r1)
(if (r2 < 256)
- (r1 = ?\x12)
+ (r1 = #x12)
(if (r2 < 448)
- ((r1 = ?\x13) (r2 -= 256))
- ((r1 = ?\xfd) (r2 -= 208))
+ ((r1 = #x13) (r2 -= 256))
+ ((r1 = #xfd) (r2 -= 208))
))))
"CCL program to encode an Ethiopic code to code point of Ethiopic font.")
"Ethiopic" '((setup-function . setup-ethiopic-environment-internal)
(exit-function . exit-ethiopic-environment)
(charset ethiopic)
- (coding-system iso-2022-7bit)
- (coding-priority iso-2022-7bit)
+ (coding-system utf-8-emacs)
+ (coding-priority utf-8-emacs)
(input-method . "ethiopic")
(features ethio-util)
- (sample-text . "\e$(3$Q#U!.\e(B")
+ (sample-text . "áŠá‹°áˆ")
(documentation .
-"This language envrironment provides these function key bindings
- \(old bindings are shown in parentheses):
- [f3] ethio-fidel-to-sera-buffer (f5)
- [S-f3] ethio-fidel-to-sera-region (f5)
- [C-f3] ethio-fidel-to-sera-mail-or-marker (f5)
-
- [f4] ethio-sera-to-fidel-buffer (unchanged)
- [S-f4] ethio-sera-to-fidel-region (unchanged)
- [C-f4] ethio-sera-to-fidel-mail-or-marker (unchanged)
-
- [S-f5] ethio-toggle-punctuation (f3)
- [S-f6] ethio-modify-vowel (f6)
- [S-f7] ethio-replace-space (f7)
- [S-f8] ethio-input-special-character (f8)
- [S-f9] ethio-replace-space (unchanged)
- [C-f9] ethio-toggle-space (f2)"
+"This language envrironment provides these function key bindings:
+ [f3] ethio-fidel-to-sera-buffer
+ [S-f3] ethio-fidel-to-sera-region
+ [C-f3] ethio-fidel-to-sera-marker
+
+ [f4] ethio-sera-to-fidel-buffer
+ [S-f4] ethio-sera-to-fidel-region
+ [C-f4] ethio-sera-to-fidel-marker
+
+ [S-f5] ethio-toggle-punctuation
+ [S-f6] ethio-modify-vowel
+ [S-f7] ethio-replace-space
+
+ [S-f9] ethio-replace-space
+ [C-f9] ethio-toggle-space"
)))
+;; For automatic composition
+(aset composition-function-table ?ö ‡Š 'ethio-composition-function)
+(aset composition-function-table ?០'ethio-composition-function)
+
(provide 'ethiopic)
;;; arch-tag: e81329d9-1286-43ba-92fd-54ce5c7b213c
;;; european.el --- support for European languages -*- coding: iso-2022-7bit; -*-
- ;; Copyright (C) 1997, 1998, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007
- ;; Free Software Foundation, Inc.
+ ;; Copyright (C) 1997, 1998, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
+ ;; 2008 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- ;; 2005, 2006, 2007
+ ;; 2005, 2006, 2007, 2008
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
+;; Copyright (C) 2003
+;; National Institute of Advanced Industrial Science and Technology (AIST)
+;; Registration Number H13PRO009
;; Keywords: multilingual, European
;; Latin-1 (ISO-8859-1)
(set-language-info-alist
- "Latin-1" '((charset ascii latin-iso8859-1)
- (coding-system iso-latin-1)
- (coding-priority iso-latin-1 windows-1252)
- (nonascii-translation . latin-iso8859-1)
- (unibyte-syntax . "latin-1")
+ "Latin-1" '((charset iso-8859-1)
+ (coding-system iso-latin-1 iso-latin-9 windows-1252)
+ (coding-priority iso-latin-1)
+ (nonascii-translation . iso-8859-1)
(unibyte-display . iso-latin-1)
(input-method . "latin-1-prefix")
(sample-text
- . "Hello, Hej, Tere, Hei, Bonjour, Gr\e,A|_\e(B Gott, Ciao, \e,A!\e(BHola!")
+ . "Hello, Hej, Tere, Hei, Bonjour, Gr\e$(D+d)N\e(B Gott, Ciao, \e$(D"B\e(BHola!")
(documentation . "\
This language environment is a generic one for the Latin-1 (ISO-8859-1)
character set which supports the following European languages:
Indonesian/Malay, Tagalog (Philippines), Swahili and Afrikaans."))
'("European"))
-(eval-and-compile
- (setq
- non-iso-charset-alist
- (cp-make-coding-system
- windows-1252
- [?\\e$,1tL\e(B nil ?\\e$,1rz\e(B ?\\e$,1!R\e(B ?\\e$,1r~\e(B ?\\e$,1s&\e(B ?\\e$,1s \e(B ?\\e$,1s!\e(B ?\\e$,1$f\e(B ?\\e$,1s0\e(B ?\\e$,1! \e(B ?\\e$,1s9\e(B ?\\e$,1 r\e(B nil ?\\e$,1!=\e(B nil nil
- ?\\e$,1rx\e(B ?\\e$,1ry\e(B ?\\e$,1r|\e(B ?\\e$,1r}\e(B ?\\e$,1s"\e(B ?\\e$,1rs\e(B ?\\e$,1rt\e(B ?\\e$,1$|\e(B ?\\e$,1ub\e(B ?\\e$,1!!\e(B ?\\e$,1s:\e(B ?\\e$,1 s\e(B nil ?\\e$,1!>\e(B ?\\e$,1!8\e(B ?\\e,A \e(B ?\\e,A!\e(B
- ?\\e,A"\e(B ?\\e,A#\e(B ?\\e,A$\e(B ?\\e,A%\e(B ?\\e,A&\e(B ?\\e,A'\e(B ?\\e,A(\e(B ?\\e,A)\e(B ?\\e,A*\e(B ?\\e,A+\e(B ?\\e,A,\e(B ?\\e,A-\e(B ?\\e,A.\e(B ?\\e,A/\e(B ?\\e,A0\e(B ?\\e,A1\e(B ?\\e,A2\e(B
- ?\\e,A3\e(B ?\\e,A4\e(B ?\\e,A5\e(B ?\\e,A6\e(B ?\\e,A7\e(B ?\\e,A8\e(B ?\\e,A9\e(B ?\\e,A:\e(B ?\\e,A;\e(B ?\\e,A<\e(B ?\\e,A=\e(B ?\\e,A>\e(B ?\\e,A?\e(B ?\\e,A@\e(B ?\\e,AA\e(B ?\\e,AB\e(B ?\\e,AC\e(B
- ?\\e,AD\e(B ?\\e,AE\e(B ?\\e,AF\e(B ?\\e,AG\e(B ?\\e,AH\e(B ?\\e,AI\e(B ?\\e,AJ\e(B ?\\e,AK\e(B ?\\e,AL\e(B ?\\e,AM\e(B ?\\e,AN\e(B ?\\e,AO\e(B ?\\e,AP\e(B ?\\e,AQ\e(B ?\\e,AR\e(B ?\\e,AS\e(B ?\\e,AT\e(B
- ?\\e,AU\e(B ?\\e,AV\e(B ?\\e,AW\e(B ?\\e,AX\e(B ?\\e,AY\e(B ?\\e,AZ\e(B ?\\e,A[\e(B ?\\e,A\\e(B ?\\e,A]\e(B ?\\e,A^\e(B ?\\e,A_\e(B ?\\e,A`\e(B ?\\e,Aa\e(B ?\\e,Ab\e(B ?\\e,Ac\e(B ?\\e,Ad\e(B ?\\e,Ae\e(B
- ?\\e,Af\e(B ?\\e,Ag\e(B ?\\e,Ah\e(B ?\\e,Ai\e(B ?\\e,Aj\e(B ?\\e,Ak\e(B ?\\e,Al\e(B ?\\e,Am\e(B ?\\e,An\e(B ?\\e,Ao\e(B ?\\e,Ap\e(B ?\\e,Aq\e(B ?\\e,Ar\e(B ?\\e,As\e(B ?\\e,At\e(B ?\\e,Au\e(B ?\\e,Av\e(B
- ?\\e,Aw\e(B ?\\e,Ax\e(B ?\\e,Ay\e(B ?\\e,Az\e(B ?\\e,A{\e(B ?\\e,A|\e(B ?\\e,A}\e(B ?\\e,A~\e(B ?\\e,A\7f\e(B])))
-
-(define-coding-system-alias 'cp1252 'windows-1252)
-
\f
;; Latin-2 (ISO-8859-2)
-(make-coding-system
- 'iso-latin-2 2 ?2
- "ISO 2022 based 8-bit encoding for Latin-2 (MIME:ISO-8859-2)."
- '(ascii latin-iso8859-2 nil nil
- nil nil nil nil nil nil nil nil nil nil nil t)
- '((safe-charsets ascii latin-iso8859-2)
- (mime-charset . iso-8859-2)))
+(define-coding-system 'iso-latin-2
+ "ISO 2022 based 8-bit encoding for Latin-2 (MIME:ISO-8859-2)."
+ :coding-type 'charset
+ :mnemonic ?2
+ :charset-list '(iso-8859-2)
+ :mime-charset 'iso-8859-2)
(define-coding-system-alias 'iso-8859-2 'iso-latin-2)
(define-coding-system-alias 'latin-2 'iso-latin-2)
(set-language-info-alist
- "Latin-2" '((charset ascii latin-iso8859-2)
- (coding-system iso-latin-2)
+ "Latin-2" '((charset iso-8859-2)
+ (coding-system iso-latin-2 windows-1250)
(coding-priority iso-latin-2)
- (nonascii-translation . latin-iso8859-2)
- (unibyte-syntax . "latin-2")
+ (nonascii-translation . iso-8859-2)
(unibyte-display . iso-latin-2)
(input-method . "latin-2-prefix")
(documentation . "\
We also have specific language environments for the following languages:
For Czech, \"Czech\".
For Croatian, \"Croatian\".
+ For Polish, \"Polish\".
For Romanian, \"Romanian\".
For Slovak, \"Slovak\"."))
'("European"))
\f
;; Latin-3 (ISO-8859-3)
-(make-coding-system
- 'iso-latin-3 2 ?3
- "ISO 2022 based 8-bit encoding for Latin-3 (MIME:ISO-8859-3)."
- '(ascii latin-iso8859-3 nil nil
- nil nil nil nil nil nil nil nil nil nil nil t)
- '((safe-charsets ascii latin-iso8859-3)
- (mime-charset . iso-8859-3)))
+(define-coding-system 'iso-latin-3
+ "ISO 2022 based 8-bit encoding for Latin-3 (MIME:ISO-8859-3)."
+ :coding-type 'charset
+ :mnemonic ?3
+ :charset-list '(iso-8859-3)
+ :mime-charset 'iso-8859-3)
(define-coding-system-alias 'iso-8859-3 'iso-latin-3)
(define-coding-system-alias 'latin-3 'iso-latin-3)
(set-language-info-alist
- "Latin-3" '((charset ascii latin-iso8859-3)
+ "Latin-3" '((charset iso-8859-3)
(coding-system iso-latin-3)
(coding-priority iso-latin-3)
- (nonascii-translation . latin-iso8859-3)
- (unibyte-syntax . "latin-3")
+ (nonascii-translation . iso-8859-3)
(unibyte-display . iso-latin-3)
(input-method . "latin-3-prefix")
(documentation . "\
\f
;; Latin-4 (ISO-8859-4)
-(make-coding-system
- 'iso-latin-4 2 ?4
- "ISO 2022 based 8-bit encoding for Latin-4 (MIME:ISO-8859-4)."
- '(ascii latin-iso8859-4 nil nil
- nil nil nil nil nil nil nil nil nil nil nil t)
- '((safe-charsets ascii latin-iso8859-4)
- (mime-charset . iso-8859-4)))
+(define-coding-system 'iso-latin-4
+ "ISO 2022 based 8-bit encoding for Latin-4 (MIME:ISO-8859-4)."
+ :coding-type 'charset
+ :mnemonic ?4
+ :charset-list '(iso-8859-4)
+ :mime-charset 'iso-8859-4)
(define-coding-system-alias 'iso-8859-4 'iso-latin-4)
(define-coding-system-alias 'latin-4 'iso-latin-4)
(set-language-info-alist
- "Latin-4" '((charset ascii latin-iso8859-4)
+ "Latin-4" '((charset iso-8859-4)
(coding-system iso-8859-4)
(coding-priority iso-8859-4)
- (nonascii-translation . latin-iso8859-4)
- (unibyte-syntax . "latin-4")
+ (nonascii-translation . iso-8859-4)
(unibyte-display . iso-8859-4)
(input-method . "latin-4-postfix")
(documentation . "\
\f
;; Latin-5 (ISO-8859-9)
-(make-coding-system
- 'iso-latin-5 2 ?9
- "ISO 2022 based 8-bit encoding for Latin-5 (MIME:ISO-8859-9)."
- '(ascii latin-iso8859-9 nil nil
- nil nil nil nil nil nil nil nil nil nil nil t)
- '((safe-charsets ascii latin-iso8859-9)
- (mime-charset . iso-8859-9)))
+(define-coding-system 'iso-latin-5
+ "ISO 2022 based 8-bit encoding for Latin-5 (MIME:ISO-8859-9)."
+ :coding-type 'charset
+ :mnemonic ?9
+ :charset-list '(iso-8859-9)
+ :mime-charset 'iso-8859-9)
(define-coding-system-alias 'iso-8859-9 'iso-latin-5)
(define-coding-system-alias 'latin-5 'iso-latin-5)
(set-language-info-alist
- "Latin-5" '((charset ascii latin-iso8859-9)
+ "Latin-5" '((charset iso-8859-9)
(coding-system iso-latin-5)
(coding-priority iso-latin-5)
- (nonascii-translation . latin-iso8859-9)
- (unibyte-syntax . "latin-5")
+ (nonascii-translation . iso-8859-9)
(unibyte-display . iso-latin-5)
(input-method . "latin-5-postfix")
- (documentation . "Support for Turkish language."))
+ (documentation . "Support for Latin-5.\
+See also the Turkish environment."))
'("European"))
\f
+;; Latin-6 (ISO-8859-10)
+
+(define-coding-system 'iso-latin-6
+ "ISO 2022 based 8-bit encoding for Latin-6 (MIME:ISO-8859-10)."
+ :coding-type 'charset
+ :mnemonic ?9
+ :charset-list '(iso-8859-10)
+ :mime-charset 'iso-8859-10)
+
+(define-coding-system-alias 'iso-8859-10 'iso-latin-6)
+(define-coding-system-alias 'latin-6 'iso-latin-6)
+
+(set-language-info-alist
+ "Latin-6" '((charset iso-8859-10)
+ (coding-system iso-latin-6)
+ (coding-priority iso-latin-6)
+ (nonascii-translation . iso-8859-10)
+ (unibyte-display . iso-latin-6)
+ ;; Fixme: input method.
+ (documentation . "Support for generic Latin-6 (Northern European)."))
+ '("European"))
+
+\f
+;; Latin-7 (ISO-8859-13)
+
+(define-coding-system 'iso-latin-7
+ "ISO 2022 based 8-bit encoding for Latin-7 (MIME:ISO-8859-13)."
+ :coding-type 'charset
+ :mnemonic ?9
+ :charset-list '(iso-8859-13)
+ :mime-charset 'iso-8859-13)
+
+(define-coding-system-alias 'iso-8859-13 'iso-latin-7)
+(define-coding-system-alias 'latin-7 'iso-latin-7)
+
+(set-language-info-alist
+ "Latin-7" '((charset iso-8859-13)
+ (coding-system iso-latin-7)
+ (coding-priority iso-latin-7)
+ (nonascii-translation . iso-8859-13)
+ (unibyte-display . iso-latin-7)
+ ;; Fixme: input method.
+ (documentation . "Support for generic Latin-7 (Baltic Rim)."))
+ '("European"))
+\f
;; Latin-8 (ISO-8859-14)
-(make-coding-system
- 'iso-latin-8 2 ?W ; `W' for `Welsh', since `C'
- ; for `Celtic' is taken.
- "ISO 2022 based 8-bit encoding for Latin-8 (MIME:ISO-8859-14)."
- '(ascii latin-iso8859-14 nil nil
- nil nil nil nil nil nil nil nil nil nil nil t t)
- '((safe-charsets ascii latin-iso8859-14)
- (mime-charset . iso-8859-14)))
+(define-coding-system 'iso-latin-8
+ "ISO 2022 based 8-bit encoding for Latin-8 (MIME:ISO-8859-14)."
+ :coding-type 'charset
+ ;; `W' for `Welsh', since `C' for `Celtic' is taken.
+ :mnemonic ?W
+ :charset-list '(iso-8859-14)
+ :mime-charset 'iso-8859-14)
(define-coding-system-alias 'iso-8859-14 'iso-latin-8)
(define-coding-system-alias 'latin-8 'iso-latin-8)
(set-language-info-alist
- "Latin-8" '((charset ascii latin-iso8859-14)
+ "Latin-8" '((charset iso-8859-14)
(coding-system iso-latin-8)
(coding-priority iso-latin-8)
- (nonascii-translation . latin-iso8859-14)
- (unibyte-syntax . "latin-8")
+ (nonascii-translation . iso-8859-14)
(unibyte-display . iso-latin-8)
(input-method . "latin-8-prefix")
;; Fixme: Welsh/Ga{e}lic greetings
- (sample-text . "\e,_"\e(B \e,_p\e(B \e,_^\e(B")
+ (sample-text . "\e,_"\e(B \e$(D+q\e(B \e$(D*t\e(B")
(documentation . "\
This language environment is a generic one for the Latin-8 (ISO-8859-14)
character set which supports the Celtic languages, including those not
\f
;; Latin-9 (ISO-8859-15)
-(make-coding-system
- 'iso-latin-9 2 ?0 ; `0' for `Latin-0'
- "ISO 2022 based 8-bit encoding for Latin-9 (MIME:ISO-8859-15)."
- '(ascii latin-iso8859-15 nil nil
- nil nil nil nil nil nil nil nil nil nil nil t t)
- '((safe-charsets ascii latin-iso8859-15)
- (mime-charset . iso-8859-15)))
+(define-coding-system 'iso-latin-9
+ "ISO 2022 based 8-bit encoding for Latin-9 (MIME:ISO-8859-15)."
+ :coding-type 'charset
+ ;; `0' for `Latin-0'
+ :mnemonic ?0
+ :charset-list '(iso-8859-15)
+ :mime-charset 'iso-8859-15)
(define-coding-system-alias 'iso-8859-15 'iso-latin-9)
(define-coding-system-alias 'latin-9 'iso-latin-9)
(define-coding-system-alias 'latin-0 'iso-latin-9)
(set-language-info-alist
- "Latin-9" '((charset ascii latin-iso8859-15)
+ "Latin-9" '((charset iso-8859-15)
(coding-system iso-latin-9)
(coding-priority iso-latin-9)
- (nonascii-translation . latin-iso8859-15)
- (unibyte-syntax . "latin-9")
+ (nonascii-translation . iso-8859-15)
(unibyte-display . iso-latin-9)
(input-method . "latin-9-prefix")
(sample-text
- . "AVE. \e,b&(48<=>\e(B \e,b$\e(B")
+ . "AVE. \e$(D*^+^*v+v)-)M*s\e(B \e$(Q)!\e(B")
(documentation . "\
This language environment is a generic one for the Latin-9 (ISO-8859-15)
character set which supports the same languages as Latin-1 with the
addition of the Euro sign and some additional French and Finnish letters.
Latin-9 is sometimes nicknamed `Latin-0'."))
'("European"))
+
+(set-language-info-alist
+ "Esperanto" '((tutorial . "TUTORIAL.eo")
+ (charset ascii latin-iso8859-3)
+ (coding-system iso-latin-3)
+ (coding-priority iso-latin-3)
+ (nonascii-translation . latin-iso8859-3)
+ (unibyte-syntax . "latin-3")
+ (unibyte-display . iso-latin-3)
+ (input-method . "latin-3-prefix")
+ (documentation . "Support for Esperanto with ISO-8859-3 character set."))
+ '("European"))
+
+\f
+(define-coding-system 'windows-1250
+ "windows-1250 (Central European) encoding (MIME: WINDOWS-1250)"
+ :coding-type 'charset
+ :mnemonic ?*
+ :charset-list '(windows-1250)
+ :mime-charset 'windows-1250)
+(define-coding-system-alias 'cp1250 'windows-1250)
+
+(define-coding-system 'windows-1252
+ "windows-1252 (Western European) encoding (MIME: WINDOWS-1252)"
+ :coding-type 'charset
+ :mnemonic ?*
+ :charset-list '(windows-1252)
+ :mime-charset 'windows-1252)
+(define-coding-system-alias 'cp1252 'windows-1252)
+
+(define-coding-system 'windows-1254
+ "windows-1254 (Turkish) encoding (MIME: WINDOWS-1254)"
+ :coding-type 'charset
+ :mnemonic ?*
+ :charset-list '(windows-1254)
+ :mime-charset 'windows-1254)
+(define-coding-system-alias 'cp1254 'windows-1254)
+
+(define-coding-system 'windows-1257
+ "windows-1257 (Baltic) encoding (MIME: WINDOWS-1257)"
+ :coding-type 'charset
+ :mnemonic ?*
+ :charset-list '(windows-1257)
+ :mime-charset 'windows-1257)
+(define-coding-system-alias 'cp1257 'windows-1257)
+
+(define-coding-system 'cp850
+ "DOS codepage 850 (Western European)"
+ :coding-type 'charset
+ :mnemonic ?D
+ :charset-list '(cp850)
+ :mime-charset 'cp850)
+(define-coding-system-alias 'ibm850 'cp850)
+
+(define-coding-system 'cp852
+ "DOS codepage 852 (Slavic)"
+ :coding-type 'charset
+ :mnemonic ?D
+ :charset-list '(cp852)
+ :mime-charset 'cp852)
+(define-coding-system-alias 'ibm852 'cp852)
+
+(define-coding-system 'cp857
+ "DOS codepage 857 (Turkish)"
+ :coding-type 'charset
+ :mnemonic ?D
+ :charset-list '(cp857)
+ :mime-charset 'cp857)
+(define-coding-system-alias 'ibm857 'cp857)
+
+(define-coding-system 'cp858
+ "Codepage 858 (Multilingual Latin I + Euro)"
+ :coding-type 'charset
+ :mnemonic ?D
+ :charset-list '(cp858)
+ :mime-charset 'cp858)
+
+(define-coding-system 'cp860
+ "DOS codepage 860 (Portuguese)"
+ :coding-type 'charset
+ :mnemonic ?D
+ :charset-list '(cp860)
+ :mime-charset 'cp860)
+(define-coding-system-alias 'ibm860 'cp860)
+
+(define-coding-system 'cp861
+ "DOS codepage 861 (Icelandic)"
+ :coding-type 'charset
+ :mnemonic ?D
+ :charset-list '(cp861)
+ :mime-charset 'cp861)
+(define-coding-system-alias 'ibm861 'cp861)
+
+(define-coding-system 'cp863
+ "DOS codepage 863 (French Canadian)"
+ :coding-type 'charset
+ :mnemonic ?D
+ :charset-list '(cp863)
+ :mime-charset 'cp863)
+(define-coding-system-alias 'ibm863 'cp863)
+
+(define-coding-system 'cp865
+ "DOS codepage 865 (Norwegian/Danish)"
+ :coding-type 'charset
+ :mnemonic ?D
+ :charset-list '(cp865)
+ :mime-charset 'cp865)
+(define-coding-system-alias 'ibm865 'cp865)
+
+(define-coding-system 'cp437
+ "DOS codepage 437"
+ :coding-type 'charset
+ :mnemonic ?D
+ :charset-list '(cp437)
+ :mime-charset 'cp437)
+(define-coding-system-alias 'ibm437 'cp437)
\f
(set-language-info-alist
"Dutch" '((tutorial . "TUTORIAL.nl")
- (charset ascii latin-iso8859-1)
+ (charset iso-8859-1)
(coding-system iso-latin-1 iso-latin-9)
(coding-priority iso-latin-1)
- (nonascii-translation . latin-iso8859-1)
- (unibyte-syntax . "latin-1")
+ (nonascii-translation . iso-8859-1)
(unibyte-display . iso-latin-1)
(input-method . "dutch")
(sample-text . "Er is een aantal manieren waarop je dit kan doen")
(set-language-info-alist
"German" '((tutorial . "TUTORIAL.de")
- (charset ascii latin-iso8859-1)
+ (charset iso-8859-1)
(coding-system iso-latin-1 iso-latin-9)
- (coding-priority iso-latin-1 windows-1252)
+ (coding-priority iso-latin-1)
+ (nonascii-translation . iso-8859-1)
(input-method . "german-postfix")
- (nonascii-translation . latin-iso8859-1)
- (unibyte-syntax . "latin-1")
(unibyte-display . iso-latin-1)
(sample-text . "\
German (Deutsch Nord) Guten Tag
-German (Deutsch S\e,A|\e(Bd) Gr\e,A|_\e(B Gott")
+German (Deutsch S\e$(D+d\e(Bd) Gr\e$(D+d)N\e(B Gott")
(documentation . "\
This language environment is almost the same as Latin-1,
but sets the default input method to \"german-postfix\".
(set-language-info-alist
"French" '((tutorial . "TUTORIAL.fr")
- (charset ascii latin-iso8859-1)
+ (charset iso-8859-1)
(coding-system iso-latin-1 iso-latin-9)
(coding-priority iso-latin-1)
- (nonascii-translation . latin-iso8859-1)
- (unibyte-syntax . "latin-1")
+ (nonascii-translation . iso-8859-1)
(unibyte-display . iso-latin-1)
(input-method . "latin-1-prefix")
- (sample-text . "French (Fran\e,Ag\e(Bais) Bonjour, Salut")
+ (sample-text . "French (Fran\e$(D+.\e(Bais) Bonjour, Salut")
(documentation . "\
This language environment is almost the same as Latin-1,
but it selects the French tutorial and input method."))
(set-language-info-alist
"Italian" '((tutorial . "TUTORIAL.it")
- (charset ascii latin-iso8859-1)
+ (charset iso-8859-1)
(coding-system iso-latin-1 iso-latin-9)
(coding-priority iso-latin-1)
- (nonascii-translation . latin-iso8859-1)
- (unibyte-syntax . "latin-1")
+ (nonascii-translation . iso-8859-1)
(unibyte-display . iso-latin-1)
(input-method . "italian-postfix")
(sample-text . "Salve, ciao!")
'("European"))
(set-language-info-alist
- "Slovenian" '((charset . (ascii latin-iso8859-2))
- (coding-system . (iso-8859-2))
+ "Slovenian" '((charset iso-8859-2)
+ (coding-system . (iso-8859-2 windows-1250))
(coding-priority . (iso-8859-2))
- (nonascii-translation . latin-iso8859-2)
+ (nonascii-translation . iso-8859-2)
(input-method . "slovenian")
- (unibyte-syntax . "latin-2")
(unibyte-display . iso-8859-2)
(tutorial . "TUTORIAL.sl")
- (sample-text . "\e,B.\e(Belimo vam uspe\e,B9\e(Ben dan!")
+ (sample-text . "\e$(D*v\e(Belimo vam uspe\e$(D+^\e(Ben dan!")
(documentation . "\
This language environment is almost the same as Latin-2,
but it selects the Slovenian tutorial and input method."))
(set-language-info-alist
"Spanish" '((tutorial . "TUTORIAL.es")
- (charset ascii latin-iso8859-1)
+ (charset iso-8859-1)
(coding-system iso-latin-1 iso-latin-9)
(coding-priority iso-latin-1)
(input-method . "spanish-postfix")
- (nonascii-translation . latin-iso8859-1)
- (unibyte-syntax . "latin-1")
+ (nonascii-translation . iso-8859-1)
(unibyte-display . iso-latin-1)
- (sample-text . "Spanish (Espa\e,Aq\e(Bol) \e,A!\e(BHola!")
+ (sample-text . "Spanish (Espa\e$(D+P\e(Bol) \e$(D"B\e(BHola!")
(documentation . "\
This language environment is almost the same as Latin-1,
but it sets the default input method to \"spanish-postfix\",
;; "Latin-3" language environment.
(set-language-info-alist
- "Turkish" '((charset ascii latin-iso8859-9)
- (coding-system iso-latin-5 iso-latin-3)
+ "Turkish" '((charset iso-8859-9)
+ (coding-system iso-latin-5 windows-1254 iso-latin-3)
(coding-priority iso-latin-5)
- (nonascii-translation . latin-iso8859-9)
- (unibyte-syntax . "latin-5")
+ (nonascii-translation . iso-8859-9)
(unibyte-display . iso-latin-5)
(input-method . "turkish-postfix")
- (sample-text . "Turkish (T\e,M|\e(Brk\e,Mg\e(Be) Merhaba")
- (documentation . t)
+ (sample-text . "Turkish (T\e$(D+d\e(Brk\e$(D+.\e(Be) Merhaba")
(setup-function . turkish-case-conversion-enable)
- (exit-function . turkish-case-conversion-disable)))
+ (setup-function . turkish-case-conversion-disable)
+ (documentation . "Support for Turkish.
+Differs from the Latin-5 environment in using the `turkish-postfix' input
+method and applying Turkish case rules for the characters i, I, \e$(D)E\e(B, \e$(D*D\e(B.")))
(defun turkish-case-conversion-enable ()
- "Set up Turkish case conversion of `i' and `I' into `\e$,1 P\e(B' and `\e$,1 Q\e(B'."
+ "Set up Turkish case conversion of `i' and `I' into `\e$(D*D\e(B' and `\e$(D)E\e(B'."
(let ((table (standard-case-table)))
- (set-case-syntax-pair ?\e$,1 P\e(B ?i table)
- (set-case-syntax-pair ?I ?\e$,1 Q\e(B table)))
+ (set-case-syntax-pair ?\e$(D*D\e(B ?i table)
+ (set-case-syntax-pair ?I ?\e$(D)E\e(B table)))
(defun turkish-case-conversion-disable ()
"Set up normal (non-Turkish) case conversion of `i' into `I'."
(let ((table (standard-case-table)))
(set-case-syntax-pair ?I ?i table)
- (set-case-syntax ?\e$,1 P\e(B "w" table)
- (set-case-syntax ?\e$,1 Q\e(B "w" table)))
+ (set-case-syntax ?\e$(D*D\e(B "w" table)
+ (set-case-syntax ?\e$(D)E\e(B "w" table)))
;; Polish ISO 8859-2 environment.
;; Maintainer: Wlodek Bzyl <matwb@univ.gda.pl>
;; Keywords: multilingual, Polish
(set-language-info-alist
- "Polish" '((charset . (ascii latin-iso8859-2))
- (coding-system . (iso-8859-2))
- (coding-priority . (iso-8859-2))
+ "Polish" '((charset iso-8859-2)
+ (coding-system iso-8859-2 windows-1250)
+ (coding-priority iso-8859-2)
(input-method . "polish-slash")
- (nonascii-translation . latin-iso8859-2)
- (unibyte-syntax . "latin-2")
+ (nonascii-translation . iso-8859-2)
(unibyte-display . iso-8859-2)
(tutorial . "TUTORIAL.pl")
- (sample-text . "P\e,Bs\e(Bjd\e,B<\e(B, ki\e,Bq\e(B-\e,B?\e(Be t\e,Bj\e(B chmurno\e,B6f\e(B w g\e,B31\e(Bb flaszy")
+ (sample-text . "P\e$(D+Q\e(Bjd\e$(D+u\e(B, ki\e$(D+M\e(B-\e$(D+w\e(Be t\e$(D+8\e(B chmurno\e$(D+\++\e(B w g\e$(D)H+(\e(Bb flaszy")
(documentation . t))
'("European"))
(set-language-info-alist
"Welsh" `((coding-system utf-8 latin-8) ; the input method is Unicode-based
(coding-priority utf-8 latin-8)
- (nonascii-translation . latin-iso8859-14)
+ (nonascii-translation . iso-8859-14)
(input-method . "welsh")
(documentation . "Support for Welsh, using Unicode."))
'("European"))
(set-language-info-alist
"Latin-7" `((coding-system latin-7)
(coding-priority latin-7)
- (nonascii-translation . ,(get 'decode-iso-latin-7
- 'translation-table))
+ (nonascii-translation . iso-8859-13)
(input-method . "latin-prefix")
- (features code-pages)
(documentation . "Support for Latin-7, e.g. Latvian, Lithuanian."))
'("European"))
(set-language-info-alist
- "Lithuanian" `((coding-system latin-7)
+ "Lithuanian" `((coding-system latin-7 windows-1257)
(coding-priority latin-7)
+ (nonascii-translation . iso-8859-13)
(input-method . "lithuanian-keyboard")
- (nonascii-translation . ,(get 'decode-iso-latin-7
- 'translation-table))
- (features code-pages)
(documentation . "Support for Lithuanian."))
'("European"))
(set-language-info-alist
- "Latvian" `((coding-system latin-7)
+ "Latvian" `((coding-system latin-7 windows-1257)
(coding-priority latin-7)
+ (nonascii-translation . iso-8859-13)
(input-method . "latvian-keyboard")
- (nonascii-translation . ,(get 'decode-iso-latin-7
- 'translation-table))
- (features code-pages)
(documentation . "Support for Latvian."))
'("European"))
(set-language-info-alist
"Swedish" '((tutorial . "TUTORIAL.sv")
- (charset ascii latin-iso8859-1)
+ (charset iso-8859-1)
(coding-system iso-latin-1)
(coding-priority iso-latin-1)
- (nonascii-translation . latin-iso8859-1)
- (unibyte-syntax . "latin-1")
+ (nonascii-translation . iso-8859-1)
(unibyte-display . iso-latin-1)
(sample-text . "Goddag Hej")
(documentation . "Support for Swedish"))
'("European"))
(set-language-info-alist
- "Croatian" '((charset . (ascii latin-iso8859-2))
- (coding-system . (iso-8859-2))
- (coding-priority . (iso-8859-2))
+ "Croatian" '((charset iso-8859-2)
+ (coding-system iso-8859-2)
+ (coding-priority iso-8859-2)
(input-method . "croatian")
- (nonascii-translation . latin-iso8859-2)
- (unibyte-syntax . "latin-2")
+ (nonascii-translation . iso-8859-2)
(unibyte-display . iso-8859-2)
(documentation . "Support for Croatian with Latin-2 encoding."))
'("European"))
(set-language-info-alist
"Brazilian Portuguese" '((tutorial . "TUTORIAL.pt_BR")
- (charset ascii latin-iso8859-1)
+ (charset iso-8859-1)
(coding-system iso-latin-1 iso-latin-9)
(coding-priority iso-latin-1)
- (nonascii-translation . latin-iso8859-1)
- (unibyte-syntax . "latin-1")
- (unibyte-display . iso-latin-1)
+ (nonascii-translation . iso-8859-1)
+ (unibyte-display . iso-8859-1)
(input-method . "latin-1-prefix")
(sample-text . "Oi")
(documentation . "Support for Brazilian Portuguese."))
'("European"))
-(set-language-info-alist
- "Esperanto" '((tutorial . "TUTORIAL.eo")
- (charset ascii latin-iso8859-3)
- (coding-system iso-latin-3)
- (coding-priority iso-latin-3)
- (nonascii-translation . latin-iso8859-3)
- (unibyte-syntax . "latin-3")
- (unibyte-display . iso-latin-3)
- (input-method . "latin-3-prefix")
- (documentation . "Support for Esperanto with ISO-8859-3 character set."))
- '("European"))
+\f
+(define-coding-system 'mac-roman
+ "Mac Roman Encoding (MIME:MACINTOSH)."
+ :coding-type 'charset
+ :mnemonic ?M
+ :charset-list '(mac-roman)
+ :mime-charset 'macintosh)
+
+(define-coding-system 'next
+ "NeXTstep encoding"
+ :coding-type 'charset
+ :mnemonic ?*
+ :charset-list '(next)
+ :mime-charset 'next)
+
+(define-coding-system 'hp-roman8
+ "Hewlet-Packard roman-8 encoding (MIME:ROMAN-8)"
+ :coding-type 'charset
+ :mnemonic ?*
+ :charset-list '(hp-roman8)
+ :mime-charset 'hp-roman8)
+(define-coding-system-alias 'roman8 'hp-roman8)
+
+(define-coding-system 'adobe-standard-encoding
+ "Adobe `standard' encoding for PostScript"
+ :coding-type 'charset
+ :mnemonic ?*
+ :charset-list '(adobe-standard-encoding)
+ :mime-charset 'adobe-standard-encoding)
\f
-;; Definitions for the Mac Roman character sets and coding system.
-;; The Mac Roman encoding uses all 128 code points in the range 128 to
-;; 255 for actual characters. Emacs decodes them to one of the
-;; following character sets.
-;; ascii, latin-iso8859-1, mule-unicode-0100-24ff,
-;; mule-unicode-2500-33ff, mule-unicode-e000-ffff
-
-(let
- ((encoding-vector (make-vector 256 nil))
- (i 0)
- (vec ;; mac-roman (128..255) -> UCS mapping
- [ #x00C4 ;; 128:LATIN CAPITAL LETTER A WITH DIAERESIS
- #x00C5 ;; 129:LATIN CAPITAL LETTER A WITH RING ABOVE
- #x00C7 ;; 130:LATIN CAPITAL LETTER C WITH CEDILLA
- #x00C9 ;; 131:LATIN CAPITAL LETTER E WITH ACUTE
- #x00D1 ;; 132:LATIN CAPITAL LETTER N WITH TILDE
- #x00D6 ;; 133:LATIN CAPITAL LETTER O WITH DIAERESIS
- #x00DC ;; 134:LATIN CAPITAL LETTER U WITH DIAERESIS
- #x00E1 ;; 135:LATIN SMALL LETTER A WITH ACUTE
- #x00E0 ;; 136:LATIN SMALL LETTER A WITH GRAVE
- #x00E2 ;; 137:LATIN SMALL LETTER A WITH CIRCUMFLEX
- #x00E4 ;; 138:LATIN SMALL LETTER A WITH DIAERESIS
- #x00E3 ;; 139:LATIN SMALL LETTER A WITH TILDE
- #x00E5 ;; 140:LATIN SMALL LETTER A WITH RING ABOVE
- #x00E7 ;; 141:LATIN SMALL LETTER C WITH CEDILLA
- #x00E9 ;; 142:LATIN SMALL LETTER E WITH ACUTE
- #x00E8 ;; 143:LATIN SMALL LETTER E WITH GRAVE
- #x00EA ;; 144:LATIN SMALL LETTER E WITH CIRCUMFLEX
- #x00EB ;; 145:LATIN SMALL LETTER E WITH DIAERESIS
- #x00ED ;; 146:LATIN SMALL LETTER I WITH ACUTE
- #x00EC ;; 147:LATIN SMALL LETTER I WITH GRAVE
- #x00EE ;; 148:LATIN SMALL LETTER I WITH CIRCUMFLEX
- #x00EF ;; 149:LATIN SMALL LETTER I WITH DIAERESIS
- #x00F1 ;; 150:LATIN SMALL LETTER N WITH TILDE
- #x00F3 ;; 151:LATIN SMALL LETTER O WITH ACUTE
- #x00F2 ;; 152:LATIN SMALL LETTER O WITH GRAVE
- #x00F4 ;; 153:LATIN SMALL LETTER O WITH CIRCUMFLEX
- #x00F6 ;; 154:LATIN SMALL LETTER O WITH DIAERESIS
- #x00F5 ;; 155:LATIN SMALL LETTER O WITH TILDE
- #x00FA ;; 156:LATIN SMALL LETTER U WITH ACUTE
- #x00F9 ;; 157:LATIN SMALL LETTER U WITH GRAVE
- #x00FB ;; 158:LATIN SMALL LETTER U WITH CIRCUMFLEX
- #x00FC ;; 159:LATIN SMALL LETTER U WITH DIAERESIS
- #x2020 ;; 160:DAGGER
- #x00B0 ;; 161:DEGREE SIGN
- #x00A2 ;; 162:CENT SIGN
- #x00A3 ;; 163:POUND SIGN
- #x00A7 ;; 164:SECTION SIGN
- #x2022 ;; 165:BULLET
- #x00B6 ;; 166:PILCROW SIGN
- #x00DF ;; 167:LATIN SMALL LETTER SHARP S
- #x00AE ;; 168:REGISTERED SIGN
- #x00A9 ;; 169:COPYRIGHT SIGN
- #x2122 ;; 170:TRADE MARK SIGN
- #x00B4 ;; 171:ACUTE ACCENT
- #x00A8 ;; 172:DIAERESIS
- #x2260 ;; 173:NOT EQUAL TO
- #x00C6 ;; 174:LATIN CAPITAL LETTER AE
- #x00D8 ;; 175:LATIN CAPITAL LETTER O WITH STROKE
- #x221E ;; 176:INFINITY
- #x00B1 ;; 177:PLUS-MINUS SIGN
- #x2264 ;; 178:LESS-THAN OR EQUAL TO
- #x2265 ;; 179:GREATER-THAN OR EQUAL TO
- #x00A5 ;; 180:YEN SIGN
- #x00B5 ;; 181:MICRO SIGN
- #x2202 ;; 182:PARTIAL DIFFERENTIAL
- #x2211 ;; 183:N-ARY SUMMATION
- #x220F ;; 184:N-ARY PRODUCT
- #x03C0 ;; 185:GREEK SMALL LETTER PI
- #x222B ;; 186:INTEGRAL
- #x00AA ;; 187:FEMININE ORDINAL INDICATOR
- #x00BA ;; 188:MASCULINE ORDINAL INDICATOR
- #x03A9 ;; 189:GREEK CAPITAL LETTER OMEGA
- #x00E6 ;; 190:LATIN SMALL LETTER AE
- #x00F8 ;; 191:LATIN SMALL LETTER O WITH STROKE
- #x00BF ;; 192:INVERTED QUESTION MARK
- #x00A1 ;; 193:INVERTED EXCLAMATION MARK
- #x00AC ;; 194:NOT SIGN
- #x221A ;; 195:SQUARE ROOT
- #x0192 ;; 196:LATIN SMALL LETTER F WITH HOOK
- #x2248 ;; 197:ALMOST EQUAL TO
- #x2206 ;; 198:INCREMENT
- #x00AB ;; 199:LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
- #x00BB ;; 200:RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK
- #x2026 ;; 201:HORIZONTAL ELLIPSIS
- #x00A0 ;; 202:NO-BREAK SPACE
- #x00C0 ;; 203:LATIN CAPITAL LETTER A WITH GRAVE
- #x00C3 ;; 204:LATIN CAPITAL LETTER A WITH TILDE
- #x00D5 ;; 205:LATIN CAPITAL LETTER O WITH TILDE
- #x0152 ;; 206:LATIN CAPITAL LIGATURE OE
- #x0153 ;; 207:LATIN SMALL LIGATURE OE
- #x2013 ;; 208:EN DASH
- #x2014 ;; 209:EM DASH
- #x201C ;; 210:LEFT DOUBLE QUOTATION MARK
- #x201D ;; 211:RIGHT DOUBLE QUOTATION MARK
- #x2018 ;; 212:LEFT SINGLE QUOTATION MARK
- #x2019 ;; 213:RIGHT SINGLE QUOTATION MARK
- #x00F7 ;; 214:DIVISION SIGN
- #x25CA ;; 215:LOZENGE
- #x00FF ;; 216:LATIN SMALL LETTER Y WITH DIAERESIS
- #x0178 ;; 217:LATIN CAPITAL LETTER Y WITH DIAERESIS
- #x2044 ;; 218:FRACTION SLASH
- #x20AC ;; 219:EURO SIGN
- #x2039 ;; 220:SINGLE LEFT-POINTING ANGLE QUOTATION MARK
- #x203A ;; 221:SINGLE RIGHT-POINTING ANGLE QUOTATION MARK
- #xFB01 ;; 222:LATIN SMALL LIGATURE FI
- #xFB02 ;; 223:LATIN SMALL LIGATURE FL
- #x2021 ;; 224:DOUBLE DAGGER
- #x00B7 ;; 225:MIDDLE DOT
- #x201A ;; 226:SINGLE LOW-9 QUOTATION MARK
- #x201E ;; 227:DOUBLE LOW-9 QUOTATION MARK
- #x2030 ;; 228:PER MILLE SIGN
- #x00C2 ;; 229:LATIN CAPITAL LETTER A WITH CIRCUMFLEX
- #x00CA ;; 230:LATIN CAPITAL LETTER E WITH CIRCUMFLEX
- #x00C1 ;; 231:LATIN CAPITAL LETTER A WITH ACUTE
- #x00CB ;; 232:LATIN CAPITAL LETTER E WITH DIAERESIS
- #x00C8 ;; 233:LATIN CAPITAL LETTER E WITH GRAVE
- #x00CD ;; 234:LATIN CAPITAL LETTER I WITH ACUTE
- #x00CE ;; 235:LATIN CAPITAL LETTER I WITH CIRCUMFLEX
- #x00CF ;; 236:LATIN CAPITAL LETTER I WITH DIAERESIS
- #x00CC ;; 237:LATIN CAPITAL LETTER I WITH GRAVE
- #x00D3 ;; 238:LATIN CAPITAL LETTER O WITH ACUTE
- #x00D4 ;; 239:LATIN CAPITAL LETTER O WITH CIRCUMFLEX
- #xF8FF ;; 240:Apple logo
- #x00D2 ;; 241:LATIN CAPITAL LETTER O WITH GRAVE
- #x00DA ;; 242:LATIN CAPITAL LETTER U WITH ACUTE
- #x00DB ;; 243:LATIN CAPITAL LETTER U WITH CIRCUMFLEX
- #x00D9 ;; 244:LATIN CAPITAL LETTER U WITH GRAVE
- #x0131 ;; 245:LATIN SMALL LETTER DOTLESS I
- #x02C6 ;; 246:MODIFIER LETTER CIRCUMFLEX ACCENT
- #x02DC ;; 247:SMALL TILDE
- #x00AF ;; 248:MACRON
- #x02D8 ;; 249:BREVE
- #x02D9 ;; 250:DOT ABOVE
- #x02DA ;; 251:RING ABOVE
- #x00B8 ;; 252:CEDILLA
- #x02DD ;; 253:DOUBLE ACUTE ACCENT
- #x02DB ;; 254:OGONEK
- #x02C7 ;; 255:CARON
- ])
- translation-table)
- (while (< i 128)
- (aset encoding-vector i i)
- (setq i (1+ i)))
- (while (< i 256)
- (aset encoding-vector i
- (decode-char 'ucs (aref vec (- i 128))))
- (setq i (1+ i)))
- (setq translation-table
- (make-translation-table-from-vector encoding-vector))
- (define-translation-table 'mac-roman-decoder translation-table)
- (define-translation-table 'mac-roman-encoder
- (char-table-extra-slot translation-table 0)))
-
-(define-ccl-program decode-mac-roman
- `(4
- ((loop
- (read r1)
- (if (r1 < 128) ;; ASCII
- (r0 = ,(charset-id 'ascii))
- (if (r1 < 160)
- (r0 = ,(charset-id 'eight-bit-control))
- (r0 = ,(charset-id 'eight-bit-graphic))))
- (translate-character mac-roman-decoder r0 r1)
- (write-multibyte-character r0 r1)
- (repeat))))
- "CCL program to decode Mac Roman")
-
-(define-ccl-program encode-mac-roman
- `(1
- ((loop
- (read-multibyte-character r0 r1)
- (translate-character ucs-mule-to-mule-unicode r0 r1)
- (translate-character mac-roman-encoder r0 r1)
- (if (r0 != ,(charset-id 'ascii))
- (if (r0 != ,(charset-id 'eight-bit-graphic))
- (if (r0 != ,(charset-id 'eight-bit-control))
- (r1 = ??))))
- (write-repeat r1))))
- "CCL program to encode Mac Roman")
-
-(make-coding-system
- 'mac-roman 4 ?M
- "Mac Roman Encoding (MIME:MACINTOSH)."
- '(decode-mac-roman . encode-mac-roman)
- (list (cons 'safe-chars (get 'mac-roman-encoder 'translation-table))
- '(valid-codes (0 . 255))
- '(mime-charset . macintosh))) ; per IANA, rfc1345
+;; For automatic composing of diacritics and combining marks.
+(dolist (range '( ;; combining diacritical marks
+ (#x0300 #x0314 (tc . bc))
+ (#x0315 (tr . bl))
+ (#x0316 #x0319 (bc . tc))
+ (#x031A (tr . cl))
+ (#x031B #x0320 (bc . tc))
+ (#x0321 (Br . tr))
+ (#x0322 (Br . tl))
+ (#x0323 #x0333 (bc . tc))
+ (#x0334 #x0338 (Bc . Bc))
+ (#x0339 #x033C (bc . tc))
+ (#x033D #x033F (tc . bc))
+ (#x0340 (tl . bc))
+ (#x0341 (tr . bc))
+ (#x0342 #x0344 (tc . bc))
+ (#x0345 (bc . tc))
+ (#x0346 (tc . bc))
+ (#x0347 #x0349 (bc . tc))
+ (#x034A #x034C (tc . bc))
+ (#x034D #x034E (bc . tc))
+ ;; combining diacritical marks for symbols
+ (#x20D0 #x20D1 (tc . bc))
+ (#x20D2 #x20D3 (Bc . Bc))
+ (#x20D4 #x20D7 (tc . bc))
+ (#x20D8 #x20DA (Bc . Bc))
+ (#x20DB #x20DC (tc . bc))
+ (#x20DD #x20E0 (Bc . Bc))
+ (#x20E1 (tc . bc))
+ (#x20E2 #x20E3 (Bc . Bc))))
+ (let* ((from (car range))
+ (to (if (= (length range) 3)
+ (nth 1 range)
+ from))
+ (composition (car (last range))))
+ (while (<= from to)
+ (put-char-code-property from 'diacritic-composition composition)
+ (aset composition-function-table from 'diacritic-composition-function)
+ (setq from (1+ from)))))
(defconst diacritic-composition-pattern "\\C^\\c^+")
(narrow-to-region beg end)
(goto-char (point-min))
(while (re-search-forward diacritic-composition-pattern nil t)
- (compose-region (match-beginning 0) (match-end 0)))))
+ (if (= (char-syntax (char-after (match-beginning 0))) ?w)
+ (compose-region (match-beginning 0) (match-end 0))))))
(defun diacritic-compose-string (string)
"Compose diacritic characters in STRING and return the resulting string."
(let ((idx 0))
(while (setq idx (string-match diacritic-composition-pattern string idx))
- (compose-string string idx (match-end 0))
+ (if (= (char-syntax (aref string idx)) ?w)
+ (compose-string string idx (match-end 0)))
(setq idx (match-end 0))))
string)
(interactive)
(diacritic-compose-region (point-min) (point-max)))
-(defun diacritic-post-read-conversion (len)
- (diacritic-compose-region (point) (+ (point) len))
- len)
-
-(defun diacritic-composition-function (from to pattern &optional string)
- "Compose diacritic text in the region FROM and TO.
-The text matches the regular expression PATTERN.
-Optional 4th argument STRING, if non-nil, is a string containing text
+(defun diacritic-composition-function (pos to font-object string)
+ "Compose diacritic text around POS.
+Optional 2nd argument STRING, if non-nil, is a string containing text
to compose.
-The return value is the number of composed characters."
- (when (< (1+ from) to)
- (if string
- (compose-string string from to)
- (compose-region from to))
- (- to from)))
-
-;; Register a function to compose Unicode diacrtics and marks.
-(let ((patterns '(("\\C^\\c^+" . diacritic-composition-function))))
- (let ((c #x300))
- (while (<= c #x362)
- (aset composition-function-table (decode-char 'ucs c) patterns)
- (setq c (1+ c)))
- (setq c #x20d0)
- (while (<= c #x20e3)
- (aset composition-function-table (decode-char 'ucs c) patterns)
- (setq c (1+ c)))))
+The return value is the end position of composed characters,
+or nil if no characters are composed."
+ (setq pos (1- pos))
+ (if string
+ (if (>= pos 0)
+ (let ((ch (aref string pos))
+ start end components ch composition)
+ (when (= (char-syntax ch) ?w)
+ (setq start pos
+ end (length string)
+ components (list ch)
+ pos (1+ pos))
+ (while (and
+ (< pos end)
+ (setq ch (aref string pos)
+ composition
+ (get-char-code-property ch
+ 'diacritic-composition)))
+ (setq components (cons ch (cons composition components))
+ pos (1+ pos)))
+ (compose-string string start pos (nreverse components))
+ pos)))
+ (if (>= pos (point-min))
+ (let ((ch (char-after pos))
+ start end components composition)
+ (when (= (char-syntax ch) ?w)
+ (setq start pos
+ end (point-max)
+ components (list ch)
+ pos (1+ pos))
+ (while (and
+ (< pos end)
+ (setq ch (char-after pos)
+ composition
+ (get-char-code-property ch 'diacritic-composition)))
+ (setq components (cons ch (cons composition components))
+ pos (1+ pos)))
+ (compose-region start pos (nreverse components))
+ pos)))))
(provide 'european)
;;; georgian.el --- language support for Georgian -*- no-byte-compile: t -*-
- ;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ ;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
;; Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;;; Code:
+(define-coding-system 'georgian-ps
+ "Georgian PS encoding"
+ :coding-type 'charset
+ :mnemonic ?G
+ :charset-list '(georgian-ps))
+
+(define-coding-system 'georgian-academy
+ "Georgian Academy encoding"
+ :coding-type 'charset
+ :mnemonic ?G
+ :charset-list '(georgian-academy))
+
(set-language-info-alist
"Georgian" `((coding-system georgian-ps)
(coding-priority georgian-ps)
(input-method . "georgian")
- (features code-pages)
- (nonascii-translation . ,(get 'decode-georgian-ps
- 'translation-table))
+ (nonascii-translation . georgian-ps)
(documentation . "Support for georgian-ps character set."))
'("European")) ; fixme: is this appropriate for
; a non-Latin script?
;;; greek.el --- support for Greek -*- no-byte-compile: t -*-
+;; Copyright (C) 2002 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- ;; 2005, 2006, 2007
+ ;; 2005, 2006, 2007, 2008
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
+;; Copyright (C) 2003
+;; National Institute of Advanced Industrial Science and Technology (AIST)
+;; Registration Number H13PRO009
+
;; Keywords: multilingual, Greek
;; This file is part of GNU Emacs.
;;; Code:
-(make-coding-system
- 'greek-iso-8bit 2 ?7
- "ISO 2022 based 8-bit encoding for Greek (MIME:ISO-8859-7)."
- '(ascii greek-iso8859-7 nil nil
- nil nil nil nil nil nil nil nil nil nil nil t)
- '((safe-charsets ascii greek-iso8859-7)
- (mime-charset . iso-8859-7)))
+(define-coding-system 'greek-iso-8bit
+ "ISO 2022 based 8-bit encoding for Greek (MIME:ISO-8859-7)."
+ :coding-type 'charset
+ :mnemonic ?7
+ :charset-list '(iso-8859-7)
+ :mime-charset 'iso-8859-7)
(define-coding-system-alias 'iso-8859-7 'greek-iso-8bit)
+(define-coding-system 'windows-1253
+ "windows-1253 encoding for Greek"
+ :coding-type 'charset
+ :mnemonic ?g
+ :charset-list '(windows-1253)
+ :mime-charset 'windows-1253)
+(define-coding-system-alias 'cp1253 'windows-1253)
+
+(define-coding-system 'cp737
+ "Codepage 737 (PC Greek)"
+ :coding-type 'charset
+ :mnemonic ?D
+ :charset-list '(cp737)
+ :mime-charset 'cp737)
+
+(define-coding-system 'cp851
+ "DOS codepage 851 (Greek)"
+ :coding-type 'charset
+ :mnemonic ?D
+ :charset-list '(cp851)
+ :mime-charset 'cp851)
+(define-coding-system-alias 'ibm851 'cp851)
+
+(define-coding-system 'cp869
+ "DOS codepage 869 (Greek)"
+ :coding-type 'charset
+ :mnemonic ?D
+ :charset-list '(cp869)
+ :mime-charset 'cp869)
+(define-coding-system-alias 'ibm869 'cp869)
+
(set-language-info-alist
- "Greek" '((charset . (greek-iso8859-7))
- (coding-system . (greek-iso-8bit))
+ "Greek" '((charset iso-8859-7)
+ (coding-system greek-iso-8bit windows-1253 cp851 cp869)
(coding-priority greek-iso-8bit)
- (nonascii-translation . greek-iso8859-7)
+ (nonascii-translation . iso-8859-7)
(input-method . "greek")
- (unibyte-display . greek-iso-8bit)
(documentation . t)))
(provide 'greek)
;;; hebrew.el --- support for Hebrew -*- coding: iso-2022-7bit; no-byte-compile: t -*-
- ;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ ;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
;; Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- ;; 2005, 2006, 2007
+ ;; 2005, 2006, 2007, 2008
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
+;; Copyright (C) 2003
+;; National Institute of Advanced Industrial Science and Technology (AIST)
+;; Registration Number H13PRO009
+
;; Keywords: multilingual, Hebrew
;; This file is part of GNU Emacs.
;;; Code:
-(make-coding-system
- 'hebrew-iso-8bit 2 ?8
- "ISO 2022 based 8-bit encoding for Hebrew (MIME:ISO-8859-8)."
- '(ascii hebrew-iso8859-8 nil nil
- nil nil nil nil nil nil nil nil t nil nil t)
- '((safe-charsets ascii hebrew-iso8859-8)
- (mime-charset . iso-8859-8)))
+(define-coding-system 'hebrew-iso-8bit
+ "ISO 2022 based 8-bit encoding for Hebrew (MIME:ISO-8859-8)."
+ :coding-type 'charset
+ :mnemonic ?8
+ :charset-list '(iso-8859-8)
+ :mime-charset 'iso-8859-8)
(define-coding-system-alias 'iso-8859-8 'hebrew-iso-8bit)
(define-coding-system-alias 'iso-8859-8-i 'hebrew-iso-8bit)
(set-language-info-alist
- "Hebrew" '((charset . (hebrew-iso8859-8))
+ "Hebrew" '((charset iso-8859-8)
(coding-priority hebrew-iso-8bit)
- (coding-system . (hebrew-iso-8bit))
- (nonascii-translation . hebrew-iso8859-8)
+ (coding-system hebrew-iso-8bit windows-1255 cp862)
+ (nonascii-translation . iso-8859-8)
(input-method . "hebrew")
(unibyte-display . hebrew-iso-8bit)
(sample-text . "Hebrew \e,Hylem\e(B")
(set-language-info-alist
"Windows-1255" '((coding-priority windows-1255)
(coding-system windows-1255)
- (features code-pages)
(documentation . "\
Support for Windows-1255 encoding, e.g. for Yiddish.
Right-to-left writing is not yet supported.")))
+(define-coding-system 'windows-1255
+ "windows-1255 (Hebrew) encoding (MIME: WINDOWS-1255)"
+ :coding-type 'charset
+ :mnemonic ?h
+ :charset-list '(windows-1255)
+ :mime-charset 'windows-1255)
+(define-coding-system-alias 'cp1255 'windows-1255)
+
+(define-coding-system 'cp862
+ "DOS codepage 862 (Hebrew)"
+ :coding-type 'charset
+ :mnemonic ?D
+ :charset-list '(cp862)
+ :mime-charset 'cp862)
+(define-coding-system-alias 'ibm862 'cp862)
+
(provide 'hebrew)
;;; arch-tag: 3ca04f32-3f1e-498e-af46-8267498ba5d9
;;; ind-util.el --- Transliteration and Misc. Tools for Indian Languages -*- coding: iso-2022-7bit; -*-
- ;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ ;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
;; Free Software Foundation, Inc.
;; Maintainer: KAWABATA, Taichi <kawabata@m17n.org>
;; trans-char -- nil / string / list of strings
(when (and char trans-char)
(if (stringp trans-char) (setq trans-char (list trans-char)))
- (if (char-valid-p char) (setq char (char-to-string char)))
+ (if (characterp char) (setq char (char-to-string char)))
(puthash char (car trans-char) encode-hash)
(dolist (trans trans-char)
(puthash trans char decode-hash)))))
(defun indian--puthash-c (c trans-c halant hashtbls)
(indian--map
(lambda (c trans-c)
- (if (char-valid-p c) (setq c (char-to-string c)))
+ (if (characterp c) (setq c (char-to-string c)))
(indian--puthash-char (concat c halant) trans-c hashtbls))
c trans-c))
(indian--map
(lambda (v trans-v)
(when (and c trans-c v trans-v)
- (if (char-valid-p c) (setq c (char-to-string c)))
- (setq v (if (char-valid-p (cadr v)) (char-to-string (cadr v)) ""))
+ (if (characterp c) (setq c (char-to-string c)))
+ (setq v (if (characterp (cadr v)) (char-to-string (cadr v)) ""))
(if (stringp trans-c) (setq trans-c (list trans-c)))
(if (stringp trans-v) (setq trans-v (list trans-v)))
(indian--puthash-char
;; The followings provide conversion between IS 13194 (ISCII) and UCS.
-(defvar ucs-devanagari-to-is13194-alist
- '(;;Unicode vs IS13194 ;; only Devanagari is supported now.
- (?\x0900 . "[U+0900]")
- (?\x0901 . "\e(5!\e(B")
- (?\x0902 . "\e(5"\e(B")
- (?\x0903 . "\e(5#\e(B")
- (?\x0904 . "[U+0904]")
- (?\x0905 . "\e(5$\e(B")
- (?\x0906 . "\e(5%\e(B")
- (?\x0907 . "\e(5&\e(B")
- (?\x0908 . "\e(5'\e(B")
- (?\x0909 . "\e(5(\e(B")
- (?\x090a . "\e(5)\e(B")
- (?\x090b . "\e(5*\e(B")
- (?\x090c . "\e(5&i\e(B")
- (?\x090d . "\e(5.\e(B")
- (?\x090e . "\e(5+\e(B")
- (?\x090f . "\e(5,\e(B")
- (?\x0910 . "\e(5-\e(B")
- (?\x0911 . "\e(52\e(B")
- (?\x0912 . "\e(5/\e(B")
- (?\x0913 . "\e(50\e(B")
- (?\x0914 . "\e(51\e(B")
- (?\x0915 . "\e(53\e(B")
- (?\x0916 . "\e(54\e(B")
- (?\x0917 . "\e(55\e(B")
- (?\x0918 . "\e(56\e(B")
- (?\x0919 . "\e(57\e(B")
- (?\x091a . "\e(58\e(B")
- (?\x091b . "\e(59\e(B")
- (?\x091c . "\e(5:\e(B")
- (?\x091d . "\e(5;\e(B")
- (?\x091e . "\e(5<\e(B")
- (?\x091f . "\e(5=\e(B")
- (?\x0920 . "\e(5>\e(B")
- (?\x0921 . "\e(5?\e(B")
- (?\x0922 . "\e(5@\e(B")
- (?\x0923 . "\e(5A\e(B")
- (?\x0924 . "\e(5B\e(B")
- (?\x0925 . "\e(5C\e(B")
- (?\x0926 . "\e(5D\e(B")
- (?\x0927 . "\e(5E\e(B")
- (?\x0928 . "\e(5F\e(B")
- (?\x0929 . "\e(5G\e(B")
- (?\x092a . "\e(5H\e(B")
- (?\x092b . "\e(5I\e(B")
- (?\x092c . "\e(5J\e(B")
- (?\x092d . "\e(5K\e(B")
- (?\x092e . "\e(5L\e(B")
- (?\x092f . "\e(5M\e(B")
- (?\x0930 . "\e(5O\e(B")
- (?\x0931 . "\e(5P\e(B")
- (?\x0932 . "\e(5Q\e(B")
- (?\x0933 . "\e(5R\e(B")
- (?\x0934 . "\e(5S\e(B")
- (?\x0935 . "\e(5T\e(B")
- (?\x0936 . "\e(5U\e(B")
- (?\x0937 . "\e(5V\e(B")
- (?\x0938 . "\e(5W\e(B")
- (?\x0939 . "\e(5X\e(B")
- (?\x093a . "[U+093a]")
- (?\x093b . "[U+093b]")
- (?\x093c . "\e(5i\e(B")
- (?\x093d . "\e(5ji\e(B")
- (?\x093e . "\e(5Z\e(B")
- (?\x093f . "\e(5[\e(B")
- (?\x0940 . "\e(5\\e(B")
- (?\x0941 . "\e(5]\e(B")
- (?\x0942 . "\e(5^\e(B")
- (?\x0943 . "\e(5_\e(B")
- (?\x0944 . "\e(5_i\e(B")
- (?\x0945 . "\e(5c\e(B")
- (?\x0946 . "\e(5`\e(B")
- (?\x0947 . "\e(5a\e(B")
- (?\x0948 . "\e(5b\e(B")
- (?\x0949 . "\e(5g\e(B")
- (?\x094a . "\e(5d\e(B")
- (?\x094b . "\e(5e\e(B")
- (?\x094c . "\e(5f\e(B")
- (?\x094d . "\e(5h\e(B")
- (?\x094e . "[U+094e]")
- (?\x094f . "[U+094f]")
- (?\x0950 . "\e(5!i\e(B")
- (?\x0951 . "\e(5p5\e(B")
- (?\x0952 . "\e(5p8\e(B")
- (?\x0953 . "[DEVANAGARI GRAVE ACCENT]")
- (?\x0954 . "[DEVANAGARI ACUTE ACCENT]")
- (?\x0955 . "[U+0955]")
- (?\x0956 . "[U+0956]")
- (?\x0957 . "[U+0957]")
- (?\x0958 . "\e(53i\e(B")
- (?\x0959 . "\e(54i\e(B")
- (?\x095a . "\e(55i\e(B")
- (?\x095b . "\e(5:i\e(B")
- (?\x095c . "\e(5?i\e(B")
- (?\x095d . "\e(5@i\e(B")
- (?\x095e . "\e(5Ii\e(B")
- (?\x095f . "\e(5N\e(B")
- (?\x0960 . "\e(5*i\e(B")
- (?\x0961 . "\e(5'i\e(B")
- (?\x0962 . "\e(5[i\e(B")
- (?\x0963 . "\e(5ei\e(B")
- (?\x0964 . "\e(5j\e(B")
- (?\x0965 . "\e(5jj\e(B")
- (?\x0966 . "\e(5q\e(B")
- (?\x0967 . "\e(5r\e(B")
- (?\x0968 . "\e(5s\e(B")
- (?\x0969 . "\e(5t\e(B")
- (?\x096a . "\e(5u\e(B")
- (?\x096b . "\e(5v\e(B")
- (?\x096c . "\e(5w\e(B")
- (?\x096d . "\e(5x\e(B")
- (?\x096e . "\e(5y\e(B")
- (?\x096f . "\e(5z\e(B")
- (?\x0970 . "[U+0970]")
- (?\x0971 . "[U+0971]")
- (?\x0972 . "[U+0972]")
- (?\x0973 . "[U+0973]")
- (?\x0974 . "[U+0974]")
- (?\x0975 . "[U+0975]")
- (?\x0976 . "[U+0976]")
- (?\x0977 . "[U+0977]")
- (?\x0978 . "[U+0978]")
- (?\x0979 . "[U+0979]")
- (?\x097a . "[U+097a]")
- (?\x097b . "[U+097b]")
- (?\x097c . "[U+097c]")
- (?\x097d . "[U+097d]")
- (?\x097e . "[U+097e]")
- (?\x097f . "[U+097f]")))
-
-(defvar ucs-bengali-to-is13194-alist nil)
-(defvar ucs-assamese-to-is13194-alist nil)
-(defvar ucs-gurmukhi-to-is13194-alist nil)
-(defvar ucs-gujarati-to-is13194-alist nil)
-(defvar ucs-oriya-to-is13194-alist nil)
-(defvar ucs-tamil-to-is13194-alist nil)
-(defvar ucs-telugu-to-is13194-alist nil)
-(defvar ucs-malayalam-to-is13194-alist nil)
-(defvar ucs-kannada-to-is13194-alist nil)
-
-(defvar is13194-default-repartory 'devanagari)
+(let
+ ;;Unicode vs IS13194 ;; only Devanagari is supported now.
+ ((ucs-devanagari-to-is13194-alist
+ '((?\x0900 . "[U+0900]")
+ (?\x0901 . "\e(5!\e(B")
+ (?\x0902 . "\e(5"\e(B")
+ (?\x0903 . "\e(5#\e(B")
+ (?\x0904 . "[U+0904]")
+ (?\x0905 . "\e(5$\e(B")
+ (?\x0906 . "\e(5%\e(B")
+ (?\x0907 . "\e(5&\e(B")
+ (?\x0908 . "\e(5'\e(B")
+ (?\x0909 . "\e(5(\e(B")
+ (?\x090a . "\e(5)\e(B")
+ (?\x090b . "\e(5*\e(B")
+ (?\x090c . "\e(5&i\e(B")
+ (?\x090d . "\e(5.\e(B")
+ (?\x090e . "\e(5+\e(B")
+ (?\x090f . "\e(5,\e(B")
+ (?\x0910 . "\e(5-\e(B")
+ (?\x0911 . "\e(52\e(B")
+ (?\x0912 . "\e(5/\e(B")
+ (?\x0913 . "\e(50\e(B")
+ (?\x0914 . "\e(51\e(B")
+ (?\x0915 . "\e(53\e(B")
+ (?\x0916 . "\e(54\e(B")
+ (?\x0917 . "\e(55\e(B")
+ (?\x0918 . "\e(56\e(B")
+ (?\x0919 . "\e(57\e(B")
+ (?\x091a . "\e(58\e(B")
+ (?\x091b . "\e(59\e(B")
+ (?\x091c . "\e(5:\e(B")
+ (?\x091d . "\e(5;\e(B")
+ (?\x091e . "\e(5<\e(B")
+ (?\x091f . "\e(5=\e(B")
+ (?\x0920 . "\e(5>\e(B")
+ (?\x0921 . "\e(5?\e(B")
+ (?\x0922 . "\e(5@\e(B")
+ (?\x0923 . "\e(5A\e(B")
+ (?\x0924 . "\e(5B\e(B")
+ (?\x0925 . "\e(5C\e(B")
+ (?\x0926 . "\e(5D\e(B")
+ (?\x0927 . "\e(5E\e(B")
+ (?\x0928 . "\e(5F\e(B")
+ (?\x0929 . "\e(5G\e(B")
+ (?\x092a . "\e(5H\e(B")
+ (?\x092b . "\e(5I\e(B")
+ (?\x092c . "\e(5J\e(B")
+ (?\x092d . "\e(5K\e(B")
+ (?\x092e . "\e(5L\e(B")
+ (?\x092f . "\e(5M\e(B")
+ (?\x0930 . "\e(5O\e(B")
+ (?\x0931 . "\e(5P\e(B")
+ (?\x0932 . "\e(5Q\e(B")
+ (?\x0933 . "\e(5R\e(B")
+ (?\x0934 . "\e(5S\e(B")
+ (?\x0935 . "\e(5T\e(B")
+ (?\x0936 . "\e(5U\e(B")
+ (?\x0937 . "\e(5V\e(B")
+ (?\x0938 . "\e(5W\e(B")
+ (?\x0939 . "\e(5X\e(B")
+ (?\x093a . "[U+093a]")
+ (?\x093b . "[U+093b]")
+ (?\x093c . "\e(5i\e(B")
+ (?\x093d . "\e(5ji\e(B")
+ (?\x093e . "\e(5Z\e(B")
+ (?\x093f . "\e(5[\e(B")
+ (?\x0940 . "\e(5\\e(B")
+ (?\x0941 . "\e(5]\e(B")
+ (?\x0942 . "\e(5^\e(B")
+ (?\x0943 . "\e(5_\e(B")
+ (?\x0944 . "\e(5_i\e(B")
+ (?\x0945 . "\e(5c\e(B")
+ (?\x0946 . "\e(5`\e(B")
+ (?\x0947 . "\e(5a\e(B")
+ (?\x0948 . "\e(5b\e(B")
+ (?\x0949 . "\e(5g\e(B")
+ (?\x094a . "\e(5d\e(B")
+ (?\x094b . "\e(5e\e(B")
+ (?\x094c . "\e(5f\e(B")
+ (?\x094d . "\e(5h\e(B")
+ (?\x094e . "[U+094e]")
+ (?\x094f . "[U+094f]")
+ (?\x0950 . "\e(5!i\e(B")
+ (?\x0951 . "\e(5p5\e(B")
+ (?\x0952 . "\e(5p8\e(B")
+ (?\x0953 . "[DEVANAGARI GRAVE ACCENT]")
+ (?\x0954 . "[DEVANAGARI ACUTE ACCENT]")
+ (?\x0955 . "[U+0955]")
+ (?\x0956 . "[U+0956]")
+ (?\x0957 . "[U+0957]")
+ (?\x0958 . "\e(53i\e(B")
+ (?\x0959 . "\e(54i\e(B")
+ (?\x095a . "\e(55i\e(B")
+ (?\x095b . "\e(5:i\e(B")
+ (?\x095c . "\e(5?i\e(B")
+ (?\x095d . "\e(5@i\e(B")
+ (?\x095e . "\e(5Ii\e(B")
+ (?\x095f . "\e(5N\e(B")
+ (?\x0960 . "\e(5*i\e(B")
+ (?\x0961 . "\e(5'i\e(B")
+ (?\x0962 . "\e(5[i\e(B")
+ (?\x0963 . "\e(5ei\e(B")
+ (?\x0964 . "\e(5j\e(B")
+ (?\x0965 . "\e(5jj\e(B")
+ (?\x0966 . "\e(5q\e(B")
+ (?\x0967 . "\e(5r\e(B")
+ (?\x0968 . "\e(5s\e(B")
+ (?\x0969 . "\e(5t\e(B")
+ (?\x096a . "\e(5u\e(B")
+ (?\x096b . "\e(5v\e(B")
+ (?\x096c . "\e(5w\e(B")
+ (?\x096d . "\e(5x\e(B")
+ (?\x096e . "\e(5y\e(B")
+ (?\x096f . "\e(5z\e(B")
+ (?\x0970 . "[U+0970]")
+ (?\x0971 . "[U+0971]")
+ (?\x0972 . "[U+0972]")
+ (?\x0973 . "[U+0973]")
+ (?\x0974 . "[U+0974]")
+ (?\x0975 . "[U+0975]")
+ (?\x0976 . "[U+0976]")
+ (?\x0977 . "[U+0977]")
+ (?\x0978 . "[U+0978]")
+ (?\x0979 . "[U+0979]")
+ (?\x097a . "[U+097a]")
+ (?\x097b . "[U+097b]")
+ (?\x097c . "[U+097c]")
+ (?\x097d . "[U+097d]")
+ (?\x097e . "[U+097e]")
+ (?\x097f . "[U+097f]")))
+ (ucs-bengali-to-is13194-alist nil)
+ (ucs-assamese-to-is13194-alist nil)
+ (ucs-gurmukhi-to-is13194-alist nil)
+ (ucs-gujarati-to-is13194-alist nil)
+ (ucs-oriya-to-is13194-alist nil)
+ (ucs-tamil-to-is13194-alist nil)
+ (ucs-telugu-to-is13194-alist nil)
+ (ucs-malayalam-to-is13194-alist nil)
+ (ucs-kannada-to-is13194-alist nil))
+ (dolist (script '(devanagari bengali assamese gurmukhi gujarati
+ oriya tamil telugu malayalam kannada))
+ (let ((hashtable (intern (concat "is13194-to-ucs-"
+ (symbol-name script) "-hashtbl" )))
+ (regexp (intern (concat "is13194-to-ucs-"
+ (symbol-name script) "-regexp"))))
+ (set hashtable (make-hash-table :test 'equal :size 128))
+ (dolist (x (eval (intern (concat "ucs-" (symbol-name script)
+ "-to-is13194-alist"))))
+ (put-char-code-property (car x) 'script script)
+ (put-char-code-property (car x) 'iscii (cdr x))
+ (puthash (cdr x) (char-to-string (car x)) (eval hashtable)))
+ (set regexp (indian-regexp-of-hashtbl-keys (eval hashtable))))))
+
+(defvar is13194-default-repertory 'devanagari)
(defvar is13194-repertory-to-ucs-script
- `((DEF ?\x40 ,is13194-default-repartory)
- (RMN ?\x41 ,is13194-default-repartory)
+ `((DEF ?\x40 ,is13194-default-repertory)
+ (RMN ?\x41 ,is13194-default-repertory)
(DEV ?\x42 devanagari)
(BNG ?\x43 bengali)
(TML ?\x44 tamil)
(defvar is13194-to-ucs-kannada-hashtbl nil)
(defvar is13194-to-ucs-kannada-regexp nil)
-(mapc
- (function (lambda (script)
- (let ((hashtable (intern (concat "is13194-to-ucs-"
- (symbol-name script) "-hashtbl" )))
- (regexp (intern (concat "is13194-to-ucs-"
- (symbol-name script) "-regexp"))))
- (set hashtable (make-hash-table :test 'equal :size 128))
- (mapc
- (function (lambda (x)
- (put-char-code-property (decode-char 'ucs (car x))
- 'script script)
- (put-char-code-property (decode-char 'ucs (car x))
- 'iscii (cdr x))
- (puthash (cdr x) (char-to-string (decode-char 'ucs (car x)))
- (eval hashtable))))
- (eval (intern (concat "ucs-" (symbol-name script)
- "-to-is13194-alist"))))
- (set regexp (indian-regexp-of-hashtbl-keys (eval hashtable))))))
- '(devanagari bengali assamese gurmukhi gujarati
- oriya tamil telugu malayalam kannada))
-
(defvar ucs-to-is13194-regexp
;; only Devanagari is supported now.
- (concat "[" (char-to-string (decode-char 'ucs #x0900))
- "-" (char-to-string (decode-char 'ucs #x097f)) "]")
+ (concat "[" (char-to-string #x0900)
+ "-" (char-to-string #x097f) "]")
"Regexp that matches to conversion")
(defun ucs-to-iscii-region (from to)
(save-restriction
(narrow-to-region from to)
(goto-char (point-min))
- (let* ((current-repertory is13194-default-repartory))
- (while (re-search-forward ucs-to-is13194-regexp nil t)
- (replace-match
- (get-char-code-property (string-to-char (match-string 0))
- 'iscii))))
+ (let* ((current-repertory is13194-default-repertory))
+ (while (re-search-forward ucs-to-is13194-regexp nil t)
+ (replace-match
+ (get-char-code-property (string-to-char (match-string 0))
+ 'iscii))))
(point-max))))
(defun iscii-to-ucs-region (from to)
(save-restriction
(narrow-to-region from to)
(goto-char (point-min))
- (let* ((current-repertory is13194-default-repartory)
- (current-hashtable
- (intern (concat "is13194-to-ucs-"
- (symbol-name current-repertory) "-hashtbl")))
- (current-regexp
- (intern (concat "is13194-to-ucs-"
- (symbol-name current-repertory) "-regexp"))))
- (while (re-search-forward (eval current-regexp) nil t)
- (replace-match
- (gethash (match-string 0) (eval current-hashtable) ""))))
+ (let* ((current-repertory is13194-default-repertory)
+ (current-hashtable
+ (intern (concat "is13194-to-ucs-"
+ (symbol-name current-repertory) "-hashtbl")))
+ (current-regexp
+ (intern (concat "is13194-to-ucs-"
+ (symbol-name current-repertory) "-regexp")))
+ (re (eval current-regexp))
+ (hash (eval current-hashtable)))
+ (while (re-search-forward re nil t)
+ (replace-match (gethash (match-string 0) hash ""))))
(point-max))))
;;;###autoload
(interactive "r")
(save-excursion
(save-restriction
- (let ((pos from) chars (max to))
- (narrow-to-region from to)
- (while (< pos max)
- (setq chars (compose-chars-after pos))
- (if chars (setq pos (+ pos chars)) (setq pos (1+ pos))))))))
+ (let ((pos from) newpos func (max to))
+ (narrow-to-region from to)
+ (while (< pos max)
+ (setq func (aref composition-function-table (char-after pos)))
+ (if (fboundp func)
+ (setq newpos (funcall func pos nil)
+ pos (if (and (integerp newpos) (> newpos pos))
+ newpos (1+ pos)))
+ (setq pos (1+ pos))))))))
;;;###autoload
(defun indian-compose-string (string)
;;; Backward Compatibility support programs
-;; The followings provides the conversion from old-implementation of
+;; The following provides the conversion from old-implementation of
;; Emacs Devanagari script to UCS.
(defconst indian-2-colum-to-ucs
'(
;; 0 1 2 3 4 5 6 7 8 9 a b c d e f
- ;;2120 \e$(5!!!"!#!$!%!&!'!(!)!*!+!,!-!.!/\e(B
- ("\e$(5!!\e(B" . "\e$,15A\e(B")
- ("\e$(5!"\e(B" . "\e$,15B\e(B")
- ("\e$(5!#\e(B" . "\e$,15C\e(B")
- ("\e$(5!$\e(B" . "\e$,15E\e(B")
- ("\e$(5!%\e(B" . "\e$,15F\e(B")
- ("\e$(5!&\e(B" . "\e$,15G\e(B")
- ("\e$(5!'\e(B" . "\e$,15H\e(B")
- ("\e$(5!(\e(B" . "\e$,15I\e(B")
- ("\e$(5!)\e(B" . "\e$,15J\e(B")
- ("\e$(5!*\e(B" . "\e$,15K\e(B")
- ("\e$(5!*"p\e(B" . "\e$,15p6#\e(B")
- ("\e$(5!+\e(B" . "\e$,15N\e(B")
- ("\e$(5!,\e(B" . "\e$,15O\e(B")
- ("\e$(5!-\e(B" . "\e$,15P\e(B")
- ("\e$(5!.\e(B" . "\e$,15M\e(B")
- ("\e$(5!/\e(B" . "\e$,15R\e(B")
+ ;;2120 \e$(6!!!"!#!$!%!&!'!(!)!*!+!,!-!.!/\e(B
+ ("\e$(6!!\e(B" . "\e$,15A\e(B")
+ ("\e$(6!"\e(B" . "\e$,15B\e(B")
+ ("\e$(6!#\e(B" . "\e$,15C\e(B")
+ ("\e$(6!$\e(B" . "\e$,15E\e(B")
+ ("\e$(6!%\e(B" . "\e$,15F\e(B")
+ ("\e$(6!&\e(B" . "\e$,15G\e(B")
+ ("\e$(6!'\e(B" . "\e$,15H\e(B")
+ ("\e$(6!(\e(B" . "\e$,15I\e(B")
+ ("\e$(6!)\e(B" . "\e$,15J\e(B")
+ ("\e$(6!*\e(B" . "\e$,15K\e(B")
+ ("\e$(6!*"p\e(B" . "\e$,15p6#\e(B")
+ ("\e$(6!+\e(B" . "\e$,15N\e(B")
+ ("\e$(6!,\e(B" . "\e$,15O\e(B")
+ ("\e$(6!-\e(B" . "\e$,15P\e(B")
+ ("\e$(6!.\e(B" . "\e$,15M\e(B")
+ ("\e$(6!/\e(B" . "\e$,15R\e(B")
;; 0 1 2 3 4 5 6 7 8 9 a b c d e f
- ;;2130 \e$(5!0!1!2!3!4!5!6!7!8!9!:!;!<!=!>!?\e(B
- ("\e$(5!0\e(B" . "\e$,15S\e(B")
- ("\e$(5!1\e(B" . "\e$,15T\e(B")
- ("\e$(5!2\e(B" . "\e$,15Q\e(B")
- ("\e$(5!3\e(B" . "\e$,15U\e(B")
- ("\e$(5!4\e(B" . "\e$,15V\e(B")
- ("\e$(5!5\e(B" . "\e$,15W\e(B")
- ("\e$(5!6\e(B" . "\e$,15X\e(B")
- ("\e$(5!7\e(B" . "\e$,15Y\e(B")
- ("\e$(5!8\e(B" . "\e$,15Z\e(B")
- ("\e$(5!9\e(B" . "\e$,15[\e(B")
- ("\e$(5!:\e(B" . "\e$,15\\e(B")
- ("\e$(5!;\e(B" . "\e$,15]\e(B")
- ("\e$(5!<\e(B" . "\e$,15^\e(B")
- ("\e$(5!=\e(B" . "\e$,15_\e(B")
- ("\e$(5!>\e(B" . "\e$,15`\e(B")
- ("\e$(5!?\e(B" . "\e$,15a\e(B")
+ ;;2130 \e$(6!0!1!2!3!4!5!6!7!8!9!:!;!<!=!>!?\e(B
+ ("\e$(6!0\e(B" . "\e$,15S\e(B")
+ ("\e$(6!1\e(B" . "\e$,15T\e(B")
+ ("\e$(6!2\e(B" . "\e$,15Q\e(B")
+ ("\e$(6!3\e(B" . "\e$,15U\e(B")
+ ("\e$(6!4\e(B" . "\e$,15V\e(B")
+ ("\e$(6!5\e(B" . "\e$,15W\e(B")
+ ("\e$(6!6\e(B" . "\e$,15X\e(B")
+ ("\e$(6!7\e(B" . "\e$,15Y\e(B")
+ ("\e$(6!8\e(B" . "\e$,15Z\e(B")
+ ("\e$(6!9\e(B" . "\e$,15[\e(B")
+ ("\e$(6!:\e(B" . "\e$,15\\e(B")
+ ("\e$(6!;\e(B" . "\e$,15]\e(B")
+ ("\e$(6!<\e(B" . "\e$,15^\e(B")
+ ("\e$(6!=\e(B" . "\e$,15_\e(B")
+ ("\e$(6!>\e(B" . "\e$,15`\e(B")
+ ("\e$(6!?\e(B" . "\e$,15a\e(B")
;; 0 1 2 3 4 5 6 7 8 9 a b c d e f
- ;;2140 \e$(5!@!A!B!C!D!E!F!G!H!I!J!K!L!M!N!O\e(B
- ("\e$(5!@\e(B" . "\e$,15b\e(B")
- ("\e$(5!A\e(B" . "\e$,15c\e(B")
- ("\e$(5!B\e(B" . "\e$,15d\e(B")
- ("\e$(5!C\e(B" . "\e$,15e\e(B")
- ("\e$(5!D\e(B" . "\e$,15f\e(B")
- ("\e$(5!E\e(B" . "\e$,15g\e(B")
- ("\e$(5!F\e(B" . "\e$,15h\e(B")
- ("\e$(5!G\e(B" . "\e$,15i\e(B")
- ("\e$(5!H\e(B" . "\e$,15j\e(B")
- ("\e$(5!I\e(B" . "\e$,15k\e(B")
- ("\e$(5!J\e(B" . "\e$,15l\e(B")
- ("\e$(5!K\e(B" . "\e$,15m\e(B")
- ("\e$(5!L\e(B" . "\e$,15n\e(B")
- ("\e$(5!M\e(B" . "\e$,15o\e(B")
- ("\e$(5!N\e(B" . "\e$,16?\e(B")
- ("\e$(5!O\e(B" . "\e$,15p\e(B")
+ ;;2140 \e$(6!@!A!B!C!D!E!F!G!H!I!J!K!L!M!N!O\e(B
+ ("\e$(6!@\e(B" . "\e$,15b\e(B")
+ ("\e$(6!A\e(B" . "\e$,15c\e(B")
+ ("\e$(6!B\e(B" . "\e$,15d\e(B")
+ ("\e$(6!C\e(B" . "\e$,15e\e(B")
+ ("\e$(6!D\e(B" . "\e$,15f\e(B")
+ ("\e$(6!E\e(B" . "\e$,15g\e(B")
+ ("\e$(6!F\e(B" . "\e$,15h\e(B")
+ ("\e$(6!G\e(B" . "\e$,15i\e(B")
+ ("\e$(6!H\e(B" . "\e$,15j\e(B")
+ ("\e$(6!I\e(B" . "\e$,15k\e(B")
+ ("\e$(6!J\e(B" . "\e$,15l\e(B")
+ ("\e$(6!K\e(B" . "\e$,15m\e(B")
+ ("\e$(6!L\e(B" . "\e$,15n\e(B")
+ ("\e$(6!M\e(B" . "\e$,15o\e(B")
+ ("\e$(6!N\e(B" . "\e$,16?\e(B")
+ ("\e$(6!O\e(B" . "\e$,15p\e(B")
;; 0 1 2 3 4 5 6 7 8 9 a b c d e f
- ;;2150 \e$(5!P!Q!R!S!T!U!V!W!X!Y!Z![!\!]!^!_\e(B
- ("\e$(5!P\e(B" . "\e$,15q\e(B")
- ("\e$(5!Q\e(B" . "\e$,15r\e(B")
- ("\e$(5!R\e(B" . "\e$,15s\e(B")
- ("\e$(5!S\e(B" . "\e$,15t\e(B")
- ("\e$(5!T\e(B" . "\e$,15u\e(B")
- ("\e$(5!U\e(B" . "\e$,15v\e(B")
- ("\e$(5!V\e(B" . "\e$,15w\e(B")
- ("\e$(5!W\e(B" . "\e$,15x\e(B")
- ("\e$(5!X\e(B" . "\e$,15y\e(B")
- ("\e$(5!Z\e(B" . "\e$,15~\e(B")
- ("\e$(5![\e(B" . "\e$,15\7f\e(B")
- ("\e$(5!\\e(B" . "\e$,16 \e(B")
- ("\e$(5!]\e(B" . "\e$,16!\e(B")
- ("\e$(5!^\e(B" . "\e$,16"\e(B")
- ("\e$(5!_\e(B" . "\e$,16#\e(B")
+ ;;2150 \e$(6!P!Q!R!S!T!U!V!W!X!Y!Z![!\!]!^!_\e(B
+ ("\e$(6!P\e(B" . "\e$,15q\e(B")
+ ("\e$(6!Q\e(B" . "\e$,15r\e(B")
+ ("\e$(6!R\e(B" . "\e$,15s\e(B")
+ ("\e$(6!S\e(B" . "\e$,15t\e(B")
+ ("\e$(6!T\e(B" . "\e$,15u\e(B")
+ ("\e$(6!U\e(B" . "\e$,15v\e(B")
+ ("\e$(6!V\e(B" . "\e$,15w\e(B")
+ ("\e$(6!W\e(B" . "\e$,15x\e(B")
+ ("\e$(6!X\e(B" . "\e$,15y\e(B")
+ ("\e$(6!Z\e(B" . "\e$,15~\e(B")
+ ("\e$(6![\e(B" . "\e$,15\7f\e(B")
+ ("\e$(6!\\e(B" . "\e$,16 \e(B")
+ ("\e$(6!]\e(B" . "\e$,16!\e(B")
+ ("\e$(6!^\e(B" . "\e$,16"\e(B")
+ ("\e$(6!_\e(B" . "\e$,16#\e(B")
;; 0 1 2 3 4 5 6 7 8 9 a b c d e f
- ;;2160 \e$(5!`!a!b!c!d!e!f!g!h!i!j!k!l!m!n!o\e(B
- ("\e$(5!`\e(B" . "\e$,16&\e(B")
- ("\e$(5!a\e(B" . "\e$,16'\e(B")
- ("\e$(5!b\e(B" . "\e$,16(\e(B")
- ("\e$(5!c\e(B" . "\e$,16%\e(B")
- ("\e$(5!d\e(B" . "\e$,16*\e(B")
- ("\e$(5!e\e(B" . "\e$,16+\e(B")
- ("\e$(5!f\e(B" . "\e$,16,\e(B")
- ("\e$(5!g\e(B" . "\e$,16)\e(B")
- ("\e$(5!h\e(B" . "\e$,16-\e(B")
- ("\e$(5!i\e(B" . "\e$,15|\e(B")
- ("\e$(5!j\e(B" . "\e$,16D\e(B")
- ("\e$(5!j!j\e(B" . "\e$,16E\e(B")
+ ;;2160 \e$(6!`!a!b!c!d!e!f!g!h!i!j!k!l!m!n!o\e(B
+ ("\e$(6!`\e(B" . "\e$,16&\e(B")
+ ("\e$(6!a\e(B" . "\e$,16'\e(B")
+ ("\e$(6!b\e(B" . "\e$,16(\e(B")
+ ("\e$(6!c\e(B" . "\e$,16%\e(B")
+ ("\e$(6!d\e(B" . "\e$,16*\e(B")
+ ("\e$(6!e\e(B" . "\e$,16+\e(B")
+ ("\e$(6!f\e(B" . "\e$,16,\e(B")
+ ("\e$(6!g\e(B" . "\e$,16)\e(B")
+ ("\e$(6!h\e(B" . "\e$,16-\e(B")
+ ("\e$(6!i\e(B" . "\e$,15|\e(B")
+ ("\e$(6!j\e(B" . "\e$,16D\e(B")
+ ("\e$(6!j!j\e(B" . "\e$,16E\e(B")
;; 0 1 2 3 4 5 6 7 8 9 a b c d e f
- ;;2170 \e$(5!p!q!r!s!t!u!v!w!x!y!z!{!|!}!~\e(B
- ("\e$(5!q\e(B" . "\e$,16F\e(B")
- ("\e$(5!r\e(B" . "\e$,16G\e(B")
- ("\e$(5!s\e(B" . "\e$,16H\e(B")
- ("\e$(5!t\e(B" . "\e$,16I\e(B")
- ("\e$(5!u\e(B" . "\e$,16J\e(B")
- ("\e$(5!v\e(B" . "\e$,16K\e(B")
- ("\e$(5!w\e(B" . "\e$,16L\e(B")
- ("\e$(5!x\e(B" . "\e$,16M\e(B")
- ("\e$(5!y\e(B" . "\e$,16N\e(B")
- ("\e$(5!z\e(B" . "\e$,16O\e(B")
+ ;;2170 \e$(6!p!q!r!s!t!u!v!w!x!y!z!{!|!}!~\e(B
+ ("\e$(6!q\e(B" . "\e$,16F\e(B")
+ ("\e$(6!r\e(B" . "\e$,16G\e(B")
+ ("\e$(6!s\e(B" . "\e$,16H\e(B")
+ ("\e$(6!t\e(B" . "\e$,16I\e(B")
+ ("\e$(6!u\e(B" . "\e$,16J\e(B")
+ ("\e$(6!v\e(B" . "\e$,16K\e(B")
+ ("\e$(6!w\e(B" . "\e$,16L\e(B")
+ ("\e$(6!x\e(B" . "\e$,16M\e(B")
+ ("\e$(6!y\e(B" . "\e$,16N\e(B")
+ ("\e$(6!z\e(B" . "\e$,16O\e(B")
;; 0 1 2 3 4 5 6 7 8 9 a b c d e f
- ;;2220 \e$(5"!"""#"$"%"&"'"(")"*"+","-"."/\e(B
- ("\e$(5"!\e(B" . "\e$,16;6-5p\e(B")
- ("\e$(5""\e(B" . "\e$,16>6-5p\e(B")
- ("\e$(5"#\e(B" . "\e$,15U6-5p\e(B")
- ("\e$(5"$\e(B" . "\e$,15W6-5p\e(B")
- ("\e$(5"%\e(B" . "\e$,15d6-5p\e(B")
- ("\e$(5"&\e(B" . "\e$,15j6-5p\e(B")
- ("\e$(5"'\e(B" . "\e$,15k6-5p\e(B")
- ("\e$(5")\e(B" . "\e$,15v6-5p\e(B")
- ("\e$(5",\e(B" . "\e$,15p6!\e(B")
- ("\e$(5"-\e(B" . "\e$,15p6"\e(B")
- ("\e$(5".\e(B" . "\e$,15q6!\e(B")
- ("\e$(5"/\e(B" . "\e$,15q6"\e(B")
+ ;;2220 \e$(6"!"""#"$"%"&"'"(")"*"+","-"."/\e(B
+ ("\e$(6"!\e(B" . "\e$,16;6-5p\e(B")
+ ("\e$(6""\e(B" . "\e$,16>6-5p\e(B")
+ ("\e$(6"#\e(B" . "\e$,15U6-5p\e(B")
+ ("\e$(6"$\e(B" . "\e$,15W6-5p\e(B")
+ ("\e$(6"%\e(B" . "\e$,15d6-5p\e(B")
+ ("\e$(6"&\e(B" . "\e$,15j6-5p\e(B")
+ ("\e$(6"'\e(B" . "\e$,15k6-5p\e(B")
+ ("\e$(6")\e(B" . "\e$,15v6-5p\e(B")
+ ("\e$(6",\e(B" . "\e$,15p6!\e(B")
+ ("\e$(6"-\e(B" . "\e$,15p6"\e(B")
+ ("\e$(6".\e(B" . "\e$,15q6!\e(B")
+ ("\e$(6"/\e(B" . "\e$,15q6"\e(B")
;; 0 1 2 3 4 5 6 7 8 9 a b c d e f
- ;;2230 \e$(5"0"1"2"3"4"5"6"7"8"9":";"<"=">"?\e(B
- ("\e$(5"3\e(B" . "\e$,15U6-\e(B")
- ("\e$(5"4\e(B" . "\e$,15V6-\e(B")
- ("\e$(5"5\e(B" . "\e$,15W6-\e(B")
- ("\e$(5"6\e(B" . "\e$,15X6-\e(B")
- ("\e$(5"8\e(B" . "\e$,15Z6-\e(B")
- ("\e$(5"8"q\e(B" . "\e$,15Z6-5p6-\e(B")
- ("\e$(5":\e(B" . "\e$,15\6-\e(B")
- ("\e$(5";\e(B" . "\e$,15]6-\e(B")
- ("\e$(5"<\e(B" . "\e$,15^6-\e(B")
- ("\e$(5"<\e(B" . "\e$,15^6-\e(B")
+ ;;2230 \e$(6"0"1"2"3"4"5"6"7"8"9":";"<"=">"?\e(B
+ ("\e$(6"3\e(B" . "\e$,15U6-\e(B")
+ ("\e$(6"4\e(B" . "\e$,15V6-\e(B")
+ ("\e$(6"5\e(B" . "\e$,15W6-\e(B")
+ ("\e$(6"6\e(B" . "\e$,15X6-\e(B")
+ ("\e$(6"8\e(B" . "\e$,15Z6-\e(B")
+ ("\e$(6"8"q\e(B" . "\e$,15Z6-5p6-\e(B")
+ ("\e$(6":\e(B" . "\e$,15\6-\e(B")
+ ("\e$(6";\e(B" . "\e$,15]6-\e(B")
+ ("\e$(6"<\e(B" . "\e$,15^6-\e(B")
+ ("\e$(6"<\e(B" . "\e$,15^6-\e(B")
;; 0 1 2 3 4 5 6 7 8 9 a b c d e f
- ;;2240 \e$(5"@"A"B"C"D"E"F"G"H"I"J"K"L"M"N"O\e(B
- ("\e$(5"A\e(B" . "\e$,15c6-\e(B")
- ("\e$(5"B\e(B" . "\e$,15d6-\e(B")
- ("\e$(5"C\e(B" . "\e$,15e6-\e(B")
- ("\e$(5"E\e(B" . "\e$,15g6-\e(B")
- ("\e$(5"F\e(B" . "\e$,15h6-\e(B")
- ("\e$(5"G\e(B" . "\e$,15i6-\e(B")
- ("\e$(5"H\e(B" . "\e$,15j6-\e(B")
- ("\e$(5"I\e(B" . "\e$,15k6-\e(B")
- ("\e$(5"J\e(B" . "\e$,15l6-\e(B")
- ("\e$(5"J\e(B" . "\e$,15l6-\e(B")
- ("\e$(5"K\e(B" . "\e$,15m6-\e(B")
- ("\e$(5"L\e(B" . "\e$,15n6-\e(B")
- ("\e$(5"M\e(B" . "\e$,15o6-\e(B")
- ("\e$(5"N\e(B" . "\e$,16?6-\e(B")
+ ;;2240 \e$(6"@"A"B"C"D"E"F"G"H"I"J"K"L"M"N"O\e(B
+ ("\e$(6"A\e(B" . "\e$,15c6-\e(B")
+ ("\e$(6"B\e(B" . "\e$,15d6-\e(B")
+ ("\e$(6"C\e(B" . "\e$,15e6-\e(B")
+ ("\e$(6"E\e(B" . "\e$,15g6-\e(B")
+ ("\e$(6"F\e(B" . "\e$,15h6-\e(B")
+ ("\e$(6"G\e(B" . "\e$,15i6-\e(B")
+ ("\e$(6"H\e(B" . "\e$,15j6-\e(B")
+ ("\e$(6"I\e(B" . "\e$,15k6-\e(B")
+ ("\e$(6"J\e(B" . "\e$,15l6-\e(B")
+ ("\e$(6"J\e(B" . "\e$,15l6-\e(B")
+ ("\e$(6"K\e(B" . "\e$,15m6-\e(B")
+ ("\e$(6"L\e(B" . "\e$,15n6-\e(B")
+ ("\e$(6"M\e(B" . "\e$,15o6-\e(B")
+ ("\e$(6"N\e(B" . "\e$,16?6-\e(B")
;; 0 1 2 3 4 5 6 7 8 9 a b c d e f
- ;;2250 \e$(5"P"Q"R"S"T"U"V"W"X"Y"Z"["\"]"^"_\e(B
- ("\e$(5"Q\e(B" . "\e$,15r6-\e(B")
- ("\e$(5"R\e(B" . "\e$,15s6-\e(B")
- ("\e$(5"S\e(B" . "\e$,15t6-\e(B")
- ("\e$(5"T\e(B" . "\e$,15u6-\e(B")
- ("\e$(5"U\e(B" . "\e$,15v6-\e(B")
- ("\e$(5"V\e(B" . "\e$,15w6-\e(B")
- ("\e$(5"W\e(B" . "\e$,15x6-\e(B")
- ("\e$(5"]\e(B" . "\e$,16-5o\e(B")
+ ;;2250 \e$(6"P"Q"R"S"T"U"V"W"X"Y"Z"["\"]"^"_\e(B
+ ("\e$(6"Q\e(B" . "\e$,15r6-\e(B")
+ ("\e$(6"R\e(B" . "\e$,15s6-\e(B")
+ ("\e$(6"S\e(B" . "\e$,15t6-\e(B")
+ ("\e$(6"T\e(B" . "\e$,15u6-\e(B")
+ ("\e$(6"U\e(B" . "\e$,15v6-\e(B")
+ ("\e$(6"V\e(B" . "\e$,15w6-\e(B")
+ ("\e$(6"W\e(B" . "\e$,15x6-\e(B")
+ ("\e$(6"]\e(B" . "\e$,16-5o\e(B")
;; 0 1 2 3 4 5 6 7 8 9 a b c d e f
- ;;2260 \e$(5"`"a"b"c"d"e"f"g"h"i"j"k"l"m"n"o\e(B
- ("\e$(5"`\e(B" . "\e$,15W6-5p6-\e(B")
- ("\e$(5"a\e(B" . "\e$,15X6-5h6-\e(B")
- ("\e$(5"c\e(B" . "\e$,15d6-5d6-\e(B")
- ("\e$(5"d\e(B" . "\e$,15d6-5p6-\e(B")
- ("\e$(5"e\e(B" . "\e$,15g6-5h6-\e(B")
- ("\e$(5"f\e(B" . "\e$,15g6-5p6-\e(B")
- ("\e$(5"g\e(B" . "\e$,15j6-5d6-\e(B")
- ("\e$(5"h\e(B" . "\e$,15v6-5Z6-\e(B")
- ("\e$(5"i\e(B" . "\e$,15v6-5p6-\e(B")
- ("\e$(5"j\e(B" . "\e$,15v6-5u6-\e(B")
- ("\e$(5"k\e(B" . "\e$,15h6-5h6-\e(B")
- ("\e$(5"l\e(B" . "\e$,15U6-5w6-\e(B")
- ("\e$(5"m\e(B" . "\e$,15\6-5^6-\e(B")
+ ;;2260 \e$(6"`"a"b"c"d"e"f"g"h"i"j"k"l"m"n"o\e(B
+ ("\e$(6"`\e(B" . "\e$,15W6-5p6-\e(B")
+ ("\e$(6"a\e(B" . "\e$,15X6-5h6-\e(B")
+ ("\e$(6"c\e(B" . "\e$,15d6-5d6-\e(B")
+ ("\e$(6"d\e(B" . "\e$,15d6-5p6-\e(B")
+ ("\e$(6"e\e(B" . "\e$,15g6-5h6-\e(B")
+ ("\e$(6"f\e(B" . "\e$,15g6-5p6-\e(B")
+ ("\e$(6"g\e(B" . "\e$,15j6-5d6-\e(B")
+ ("\e$(6"h\e(B" . "\e$,15v6-5Z6-\e(B")
+ ("\e$(6"i\e(B" . "\e$,15v6-5p6-\e(B")
+ ("\e$(6"j\e(B" . "\e$,15v6-5u6-\e(B")
+ ("\e$(6"k\e(B" . "\e$,15h6-5h6-\e(B")
+ ("\e$(6"l\e(B" . "\e$,15U6-5w6-\e(B")
+ ("\e$(6"m\e(B" . "\e$,15\6-5^6-\e(B")
;; 0 1 2 3 4 5 6 7 8 9 a b c d e f
- ;;2270 \e$(5"p"q"r"s"t"u"v"w"x"y"z"{"|"}"~\e(B
- ("\e$(5"p\e(B" . "\e$,15p6-\e(B")
- ("\e$(5"q\e(B" . "\e$,16-5p\e(B")
- ("\e$(5"r\e(B" . "\e$,16-5p\e(B")
- ("\e$(5"s\e(B" . "\e$,1686-\e(B")
- ("\e$(5"t\e(B" . "\e$,1696-\e(B")
- ("\e$(5"u\e(B" . "\e$,16:6-\e(B")
- ("\e$(5"y\e(B" . "\e$,16>6-\e(B")
- ("\e$(5"z\e(B" . "\e$,16;6-\e(B")
+ ;;2270 \e$(6"p"q"r"s"t"u"v"w"x"y"z"{"|"}"~\e(B
+ ("\e$(6"p\e(B" . "\e$,15p6-\e(B")
+ ("\e$(6"q\e(B" . "\e$,16-5p\e(B")
+ ("\e$(6"r\e(B" . "\e$,16-5p\e(B")
+ ("\e$(6"s\e(B" . "\e$,1686-\e(B")
+ ("\e$(6"t\e(B" . "\e$,1696-\e(B")
+ ("\e$(6"u\e(B" . "\e$,16:6-\e(B")
+ ("\e$(6"y\e(B" . "\e$,16>6-\e(B")
+ ("\e$(6"z\e(B" . "\e$,16;6-\e(B")
;; 0 1 2 3 4 5 6 7 8 9 a b c d e f
- ;;2320 \e$(5#!#"###$#%#&#'#(#)#*#+#,#-#.#/\e(B
- ("\e$(5#!\e(B" . "\e$,160\e(B")
- ("\e$(5#&\e(B" . "\e$,15L\e(B")
- ("\e$(5#&"p\e(B" . "\e$,15p6$\e(B")
- ("\e$(5#'\e(B" . "\e$,16A\e(B")
- ("\e$(5#'"p\e(B" . "\e$,15p6C\e(B")
- ("\e$(5#*\e(B" . "\e$,16@\e(B")
- ("\e$(5#*"p\e(B" . "\e$,15p6B\e(B")
+ ;;2320 \e$(6#!#"###$#%#&#'#(#)#*#+#,#-#.#/\e(B
+ ("\e$(6#!\e(B" . "\e$,160\e(B")
+ ("\e$(6#&\e(B" . "\e$,15L\e(B")
+ ("\e$(6#&"p\e(B" . "\e$,15p6$\e(B")
+ ("\e$(6#'\e(B" . "\e$,16A\e(B")
+ ("\e$(6#'"p\e(B" . "\e$,15p6C\e(B")
+ ("\e$(6#*\e(B" . "\e$,16@\e(B")
+ ("\e$(6#*"p\e(B" . "\e$,15p6B\e(B")
;; 0 1 2 3 4 5 6 7 8 9 a b c d e f
- ;;2330 \e$(5#0#1#2#3#4#5#6#7#8#9#:#;#<#=#>#?\e(B
- ("\e$(5#3\e(B" . "\e$,168\e(B")
- ("\e$(5#4\e(B" . "\e$,169\e(B")
- ("\e$(5#5\e(B" . "\e$,16:\e(B")
- ("\e$(5#:\e(B" . "\e$,16;\e(B")
- ("\e$(5#?\e(B" . "\e$,16<\e(B")
+ ;;2330 \e$(6#0#1#2#3#4#5#6#7#8#9#:#;#<#=#>#?\e(B
+ ("\e$(6#3\e(B" . "\e$,168\e(B")
+ ("\e$(6#4\e(B" . "\e$,169\e(B")
+ ("\e$(6#5\e(B" . "\e$,16:\e(B")
+ ("\e$(6#:\e(B" . "\e$,16;\e(B")
+ ("\e$(6#?\e(B" . "\e$,16<\e(B")
;; 0 1 2 3 4 5 6 7 8 9 a b c d e f
- ;;2340 \e$(5#@#A#B#C#D#E#F#G#H#I#J#K#L#M#N#O\e(B
- ("\e$(5#@\e(B" . "\e$,16=\e(B")
- ("\e$(5#I\e(B" . "\e$,16>\e(B")
- ("\e$(5#J\e(B" . "\e$,15}\e(B")
- ("\e$(5#K\e(B" . "\e$,16$\e(B")
- ("\e$(5#L\e(B" . "\e$,16B\e(B")
- ("\e$(5#M\e(B" . "\e$,16C\e(B")
+ ;;2340 \e$(6#@#A#B#C#D#E#F#G#H#I#J#K#L#M#N#O\e(B
+ ("\e$(6#@\e(B" . "\e$,16=\e(B")
+ ("\e$(6#I\e(B" . "\e$,16>\e(B")
+ ("\e$(6#J\e(B" . "\e$,15}\e(B")
+ ("\e$(6#K\e(B" . "\e$,16$\e(B")
+ ("\e$(6#L\e(B" . "\e$,16B\e(B")
+ ("\e$(6#M\e(B" . "\e$,16C\e(B")
;; 0 1 2 3 4 5 6 7 8 9 a b c d e f
- ;;2350 \e$(5#P#Q#R#S#T#U#V#W#X#Y#Z#[#\#]#^#_\e(B
- ("\e$(5#P\e(B" . "\e$,15n6-5h\e(B")
- ("\e$(5#Q\e(B" . "\e$,15n6-5r\e(B")
- ("\e$(5#R\e(B" . "\e$,15y6#\e(B")
+ ;;2350 \e$(6#P#Q#R#S#T#U#V#W#X#Y#Z#[#\#]#^#_\e(B
+ ("\e$(6#P\e(B" . "\e$,15n6-5h\e(B")
+ ("\e$(6#Q\e(B" . "\e$,15n6-5r\e(B")
+ ("\e$(6#R\e(B" . "\e$,15y6#\e(B")
;; 0 1 2 3 4 5 6 7 8 9 a b c d e f
- ;;2360 \e$(5#`#a#b#c#d#e#f#g#h#i#j#k#l#m#n#o\e(B
- ("\e$(5#`\e(B" . "\e$,15r6-5r\e(B")
- ("\e$(5#a\e(B" . "\e$,15u6-5h\e(B")
- ("\e$(5#b\e(B" . "\e$,15u6-5u\e(B")
- ("\e$(5#c\e(B" . "\e$,15v6-5Z\e(B")
- ("\e$(5#d\e(B" . "\e$,15v6-5h\e(B")
- ("\e$(5#e\e(B" . "\e$,15v6-5l\e(B")
- ("\e$(5#f\e(B" . "\e$,15v6-5r\e(B")
- ("\e$(5#g\e(B" . "\e$,15v6-5u\e(B")
- ("\e$(5#h\e(B" . "\e$,15w6-5_6-5p6-5o\e(B")
- ("\e$(5#i\e(B" . "\e$,15w6-5_6-5o\e(B")
- ("\e$(5#j\e(B" . "\e$,15w6-5_6-5u\e(B")
- ("\e$(5#k\e(B" . "\e$,15w6-5_\e(B")
- ("\e$(5#l\e(B" . "\e$,15w6-5`\e(B")
- ("\e$(5#m\e(B" . "\e$,15x6-5h\e(B")
- ("\e$(5#n\e(B" . "\e$,15x6-5p\e(B")
+ ;;2360 \e$(6#`#a#b#c#d#e#f#g#h#i#j#k#l#m#n#o\e(B
+ ("\e$(6#`\e(B" . "\e$,15r6-5r\e(B")
+ ("\e$(6#a\e(B" . "\e$,15u6-5h\e(B")
+ ("\e$(6#b\e(B" . "\e$,15u6-5u\e(B")
+ ("\e$(6#c\e(B" . "\e$,15v6-5Z\e(B")
+ ("\e$(6#d\e(B" . "\e$,15v6-5h\e(B")
+ ("\e$(6#e\e(B" . "\e$,15v6-5l\e(B")
+ ("\e$(6#f\e(B" . "\e$,15v6-5r\e(B")
+ ("\e$(6#g\e(B" . "\e$,15v6-5u\e(B")
+ ("\e$(6#h\e(B" . "\e$,15w6-5_6-5p6-5o\e(B")
+ ("\e$(6#i\e(B" . "\e$,15w6-5_6-5o\e(B")
+ ("\e$(6#j\e(B" . "\e$,15w6-5_6-5u\e(B")
+ ("\e$(6#k\e(B" . "\e$,15w6-5_\e(B")
+ ("\e$(6#l\e(B" . "\e$,15w6-5`\e(B")
+ ("\e$(6#m\e(B" . "\e$,15x6-5h\e(B")
+ ("\e$(6#n\e(B" . "\e$,15x6-5p\e(B")
;; 0 1 2 3 4 5 6 7 8 9 a b c d e f
- ;;2370 \e$(5#p#q#r#s#t#u#v#w#x#y#z#{#|#}#~\e(B
- ("\e$(5#p\e(B" . "\e$,15y6-5c\e(B")
- ("\e$(5#q\e(B" . "\e$,15y6-5h\e(B")
- ("\e$(5#r\e(B" . "\e$,15y6-5n\e(B")
- ("\e$(5#s\e(B" . "\e$,15y6-5o\e(B")
- ("\e$(5#t\e(B" . "\e$,15y6-5p\e(B")
- ("\e$(5#u\e(B" . "\e$,15y6-5r\e(B")
- ("\e$(5#v\e(B" . "\e$,15y6-5u\e(B")
+ ;;2370 \e$(6#p#q#r#s#t#u#v#w#x#y#z#{#|#}#~\e(B
+ ("\e$(6#p\e(B" . "\e$,15y6-5c\e(B")
+ ("\e$(6#q\e(B" . "\e$,15y6-5h\e(B")
+ ("\e$(6#r\e(B" . "\e$,15y6-5n\e(B")
+ ("\e$(6#s\e(B" . "\e$,15y6-5o\e(B")
+ ("\e$(6#t\e(B" . "\e$,15y6-5p\e(B")
+ ("\e$(6#u\e(B" . "\e$,15y6-5r\e(B")
+ ("\e$(6#v\e(B" . "\e$,15y6-5u\e(B")
;; 0 1 2 3 4 5 6 7 8 9 a b c d e f
- ;;2420 \e$(5$!$"$#$$$%$&$'$($)$*$+$,$-$.$/\e(B
- ("\e$(5$!\e(B" . "\e$,15U6-5d6-5p6-5o\e(B")
- ("\e$(5$"\e(B" . "\e$,15U6-5d6-5u\e(B")
- ("\e$(5$#\e(B" . "\e$,15U6-5d6-5o\e(B")
- ("\e$(5$$\e(B" . "\e$,15U6-5h6-5o\e(B")
- ("\e$(5$%\e(B" . "\e$,15U6-5p6-5o\e(B")
- ("\e$(5$&\e(B" . "\e$,15U6-5u6-5o\e(B")
- ("\e$(5$'\e(B" . "\e$,15U6-5U\e(B")
- ("\e$(5$(\e(B" . "\e$,15U6-5d\e(B")
- ("\e$(5$)\e(B" . "\e$,15U6-5h\e(B")
- ("\e$(5$*\e(B" . "\e$,15U6-5n\e(B")
- ("\e$(5$+\e(B" . "\e$,15U6-5o\e(B")
- ("\e$(5$,\e(B" . "\e$,15U6-5r\e(B")
- ("\e$(5$-\e(B" . "\e$,15U6-5u\e(B")
- ("\e$(5$.\e(B" . "\e$,15U6-5w\e(B")
- ("\e$(5$/\e(B" . "\e$,15X6-5h\e(B")
+ ;;2420 \e$(6$!$"$#$$$%$&$'$($)$*$+$,$-$.$/\e(B
+ ("\e$(6$!\e(B" . "\e$,15U6-5d6-5p6-5o\e(B")
+ ("\e$(6$"\e(B" . "\e$,15U6-5d6-5u\e(B")
+ ("\e$(6$#\e(B" . "\e$,15U6-5d6-5o\e(B")
+ ("\e$(6$$\e(B" . "\e$,15U6-5h6-5o\e(B")
+ ("\e$(6$%\e(B" . "\e$,15U6-5p6-5o\e(B")
+ ("\e$(6$&\e(B" . "\e$,15U6-5u6-5o\e(B")
+ ("\e$(6$'\e(B" . "\e$,15U6-5U\e(B")
+ ("\e$(6$(\e(B" . "\e$,15U6-5d\e(B")
+ ("\e$(6$)\e(B" . "\e$,15U6-5h\e(B")
+ ("\e$(6$*\e(B" . "\e$,15U6-5n\e(B")
+ ("\e$(6$+\e(B" . "\e$,15U6-5o\e(B")
+ ("\e$(6$,\e(B" . "\e$,15U6-5r\e(B")
+ ("\e$(6$-\e(B" . "\e$,15U6-5u\e(B")
+ ("\e$(6$.\e(B" . "\e$,15U6-5w\e(B")
+ ("\e$(6$/\e(B" . "\e$,15X6-5h\e(B")
;; 0 1 2 3 4 5 6 7 8 9 a b c d e f
- ;;2430 \e$(5$0$1$2$3$4$5$6$7$8$9$:$;$<$=$>$?\e(B
- ("\e$(5$0\e(B" . "\e$,15Y6-5U6-5d6-5o\e(B")
- ("\e$(5$1\e(B" . "\e$,15Y6-5U6-5w6-5u\e(B")
- ("\e$(5$2\e(B" . "\e$,15Y6-5U6-5d\e(B")
- ("\e$(5$3\e(B" . "\e$,15Y6-5U6-5w\e(B")
- ("\e$(5$4\e(B" . "\e$,15Y6-5X6-5p\e(B")
- ("\e$(5$5\e(B" . "\e$,15Y6-5U6-5o\e(B")
- ("\e$(5$6\e(B" . "\e$,15Y6-5V6-5o\e(B")
- ("\e$(5$7\e(B" . "\e$,15Y6-5W6-5o\e(B")
- ("\e$(5$8\e(B" . "\e$,15Y6-5X6-5o\e(B")
- ("\e$(5$9\e(B" . "\e$,15Y6-5U\e(B")
- ("\e$(5$:\e(B" . "\e$,15Y6-5V\e(B")
- ("\e$(5$;\e(B" . "\e$,15Y6-5W\e(B")
- ("\e$(5$<\e(B" . "\e$,15Y6-5X\e(B")
- ("\e$(5$=\e(B" . "\e$,15Y6-5Y\e(B")
- ("\e$(5$>\e(B" . "\e$,15Y6-5h\e(B")
- ("\e$(5$?\e(B" . "\e$,15Y6-5n\e(B")
+ ;;2430 \e$(6$0$1$2$3$4$5$6$7$8$9$:$;$<$=$>$?\e(B
+ ("\e$(6$0\e(B" . "\e$,15Y6-5U6-5d6-5o\e(B")
+ ("\e$(6$1\e(B" . "\e$,15Y6-5U6-5w6-5u\e(B")
+ ("\e$(6$2\e(B" . "\e$,15Y6-5U6-5d\e(B")
+ ("\e$(6$3\e(B" . "\e$,15Y6-5U6-5w\e(B")
+ ("\e$(6$4\e(B" . "\e$,15Y6-5X6-5p\e(B")
+ ("\e$(6$5\e(B" . "\e$,15Y6-5U6-5o\e(B")
+ ("\e$(6$6\e(B" . "\e$,15Y6-5V6-5o\e(B")
+ ("\e$(6$7\e(B" . "\e$,15Y6-5W6-5o\e(B")
+ ("\e$(6$8\e(B" . "\e$,15Y6-5X6-5o\e(B")
+ ("\e$(6$9\e(B" . "\e$,15Y6-5U\e(B")
+ ("\e$(6$:\e(B" . "\e$,15Y6-5V\e(B")
+ ("\e$(6$;\e(B" . "\e$,15Y6-5W\e(B")
+ ("\e$(6$<\e(B" . "\e$,15Y6-5X\e(B")
+ ("\e$(6$=\e(B" . "\e$,15Y6-5Y\e(B")
+ ("\e$(6$>\e(B" . "\e$,15Y6-5h\e(B")
+ ("\e$(6$?\e(B" . "\e$,15Y6-5n\e(B")
;; 0 1 2 3 4 5 6 7 8 9 a b c d e f
- ;;2440 \e$(5$@$A$B$C$D$E$F$G$H$I$J$K$L$M$N$O\e(B
- ("\e$(5$@\e(B" . "\e$,15Y6-5o\e(B")
- ("\e$(5$A\e(B" . "\e$,15Z6-5Z\e(B")
- ("\e$(5$B\e(B" . "\e$,15Z6-5^\e(B")
- ("\e$(5$C\e(B" . "\e$,15[6-5o\e(B")
- ("\e$(5$D\e(B" . "\e$,15\6-5p\e(B")
- ("\e$(5$E\e(B" . "\e$,15\6-5^\e(B")
- ("\e$(5$F\e(B" . "\e$,15^6-5Z\e(B")
- ("\e$(5$G\e(B" . "\e$,15^6-5\\e(B")
- ("\e$(5$H\e(B" . "\e$,15_6-5U\e(B")
- ("\e$(5$I\e(B" . "\e$,15_6-5_\e(B")
- ("\e$(5$J\e(B" . "\e$,15_6-5`\e(B")
- ("\e$(5$K\e(B" . "\e$,15_6-5o\e(B")
- ("\e$(5$L\e(B" . "\e$,15`6-5o\e(B")
- ("\e$(5$M\e(B" . "\e$,15a6-5W6-5o\e(B")
- ("\e$(5$N\e(B" . "\e$,15a6-5X6-5p\e(B")
- ("\e$(5$O\e(B" . "\e$,15a6-5p6-5o\e(B")
+ ;;2440 \e$(6$@$A$B$C$D$E$F$G$H$I$J$K$L$M$N$O\e(B
+ ("\e$(6$@\e(B" . "\e$,15Y6-5o\e(B")
+ ("\e$(6$A\e(B" . "\e$,15Z6-5Z\e(B")
+ ("\e$(6$B\e(B" . "\e$,15Z6-5^\e(B")
+ ("\e$(6$C\e(B" . "\e$,15[6-5o\e(B")
+ ("\e$(6$D\e(B" . "\e$,15\6-5p\e(B")
+ ("\e$(6$E\e(B" . "\e$,15\6-5^\e(B")
+ ("\e$(6$F\e(B" . "\e$,15^6-5Z\e(B")
+ ("\e$(6$G\e(B" . "\e$,15^6-5\\e(B")
+ ("\e$(6$H\e(B" . "\e$,15_6-5U\e(B")
+ ("\e$(6$I\e(B" . "\e$,15_6-5_\e(B")
+ ("\e$(6$J\e(B" . "\e$,15_6-5`\e(B")
+ ("\e$(6$K\e(B" . "\e$,15_6-5o\e(B")
+ ("\e$(6$L\e(B" . "\e$,15`6-5o\e(B")
+ ("\e$(6$M\e(B" . "\e$,15a6-5W6-5o\e(B")
+ ("\e$(6$N\e(B" . "\e$,15a6-5X6-5p\e(B")
+ ("\e$(6$O\e(B" . "\e$,15a6-5p6-5o\e(B")
;; 0 1 2 3 4 5 6 7 8 9 a b c d e f
- ;;2450 \e$(5$P$Q$R$S$T$U$V$W$X$Y$Z$[$\$]$^$_\e(B
- ("\e$(5$P\e(B" . "\e$,15a6-5W\e(B")
- ("\e$(5$Q\e(B" . "\e$,15a6-5X\e(B")
- ("\e$(5$R\e(B" . "\e$,15a6-5a\e(B")
- ("\e$(5$S\e(B" . "\e$,15a6-5n\e(B")
- ("\e$(5$T\e(B" . "\e$,15a6-5o\e(B")
+ ;;2450 \e$(6$P$Q$R$S$T$U$V$W$X$Y$Z$[$\$]$^$_\e(B
+ ("\e$(6$P\e(B" . "\e$,15a6-5W\e(B")
+ ("\e$(6$Q\e(B" . "\e$,15a6-5X\e(B")
+ ("\e$(6$R\e(B" . "\e$,15a6-5a\e(B")
+ ("\e$(6$S\e(B" . "\e$,15a6-5n\e(B")
+ ("\e$(6$T\e(B" . "\e$,15a6-5o\e(B")
;; 0 1 2 3 4 5 6 7 8 9 a b c d e f
- ;;2460 \e$(5$`$a$b$c$d$e$f$g$h$i$j$k$l$m$n$o\e(B
- ("\e$(5$`\e(B" . "\e$,15b6-5o\e(B")
- ("\e$(5$a\e(B" . "\e$,15d6-5d\e(B")
- ("\e$(5$b\e(B" . "\e$,15d6-5h\e(B")
- ("\e$(5$c\e(B" . "\e$,15f6-5f6-5o\e(B")
- ("\e$(5$d\e(B" . "\e$,15f6-5g6-5o\e(B")
- ("\e$(5$e\e(B" . "\e$,15f6-5m6-5o\e(B")
- ("\e$(5$f\e(B" . "\e$,15f6-5p6-5o\e(B")
- ("\e$(5$g\e(B" . "\e$,15f6-5u6-5o\e(B")
- ("\e$(5$h\e(B" . "\e$,15f6-5W6-5p\e(B")
- ("\e$(5$i\e(B" . "\e$,15f6-5X6-5p\e(B")
- ("\e$(5$j\e(B" . "\e$,15f6-5f6-5u\e(B")
- ("\e$(5$k\e(B" . "\e$,15f6-5g6-5u\e(B")
- ("\e$(5$l\e(B" . "\e$,15f6-5W\e(B")
- ("\e$(5$m\e(B" . "\e$,15f6-5X\e(B")
- ("\e$(5$n\e(B" . "\e$,15f6-5f\e(B")
- ("\e$(5$o\e(B" . "\e$,15f6-5g\e(B")
+ ;;2460 \e$(6$`$a$b$c$d$e$f$g$h$i$j$k$l$m$n$o\e(B
+ ("\e$(6$`\e(B" . "\e$,15b6-5o\e(B")
+ ("\e$(6$a\e(B" . "\e$,15d6-5d\e(B")
+ ("\e$(6$b\e(B" . "\e$,15d6-5h\e(B")
+ ("\e$(6$c\e(B" . "\e$,15f6-5f6-5o\e(B")
+ ("\e$(6$d\e(B" . "\e$,15f6-5g6-5o\e(B")
+ ("\e$(6$e\e(B" . "\e$,15f6-5m6-5o\e(B")
+ ("\e$(6$f\e(B" . "\e$,15f6-5p6-5o\e(B")
+ ("\e$(6$g\e(B" . "\e$,15f6-5u6-5o\e(B")
+ ("\e$(6$h\e(B" . "\e$,15f6-5W6-5p\e(B")
+ ("\e$(6$i\e(B" . "\e$,15f6-5X6-5p\e(B")
+ ("\e$(6$j\e(B" . "\e$,15f6-5f6-5u\e(B")
+ ("\e$(6$k\e(B" . "\e$,15f6-5g6-5u\e(B")
+ ("\e$(6$l\e(B" . "\e$,15f6-5W\e(B")
+ ("\e$(6$m\e(B" . "\e$,15f6-5X\e(B")
+ ("\e$(6$n\e(B" . "\e$,15f6-5f\e(B")
+ ("\e$(6$o\e(B" . "\e$,15f6-5g\e(B")
;; 0 1 2 3 4 5 6 7 8 9 a b c d e f
- ;;2470 \e$(5$p$q$r$s$t$u$v$w$x$y$z${$|$}$~\e(B
- ("\e$(5$p\e(B" . "\e$,15f6-5h\e(B")
- ("\e$(5$q\e(B" . "\e$,15f6-5l\e(B")
- ("\e$(5$r\e(B" . "\e$,15f6-5m\e(B")
- ("\e$(5$s\e(B" . "\e$,15f6-5n\e(B")
- ("\e$(5$t\e(B" . "\e$,15f6-5o\e(B")
- ("\e$(5$u\e(B" . "\e$,15f6-5u\e(B")
- ("\e$(5$v\e(B" . "\e$,15g6-5h\e(B")
- ("\e$(5$w\e(B" . "\e$,15h6-5h\e(B")
- ("\e$(5$x\e(B" . "\e$,15j6-5d\e(B")
- ("\e$(5$y\e(B" . "\e$,15j6-5h\e(B")
- ("\e$(5$z\e(B" . "\e$,15j6-5r\e(B")
- ("\e$(5${\e(B" . "\e$,15l6-5h\e(B")
- ("\e$(5$|\e(B" . "\e$,15l6-5l\e(B")
- ("\e$(5$}\e(B" . "\e$,15l6-5u\e(B")
- ("\e$(5$~\e(B" . "\e$,15m6-5h\e(B")))
+ ;;2470 \e$(6$p$q$r$s$t$u$v$w$x$y$z${$|$}$~\e(B
+ ("\e$(6$p\e(B" . "\e$,15f6-5h\e(B")
+ ("\e$(6$q\e(B" . "\e$,15f6-5l\e(B")
+ ("\e$(6$r\e(B" . "\e$,15f6-5m\e(B")
+ ("\e$(6$s\e(B" . "\e$,15f6-5n\e(B")
+ ("\e$(6$t\e(B" . "\e$,15f6-5o\e(B")
+ ("\e$(6$u\e(B" . "\e$,15f6-5u\e(B")
+ ("\e$(6$v\e(B" . "\e$,15g6-5h\e(B")
+ ("\e$(6$w\e(B" . "\e$,15h6-5h\e(B")
+ ("\e$(6$x\e(B" . "\e$,15j6-5d\e(B")
+ ("\e$(6$y\e(B" . "\e$,15j6-5h\e(B")
+ ("\e$(6$z\e(B" . "\e$,15j6-5r\e(B")
+ ("\e$(6${\e(B" . "\e$,15l6-5h\e(B")
+ ("\e$(6$|\e(B" . "\e$,15l6-5l\e(B")
+ ("\e$(6$}\e(B" . "\e$,15l6-5u\e(B")
+ ("\e$(6$~\e(B" . "\e$,15m6-5h\e(B")))
(defconst indian-2-column-to-ucs-regexp
- "\e$(5!j!j\e(B\\|\e$(5"8"q\e(B\\|[\e$(5#&#'!*#*\e(B]\e$(5"p\e(B\\|[\e$(5!!\e(B-\e$(5$~\e(B]")
+ "\e$(6!j!j\e(B\\|\e$(6"8"q\e(B\\|[\e$(6#&#'!*#*\e(B]\e$(6"p\e(B\\|[\e$(6!!\e(B-\e$(6$~\e(B]")
(put 'indian-2-column-to-ucs-chartable 'char-table-extra-slots 1)
(defconst indian-2-column-to-ucs-chartable
(let ((table (make-char-table 'indian-2-column-to-ucs-chartable))
- (alist nil))
+ (alist nil))
(dolist (elt indian-2-colum-to-ucs)
(if (= (length (car elt)) 1)
- (aset table (aref (car elt) 0) (cdr elt))
- (setq alist (cons elt alist))))
+ (aset table (aref (car elt) 0) (cdr elt))
+ (setq alist (cons elt alist))))
(set-char-table-extra-slot table 0 alist)
table))
+;;;###autoload
(defun indian-2-column-to-ucs-region (from to)
"Convert old Emacs Devanagari characters to UCS."
(interactive "r")
(save-excursion
(save-restriction
(let ((pos from)
- (alist (char-table-extra-slot indian-2-column-to-ucs-chartable 0)))
- (narrow-to-region from to)
- (decompose-region from to)
- (goto-char (point-min))
- (while (re-search-forward indian-2-column-to-ucs-regexp nil t)
- (let ((len (- (match-end 0) (match-beginning 0)))
- subst)
- (if (= len 1)
- (setq subst (aref indian-2-column-to-ucs-chartable
+ (alist (char-table-extra-slot indian-2-column-to-ucs-chartable 0)))
+ (narrow-to-region from to)
+ (decompose-region from to)
+ (goto-char (point-min))
+ (while (re-search-forward indian-2-column-to-ucs-regexp nil t)
+ (let ((len (- (match-end 0) (match-beginning 0)))
+ subst)
+ (if (= len 1)
+ (setq subst (aref indian-2-column-to-ucs-chartable
(char-after (match-beginning 0))))
- (setq subst (cdr (assoc (match-string 0) alist))))
- (replace-match (if subst subst "?"))))
- (indian-compose-region (point-min) (point-max))))))
-
-;;;###autoload
-(defun indian-glyph-char (index &optional script)
- "Return character of charset `indian-glyph' made from glyph index INDEX.
-The variable `indian-default-script' specifies the script of the glyph.
-Optional argument SCRIPT, if non-nil, overrides `indian-default-script'.
-See also the function `indian-char-glyph'."
- (or script
- (setq script indian-default-script))
- (let ((offset (get script 'indian-glyph-code-offset)))
- (or (integerp offset)
- (error "Invalid script name: %s" script))
- (or (and (>= index 0) (< index 256))
- (error "Invalid glyph index: %d" index))
- (setq index (+ offset index))
- (make-char 'indian-glyph (+ (/ index 96) 32) (+ (% index 96) 32))))
-
-(defvar indian-glyph-max-char
- (indian-glyph-char
- 255 (aref indian-script-table (1- (length indian-script-table))))
- "The maximum valid code of characters in the charset `indian-glyph'.")
-
-;;;###autoload
-(defun indian-char-glyph (char)
- "Return information about the glyph code for CHAR of `indian-glyph' charset.
-The value is (INDEX . SCRIPT), where INDEX is the glyph index
-in the font that Indian script name SCRIPT specifies.
-See also the function `indian-glyph-char'."
- (let ((split (split-char char))
- code)
- (or (eq (car split) 'indian-glyph)
- (error "Charset of `%c' is not indian-glyph" char))
- (or (<= char indian-glyph-max-char)
- (error "Invalid indian-glyph char: %d" char))
- (setq code (+ (* (- (nth 1 split) 32) 96) (nth 2 split) -32))
- (cons (% code 256) (aref indian-script-table (/ code 256)))))
+ (setq subst (cdr (assoc (match-string 0) alist))))
+ (replace-match (if subst subst "?"))))
+ (indian-compose-region (point-min) (point-max))))))
(provide 'ind-util)
;;; indian.el --- Indian languages support -*- coding: iso-2022-7bit; -*-
- ;; Copyright (C) 1997, 1999, 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ ;; Copyright (C) 1997, 1999, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
;; Free Software Foundation, Inc.
- ;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007
+ ;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
;;; Code:
-(make-coding-system
- 'in-is13194 2 ?D
- "8-bit encoding for ASCII (MSB=0) and IS13194-Devanagari (MSB=1)."
- '(ascii indian-is13194 nil nil
- nil ascii-eol)
- `((safe-chars . ,(let ((table (make-char-table 'safe-chars nil)))
- (set-char-table-range table 'indian-is13194 t)
- (dotimes (i 127)
- (aset table i t)
- (aset table (decode-char 'ucs (+ #x900 i)) t))
- table))
- (post-read-conversion . in-is13194-post-read-conversion)
- (pre-write-conversion . in-is13194-pre-write-conversion)))
-
-(define-coding-system-alias 'devanagari 'in-is13194)
+(define-coding-system 'in-is13194-devanagari
+ "8-bit encoding for ASCII (MSB=0) and IS13194-Devanagari (MSB=1)."
+ :coding-type 'iso-2022
+ :mnemonic ?D
+ :designation [ascii indian-is13194 nil nil]
+ :charset-list '(ascii indian-is13194)
+ :post-read-conversion 'in-is13194-post-read-conversion
+ :pre-write-conversion 'in-is13194-pre-write-conversion)
+
+(define-coding-system-alias 'devanagari 'in-is13194-devanagari)
(defvar indian-font-foundry 'cdac
"Font foundry for Indian characters.
to one of `indian-script-table' (which see).
The default value is `devanagari'.")
-(define-ccl-program ccl-encode-indian-glyph-font
- `(0
- ;; Shorten (r1 = (((((r1 - 32) * 96) + r2) - 32) % 256))
- (r1 = ((((r1 * 96) + r2) - ,(+ (* 32 96) 32)) % 256))))
-
-(setq font-ccl-encoder-alist
- (cons (cons "-CDAC" 'ccl-encode-indian-glyph-font)
- font-ccl-encoder-alist))
-
-(setq font-ccl-encoder-alist
- (cons (cons "-AKRUTI" 'ccl-encode-indian-glyph-font)
- font-ccl-encoder-alist))
+(defvar indian-composable-pattern
+ (make-char-table nil)
+ "Char table of regexps for composable Indian character sequence.")
+
+(let ((script-regexp-alist
+ '((devanagari . "[\x900-\x9FF\x200C\x200D]+")
+ (bengali . "[\x980-\x9FF\x200C\x200D]+")
+ (gurmukhi . "[\xA00-\xA7F\x200C\x200D]+")
+ (gujarati . "[\xA80-\xAFF\x200C\x200D]+")
+ (oriya . "[\xB00-\xB7F\x200C\x200D]+")
+ (tamil . "[\xB80-\xBFF\x200C\x200D]+")
+ (telugu . "[\xC00-\xC7F\x200C\x200D]+")
+ (kannada . "[\xC80-\xCFF\x200C\x200D]+")
+ (malayalam . "[\xD00-\xD7F\x200C\x200D]+")
+ (sinhala . "[\xD80-\xDFF\x200C\x200D]+"))))
+ (map-char-table #'(lambda (key val)
+ (let ((slot (assq val script-regexp-alist)))
+ (if slot
+ (set-char-table-range
+ composition-function-table key
+ (list (cons (cdr slot) 'font-shape-text))))))
+ char-script-table))
+
(provide 'indian)
;;; japanese.el --- support for Japanese -*- coding: iso-2022-7bit; no-byte-compile: t -*-
- ;; Copyright (C) 1997, 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ ;; Copyright (C) 1997, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
;; Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- ;; 2005, 2006, 2007
+ ;; 2005, 2006, 2007, 2008
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
+;; Copyright (C) 2003
+;; National Institute of Advanced Industrial Science and Technology (AIST)
+;; Registration Number H13PRO009
;; Keywords: multilingual, Japanese
;;; Code:
-(make-coding-system
- 'iso-2022-jp 2 ?J
- "ISO 2022 based 7bit encoding for Japanese (MIME:ISO-2022-JP)."
- '((ascii japanese-jisx0208-1978 japanese-jisx0208
- latin-jisx0201 japanese-jisx0212) nil nil nil
- short ascii-eol ascii-cntl seven)
- '((safe-charsets ascii japanese-jisx0208-1978 japanese-jisx0208
- latin-jisx0201 japanese-jisx0212)
- (mime-charset . iso-2022-jp)))
+;;; Load translation tables for CP932.
+(load "international/cp51932")
+(load "international/eucjp-ms")
+
+(define-coding-system 'iso-2022-jp
+ "ISO 2022 based 7bit encoding for Japanese (MIME:ISO-2022-JP)."
+ :coding-type 'iso-2022
+ :mnemonic ?J
+ :designation [(ascii japanese-jisx0208-1978 japanese-jisx0208
+ latin-jisx0201)
+ nil nil nil]
+ :flags '(short ascii-at-eol ascii-at-cntl 7-bit designation)
+ :charset-list '(ascii japanese-jisx0208
+ japanese-jisx0208-1978 latin-jisx0201)
+ :mime-charset 'iso-2022-jp
+ :suitable-for-keyboard t)
(define-coding-system-alias 'junet 'iso-2022-jp)
-(make-coding-system
- 'iso-2022-jp-2 2 ?J
- "ISO 2022 based 7bit encoding for CJK, Latin-1, and Greek (MIME:ISO-2022-JP-2)."
- '((ascii japanese-jisx0208-1978 japanese-jisx0208
- latin-jisx0201 japanese-jisx0212
- chinese-gb2312 korean-ksc5601) nil
- (nil latin-iso8859-1 greek-iso8859-7) nil
- short ascii-eol ascii-cntl seven nil single-shift nil nil nil init-bol)
- '((safe-charsets ascii japanese-jisx0208-1978 japanese-jisx0208
- latin-jisx0201 japanese-jisx0212
- chinese-gb2312 korean-ksc5601
- latin-iso8859-1 greek-iso8859-7)
- (mime-charset . iso-2022-jp-2)))
-
-(make-coding-system
- 'japanese-shift-jis 1 ?S
- "Shift-JIS 8-bit encoding for Japanese (MIME:SHIFT_JIS)."
- nil
- '((safe-charsets ascii japanese-jisx0208 japanese-jisx0208-1978
- latin-jisx0201 katakana-jisx0201)
- (mime-charset . shift_jis)
- (charset-origin-alist (japanese-jisx0208 "SJIS" encode-sjis-char)
- (katakana-jisx0201 "SJIS" encode-sjis-char))))
+(define-coding-system 'iso-2022-jp-2
+ "ISO 2022 based 7bit encoding for CJK, Latin-1, Greek (MIME:ISO-2022-JP-2)."
+ :coding-type 'iso-2022
+ :mnemonic ?J
+ :designation [(ascii japanese-jisx0208-1978 japanese-jisx0208
+ latin-jisx0201 japanese-jisx0212
+ chinese-gb2312 korean-ksc5601)
+ nil
+ (nil latin-iso8859-1 greek-iso8859-7)
+ nil]
+ :flags '(short ascii-at-eol ascii-at-cntl 7-bit designation single-shift
+ init-at-bol)
+ :charset-list '(ascii japanese-jisx0208 japanese-jisx0212
+ latin-jisx0201 japanese-jisx0208-1978
+ chinese-gb2312 korean-ksc5601
+ latin-iso8859-1 greek-iso8859-7)
+ :mime-charset 'iso-2022-jp-2
+ :suitable-for-keyboard t)
+
+(let ((map ; JIS vs CP932
+ '((#x301C . #xFF5E) ; WAVE DASH FULLWIDTH TILDE
+ (#x2014 . #x2015) ; EM DASH HORIZONTAL BAR
+ (#x2016 . #x2225) ; DOUBLE VERTICAL LINE PARALLEL TO
+ (#x2212 . #xFF0D) ; MINUS SIGN FULLWIDTH HYPHEN-MINUS
+ (#x00A2 . #xFFE0) ; CENT SIGN FULLWIDTH CENT SIGN
+ (#x00A3 . #xFFE1) ; POUND SIGN FULLWIDTH POUND SIGN
+ (#x00AC . #xFFE2) ; NOT SIGN FULLWIDTH NOT SIGN
+ (#x00A6 . #xFFE4) ; BROKEN LINE FULLWIDTH BROKEN LINE
+ )))
+ (define-translation-table 'japanese-ucs-jis-to-cp932-map map)
+ (mapc #'(lambda (x) (let ((tmp (car x)))
+ (setcar x (cdr x)) (setcdr x tmp)))
+ map)
+ (define-translation-table 'japanese-ucs-cp932-to-jis-map map))
+
+;; U+2014 (EM DASH) vs U+2015 (HORIZONTAL BAR)
+(define-translation-table 'japanese-ucs-glibc-to-jis-map '((#x2015 . #x2014)))
+(define-translation-table 'japanese-ucs-jis-to-glibc-map '((#x2014 . #x2015)))
+
+(define-coding-system 'japanese-shift-jis
+ "Shift-JIS 8-bit encoding for Japanese (MIME:SHIFT_JIS)"
+ :coding-type 'shift-jis
+ :mnemonic ?S
+ :charset-list '(ascii katakana-jisx0201 japanese-jisx0208)
+ :mime-charset 'shift_jis)
(define-coding-system-alias 'shift_jis 'japanese-shift-jis)
(define-coding-system-alias 'sjis 'japanese-shift-jis)
(define-coding-system-alias 'cp932 'japanese-shift-jis)
-(make-coding-system
- 'japanese-iso-7bit-1978-irv 2 ?j
- "ISO 2022 based 7-bit encoding for Japanese JISX0208-1978 and JISX0201-Roman."
- '((ascii japanese-jisx0208-1978 japanese-jisx0208
- latin-jisx0201 japanese-jisx0212 katakana-jisx0201 t) nil nil nil
- short ascii-eol ascii-cntl seven nil nil use-roman use-oldjis)
- '(ascii japanese-jisx0208-1978 japanese-jisx0208 latin-jisx0201))
+(define-coding-system 'japanese-cp932
+ "CP932 (Microsoft shift-jis)"
+ :coding-type 'charset
+ :mnemonic ?S
+ :charset-list '(ascii katakana-sjis cp932-2-byte))
+
+(define-coding-system-alias 'cp932 'japanese-cp932)
+
+(define-coding-system 'japanese-iso-7bit-1978-irv
+ "ISO 2022 based 7-bit encoding for Japanese JISX0208-1978 and JISX0201-Roman."
+ :coding-type 'iso-2022
+ :mnemonic ?j
+ :designation [(latin-jisx0201 japanese-jisx0208-1978 japanese-jisx0208
+ japanese-jisx0212 katakana-jisx0201)
+ nil nil nil]
+ :flags '(short ascii-at-eol ascii-at-cntl 7-bit designation
+ use-roman use-oldjis)
+ :charset-list '(ascii latin-jisx0201 japanese-jisx0208-1978 japanese-jisx0208
+ japanese-jisx0212))
(define-coding-system-alias 'iso-2022-jp-1978-irv 'japanese-iso-7bit-1978-irv)
(define-coding-system-alias 'old-jis 'japanese-iso-7bit-1978-irv)
-(make-coding-system
- 'japanese-iso-8bit 2 ?E
- "ISO 2022 based EUC encoding for Japanese (MIME:EUC-JP)."
- '(ascii japanese-jisx0208 katakana-jisx0201 japanese-jisx0212
- short ascii-eol ascii-cntl nil nil single-shift)
- '((safe-charsets ascii latin-jisx0201 japanese-jisx0208 japanese-jisx0208-1978
- katakana-jisx0201 japanese-jisx0212)
- (mime-charset . euc-jp)))
+(define-coding-system 'japanese-iso-8bit
+ "ISO 2022 based EUC encoding for Japanese (MIME:EUC-JP)."
+ :coding-type 'iso-2022
+ :mnemonic ?E
+ :designation [ascii japanese-jisx0208 katakana-jisx0201 japanese-jisx0212]
+ :flags '(short ascii-at-eol ascii-at-cntl single-shift)
+ :charset-list '(ascii latin-jisx0201 japanese-jisx0208
+ katakana-jisx0201 japanese-jisx0212
+ japanese-jisx0208-1978)
+ :mime-charset 'euc-jp)
(define-coding-system-alias 'euc-japan-1990 'japanese-iso-8bit)
(define-coding-system-alias 'euc-japan 'japanese-iso-8bit)
(define-coding-system-alias 'euc-jp 'japanese-iso-8bit)
+(define-coding-system 'eucjp-ms
+ "eucJP-ms (like EUC-JP but with CP932 extension).
+eucJP-ms is defined in <http://www.opengroup.or.jp/jvc/cde/appendix.html>."
+ :coding-type 'iso-2022
+ :mnemonic ?E
+ :designation [ascii japanese-jisx0208 katakana-jisx0201 japanese-jisx0212]
+ :flags '(short ascii-at-eol ascii-at-cntl single-shift)
+ :charset-list '(ascii latin-jisx0201 japanese-jisx0208
+ katakana-jisx0201 japanese-jisx0212)
+ :decode-translation-table 'eucjp-ms-decode
+ :encode-translation-table 'eucjp-ms-encode)
+
+(define-coding-system 'iso-2022-jp-2004
+ "ISO 2022 based 7bit encoding for JIS X 0213:2004 (MIME:ISO-2022-JP-2004)."
+ :coding-type 'iso-2022
+ :mnemonic ?J
+ :designation [(ascii japanese-jisx0208 japanese-jisx0213.2004-1
+ japanese-jisx0213-1 japanese-jisx0213-2)
+ nil nil nil]
+ :flags '(short ascii-at-eol ascii-at-cntl 7-bit designation)
+ ;; init-at-bol)
+ :charset-list '(ascii japanese-jisx0208 japanese-jisx0213.2004-1
+ japanese-jisx0213-1 japanese-jisx0213-2)
+ :mime-charset 'iso-2022-jp-2004
+ :suitable-for-keyboard t)
+
+(define-coding-system-alias 'iso-2022-jp-3 'iso-2022-jp-2004)
+
+(define-coding-system 'euc-jis-2004
+ "ISO 2022 based EUC encoding for JIS X 0213 (MIME:EUC-JIS-2004)."
+ :coding-type 'iso-2022
+ :mnemonic ?E
+ :designation [ascii japanese-jisx0213.2004-1 katakana-jisx0201
+ japanese-jisx0213-2]
+ :flags '(short ascii-at-eol ascii-at-cntl single-shift)
+ :charset-list '(ascii latin-jisx0201 japanese-jisx0213.2004-1
+ japanese-jisx0213-1 katakana-jisx0201
+ japanese-jisx0213-2)
+ :mime-charset 'euc-jis-2004)
+
+(define-coding-system-alias 'euc-jisx0213 'euc-jis-2004)
+
+(define-coding-system 'japanese-shift-jis-2004
+ "Shift_JIS 8-bit encodinf for Japanese (MIME:SHIFT_JIS-2004)"
+ :coding-type 'shift-jis
+ :mnemonic ?S
+ :charset-list '(ascii katakana-jisx0201
+ japanese-jisx0213.2004-1 japanese-jisx0213-2))
+
+(define-coding-system-alias 'shift_jis-2004 'japanese-shift-jis-2004)
+
(set-language-info-alist
"Japanese" '((setup-function . setup-japanese-environment-internal)
(tutorial . "TUTORIAL.ja")
- (charset japanese-jisx0208 japanese-jisx0208-1978
+ (charset japanese-jisx0208
japanese-jisx0212 latin-jisx0201 katakana-jisx0201
- japanese-jisx0213-1 japanese-jisx0213-2)
+ japanese-jisx0213.2004-1 japanese-jisx0213-1
+ japanese-jisx0213-2 japanese-jisx0208-1978)
(coding-system iso-2022-jp japanese-iso-8bit
- japanese-shift-jis japanese-iso-7bit-1978-irv)
+ japanese-shift-jis japanese-iso-7bit-1978-irv
+ iso-2022-jp-2004 japanese-shift-jis-2004
+ euc-jis-2004)
(coding-priority iso-2022-jp japanese-iso-8bit
- japanese-shift-jis iso-2022-jp-2)
+ japanese-shift-jis
+ iso-2022-jp-2004 euc-jis-2004
+ japanese-shift-jis-2004
+ iso-2022-jp-2)
(input-method . "japanese")
(features japan-util)
(sample-text . "Japanese (\e$BF|K\8l\e(B) \e$B$3$s$K$A$O\e(B, \e(I:]FAJ\e(B")
(documentation . t)))
+(let ((map
+ ;; JISX0213-1 vs Unicode
+ '((#x2477 . [#x304B #x309A])
+ (#x2478 . [#x304D #x309A])
+ (#x2479 . [#x304F #x309A])
+ (#x247a . [#x3051 #x309A])
+ (#x247b . [#x3053 #x309A])
+ (#x2577 . [#x30AB #x309A])
+ (#x2578 . [#x30AD #x309A])
+ (#x2579 . [#x30AF #x309A])
+ (#x257a . [#x30B1 #x309A])
+ (#x257b . [#x30B3 #x309A])
+ (#x257c . [#x30BB #x309A])
+ (#x257d . [#x30C4 #x309A])
+ (#x257e . [#x30C8 #x309A])
+ (#x2678 . [#x31F7 #x309A])
+ (#x2b44 . [#x00E6 #x0300])
+ (#x2b48 . [#x0254 #x0300])
+ (#x2b49 . [#x0254 #x0301])
+ (#x2b4a . [#x028C #x0300])
+ (#x2b4b . [#x028C #x0301])
+ (#x2b4c . [#x0259 #x0300])
+ (#x2b4d . [#x0259 #x0301])
+ (#x2b4e . [#x025A #x0300])
+ (#x2b4f . [#x025A #x0301])
+ (#x2b65 . [#x02E9 #x02E5])
+ (#x2b66 . [#x02E5 #x02E9])))
+ table)
+ (dolist (elt map)
+ (setcar elt (decode-char 'japanese-jisx0213-1 (car elt))))
+ (setq table (make-translation-table-from-alist map))
+ (define-translation-table 'jisx0213-to-unicode table)
+ (define-translation-table 'unicode-to-jisx0213
+ (char-table-extra-slot table 0)))
+
(provide 'japanese)
;;; arch-tag: 450f5537-9d53-4d5e-b731-4cf116d8cbc9
;;; kannada.el --- Support for Kannada -*- coding: iso-2022-7bit; no-byte-compile: t -*-
- ;; Copyright (C) 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ ;; Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008
+ ;; Free Software Foundation, Inc.
;; Maintainer: CHOWKSEY, Kailash C. <klchxbec@m-net.arbornet.org>
;; Keywords: multilingual, Indian, Kannada
(features knd-util)
(sample-text
. (kannada-compose-string
- (copy-sequence "Kannada (\e4\e$,43Ov#4z\e0\e$,1>u\e1\e4\e$,44Kv#4zv#4M\e0\e$,1?(?M?(\e1\e4\e$,43sv#4z\e0\e$,1?!\e1\e(B) \e4\e$,44Kv#4z\e0\e$,1?(\e1\e4\e$,44hv#4zv#4\7f\e0\e$,1?.\e1\e4\e$,44qv#4{v#3Q\e0\e$,1?8?M>u?>\e1\e4\e$,44av#4z\e0\e$,1?0\e1\e(B")))
+ (copy-sequence "Kannada (\e$,1>u?(?M?(?!\e(B) \e$,1?(?.?8?M>u?>?0\e(B")))
(documentation . "\
Kannada language and script is supported in this language
environment."))
'("Indian"))
+;; For automatic composition.
+(set-char-table-range composition-function-table '(#x0c80 . #x0cff)
+ '(("[\x0c80-\x0CFF]+" . font-shape-text)))
+
(provide 'kannada)
;;; arch-tag: 880ba90b-f6f5-4131-bc1d-930705b78416
;;; knd-util.el --- Support for composing Kannada characters
- ;; Copyright (C) 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ ;; Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008
+ ;; Free Software Foundation, Inc.
;; Maintainer: Maintainer: CHOWKSEY, Kailash C. <klchxbec@m-net.arbornet.org>
;; Keywords: multilingual, Kannada
dummy)
(function (lambda (x y) (> (length x) (length y))))))))
-(defun kannada-composition-function (from to pattern &optional string)
- "Compose Kannada characters in REGION, or STRING if specified.
-Assume that the REGION or STRING must fully match the composable
-PATTERN regexp."
- (if string (kannada-compose-syllable-string string)
- (kannada-compose-syllable-region from to))
- (- to from))
-
-;; Register a function to compose Kannada characters.
-(mapc
- (function (lambda (ucs)
- (aset composition-function-table (decode-char 'ucs ucs)
- (list (cons kannada-composable-pattern
- 'kannada-composition-function)))))
- (kannada-range #x0c80 #x0cff))
+;;;###autoload
+(defun kannada-composition-function (pos &optional string)
+ "Compose Kannada characters after the position POS.
+If STRING is not nil, it is a string, and POS is an index to the string.
+In this case, compose characters after POS of the string."
+ (if string
+ ;; Not yet implemented.
+ nil
+ (goto-char pos)
+ (if (looking-at kannada-composable-pattern)
+ (prog1 (match-end 0)
+ (kannada-compose-syllable-region pos (match-end 0))))))
;; Notes on conversion steps.
(defun knd-charseq (from &optional to)
(if (null to) (setq to from))
- (mapcar (function (lambda (x) (indian-glyph-char x 'kannada)))
- (kannada-range from to)))
+ (number-sequence (decode-char 'kannada-cdac from)
+ (decode-char 'kannada-cdac to)))
(defvar knd-glyph-cv
(append
;;; korean.el --- support for Korean -*- coding: iso-2022-7bit; no-byte-compile: t -*-
- ;; Copyright (C) 1998, 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ ;; Copyright (C) 1998, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
;; Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- ;; 2005, 2006, 2007
+ ;; 2005, 2006, 2007, 2008
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
+;; Copyright (C) 2003
+;; National Institute of Advanced Industrial Science and Technology (AIST)
+;; Registration Number H13PRO009
;; Keywords: multilingual, Korean
;;; Code:
-(make-coding-system
- 'korean-iso-8bit 2 ?K
- "ISO 2022 based EUC encoding for Korean KSC5601 (MIME:EUC-KR)."
- '(ascii korean-ksc5601 nil nil
- nil ascii-eol ascii-cntl)
- '((safe-charsets ascii korean-ksc5601)
- (mime-charset . euc-kr)))
+(define-coding-system 'korean-iso-8bit
+ "ISO 2022 based EUC encoding for Korean KSC5601 (MIME:EUC-KR)."
+ :coding-type 'iso-2022
+ :mnemonic ?K
+ :designation [ascii korean-ksc5601 nil nil]
+ :charset-list '(ascii korean-ksc5601)
+ :mime-charset 'euc-kr)
(define-coding-system-alias 'euc-kr 'korean-iso-8bit)
(define-coding-system-alias 'euc-korea 'korean-iso-8bit)
(define-coding-system-alias 'cp949 'korean-iso-8bit)
-(make-coding-system
- 'iso-2022-kr 2 ?k
- "ISO 2022 based 7-bit encoding for Korean KSC5601 (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)
- '((safe-charsets ascii korean-ksc5601)
- (mime-charset . iso-2022-kr)))
+(define-coding-system 'iso-2022-kr
+ "ISO 2022 based 7-bit encoding for Korean KSC5601 (MIME:ISO-2022-KR)."
+ :coding-type 'iso-2022
+ :mnemonic ?k
+ :designation [ascii (nil korean-ksc5601) nil nil]
+ :flags '(ascii-at-eol ascii-at-cntl 7-bit designation locking-shift
+ designation-bol)
+ :charset-list '(ascii korean-ksc5601)
+ :mime-charset 'iso-2022-kr
+ :suitable-for-keyboard t)
(define-coding-system-alias 'korean-iso-7bit-lock 'iso-2022-kr)
;;; lao-util.el --- utilities for Lao -*- coding: iso-2022-7bit; -*-
- ;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ ;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
;; Free Software Foundation, Inc.
- ;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ ;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
+ ;; 2007, 2008
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
+;; Copyright (C) 2003
+;; National Institute of Advanced Industrial Science and Technology (AIST)
+;; Registration Number H13PRO009
-;; Keywords: multilingual, Lao
+;; Keywords: multilingual, Lao, i18n
;; This file is part of GNU Emacs.
(?\e(1{\e(B invalid nil)
(?\e(1|\e(B consonant "LETTER NHOR NHUU" "MOUSE")
(?\e(1}\e(B consonant "LETTER MHOR MHAR" "DOG")
- (?\e(1~\e(B invalid nil)
- ;; Unicode equivalents
- (?\e$,1D!\e(B consonant "LETTER KOR KAI'" "CHICKEN")
- (?\e$,1D"\e(B consonant "LETTER KHOR KHAI'" "EGG")
- (?\e$,1D$\e(B consonant "LETTER QHOR QHWARGN" "BUFFALO")
- (?\e$,1D'\e(B consonant "LETTER NGOR NGUU" "SNAKE")
- (?\e$,1D(\e(B consonant "LETTER JOR JUA" "BUDDHIST NOVICE")
- (?\e$,1D*\e(B consonant "LETTER XOR X\"ARNG" "ELEPHANT")
- (?\e$,1D-\e(B consonant "LETTER YOR YUNG" "MOSQUITO")
- (?\e$,1D4\e(B consonant "LETTER DOR DANG" "NOSE")
- (?\e$,1D5\e(B consonant "LETTER TOR TAR" "EYE")
- (?\e$,1D6\e(B consonant "LETTER THOR THUNG" "TO ASK,QUESTION")
- (?\e$,1D7\e(B consonant "LETTER DHOR DHARM" "FLAG")
- (?\e$,1D9\e(B consonant "LETTER NOR NOK" "BIRD")
- (?\e$,1D:\e(B consonant "LETTER BOR BED" "FISHHOOK")
- (?\e$,1D;\e(B consonant "LETTER POR PAR" "FISH")
- (?\e$,1D<\e(B consonant "LETTER HPOR HPER\"" "BEE")
- (?\e$,1D=\e(B consonant "LETTER FHOR FHAR" "WALL")
- (?\e$,1D>\e(B consonant "LETTER PHOR PHUU" "MOUNTAIN")
- (?\e$,1D?\e(B consonant "LETTER FOR FAI" "FIRE")
- (?\e$,1DA\e(B consonant "LETTER MOR MAR\"" "HORSE")
- (?\e$,1DB\e(B consonant "LETTER GNOR GNAR" "MEDICINE")
- (?\e$,1DC\e(B consonant "LETTER ROR ROD" "CAR")
- (?\e$,1DE\e(B consonant "LETTER LOR LIING" "MONKEY")
- (?\e$,1DG\e(B consonant "LETTER WOR WII" "HAND FAN")
- (?\e$,1DJ\e(B consonant "LETTER SOR SEA" "TIGER")
- (?\e$,1DK\e(B consonant "LETTER HHOR HHAI" "JAR")
- (?\e$,1DM\e(B consonant "LETTER OR OOW" "TAKE")
- (?\e$,1DN\e(B consonant "LETTER HOR HEA" "BOAT")
- (?\e$,1DO\e(B special "ELLIPSIS")
- (?\e$,1DP\e(B vowel-base "VOWEL SIGN SARA A")
- (?\e$,1DQ\e(B vowel-upper "VOWEL SIGN MAI KAN")
- (?\e$,1DR\e(B vowel-base "VOWEL SIGN SARA AR")
- (?\e$,1DS\e(B vowel-base "VOWEL SIGN SARA AM")
- (?\e$,1DT\e(B vowel-upper "VOWEL SIGN SARA I")
- (?\e$,1DU\e(B vowel-upper "VOWEL SIGN SARA II")
- (?\e$,1DV\e(B vowel-upper "VOWEL SIGN SARA EU")
- (?\e$,1DW\e(B vowel-upper "VOWEL SIGN SARA UR")
- (?\e$,1DX\e(B vowel-lower "VOWEL SIGN SARA U")
- (?\e$,1DY\e(B vowel-lower "VOWEL SIGN SARA UU")
- (?\e$,1D[\e(B vowel-upper "VOWEL SIGN MAI KONG")
- (?\e$,1D\\e(B semivowel-lower "SEMIVOWEL SIGN LO")
- (?\e$,1D]\e(B vowel-base "SEMIVOWEL SIGN SARA IA")
- (?\e$,1D`\e(B vowel-base "VOWEL SIGN SARA EE")
- (?\e$,1Da\e(B vowel-base "VOWEL SIGN SARA AA")
- (?\e$,1Db\e(B vowel-base "VOWEL SIGN SARA OO")
- (?\e$,1Dc\e(B vowel-base "VOWEL SIGN SARA EI MAI MUAN\"")
- (?\e$,1Dd\e(B vowel-base "VOWEL SIGN SARA AI MAI MAY")
- (?\e$,1Df\e(B special "KO LA (REPETITION)")
- (?\e$,1Dh\e(B tone "TONE MAI EK")
- (?\e$,1Di\e(B tone "TONE MAI THO")
- (?\e$,1Dj\e(B tone "TONE MAI TI")
- (?\e$,1Dk\e(B tone "TONE MAI JADTAWAR")
- (?\e$,1Dl\e(B tone "CANCELLATION MARK")
- (?\e$,1Dm\e(B vowel-upper "VOWEL SIGN SARA OR")
- (?\e$,1Dp\e(B special "DIGIT ZERO")
- (?\e$,1Dq\e(B special "DIGIT ONE")
- (?\e$,1Dr\e(B special "DIGIT TWO")
- (?\e$,1Ds\e(B special "DIGIT THREE")
- (?\e$,1Dt\e(B special "DIGIT FOUR")
- (?\e$,1Du\e(B special "DIGIT FIVE")
- (?\e$,1Dv\e(B special "DIGIT SIX")
- (?\e$,1Dw\e(B special "DIGIT SEVEN")
- (?\e$,1Dx\e(B special "DIGIT EIGHT")
- (?\e$,1Dy\e(B special "DIGIT NINE")
- (?\e$,1D|\e(B consonant "LETTER NHOR NHUU" "MOUSE")
- (?\e$,1D}\e(B consonant "LETTER MHOR MHAR" "DOG")))
+ (?\e(1~\e(B invalid nil)))
elm)
(while l
(setq elm (car l) l (cdr l))
;; CV -> C, CT -> C, CVT -> C, Cv -> C, CvT -> C
;; v v
;; T
-;; V T V T
-;; CsV -> C, CsT -> C, CsVT -> C, Csv -> C, CvT -> C
-;; s s s s s
-;; v v
+;; V T V T
+;; CsV -> C, CsT -> C, CsVT -> C, Csv -> C, CsvT -> C
+;; s s s s s
+;; v v
;; where C: consonant, V: vowel upper, v: vowel lower,
("\e(1d\e(B" (?\e(1d\e(B 0))
("\e(1c\e(B" (?\e(1c\e(B 0))
("\e(1`[R\e(B" (?\e(1`\e(B 0 ?\e(1[\e(B ?\e(1R\e(B))
- ("\e(1S\e(B" (0 ?\e(1S\e(B))
-
- ;; Unicode equivalents
- ("\e$,1DP\e(B" (0 ?\e$,1DP\e(B) (0 ?\e$,1DQ\e(B))
- ("\e$,1DR\e(B" (0 ?\e$,1DR\e(B))
- ("\e$,1DT\e(B" (0 ?\e$,1DU\e(B))
- ("\e$,1DU\e(B" (0 ?\e$,1DU\e(B))
- ("\e$,1DV\e(B" (0 ?\e$,1DV\e(B))
- ("\e$,1DW\e(B" (0 ?\e$,1DW\e(B))
- ("\e$,1DX\e(B" (0 ?\e$,1DX\e(B))
- ("\e$,1DY\e(B" (0 ?\e$,1DY\e(B))
- ("\e$,1D`DP\e(B" (?\e$,1D`\e(B 0 ?\e$,1DP\e(B) (?\e$,1D`\e(B 0 ?\e$,1DQ\e(B))
- ("\e$,1D`\e(B" (?\e$,1D`\e(B 0))
- ("\e$,1DaDP\e(B" (?\e$,1Da\e(B 0 ?\e$,1DP\e(B) (?\e$,1Da\e(B 0 ?\e$,1DQ\e(B))
- ("\e$,1Da\e(B" (?\e$,1Da\e(B 0))
- ("\e$,1DbDP\e(B" (?\e$,1Db\e(B 0 ?\e$,1DP\e(B) (0 ?\e$,1D[\e(B) (?\e$,1D-\e(B ?\e$,1Db\e(B 0 ?\e$,1DQ\e(B) (?\e$,1DG\e(B ?\e$,1Db\e(B 0 ?\e$,1DQ\e(B))
- ("\e$,1Db\e(B" (?\e$,1Db\e(B 0))
- ("\e$,1D`DRDP\e(B" (?\e$,1D`\e(B 0 ?\e$,1DR\e(B ?\e$,1DP\e(B) (0 ?\e$,1DQ\e(B ?\e$,1DM\e(B))
- ("\e$,1Dm\e(B" (0 ?\e$,1Dm\e(B) (0 ?\e$,1DM\e(B))
- ("\e$,1D`DT\e(B" (?\e$,1D`\e(B 0 ?\e$,1DT\e(B))
- ("\e$,1D`DU\e(B" (?\e$,1D`\e(B 0 ?\e$,1DU\e(B))
- ("\e$,1D[DGDP\e(B" (0 ?\e$,1D[\e(B ?\e$,1DG\e(B ?\e$,1DP\e(B) (0 ?\e$,1DQ\e(B ?\e$,1DG\e(B))
- ("\e$,1D[DG\e(B" (0 ?\e$,1D[\e(B ?\e$,1DG\e(B) (0 ?\e$,1DG\e(B))
- ("\e$,1D`DQD]DP\e(B" (?\e$,1D`\e(B 0 ?\e$,1DQ\e(B ?\e$,1D]\e(B ?\e$,1DP\e(B) (0 ?\e$,1DQ\e(B ?\e$,1D]\e(B))
- ("\e$,1D`DQD]\e(B" (?\e$,1D`\e(B 0 ?\e$,1DQ\e(B ?\e$,1D]\e(B) (0 ?\e$,1D]\e(B))
- ("\e$,1D`DVDM\e(B" (?\e$,1D`\e(B 0 ?\e$,1DV\e(B ?\e$,1DM\e(B))
- ("\e$,1D`DWDM\e(B" (?\e$,1D`\e(B 0 ?\e$,1DW\e(B ?\e$,1DM\e(B))
- ("\e$,1Dd\e(B" (?\e$,1Dd\e(B 0))
- ("\e$,1Dc\e(B" (?\e$,1Dc\e(B 0))
- ("\e$,1D`D[DR\e(B" (?\e$,1D`\e(B 0 ?\e$,1D[\e(B ?\e$,1DR\e(B))
- ("\e$,1DS\e(B" (0 ?\e$,1DS\e(B)))
+ ("\e(1S\e(B" (0 ?\e(1S\e(B)))
"Alist of Lao vowel string vs the corresponding re-ordering rule.
Each element has this form:
(VOWEL NO-MAA-SAKOD-RULE WITH-MAA-SAKOD-RULE (MAA-SAKOD-0 RULE-0) ...)
lao-str)))
;;;###autoload
-(defun lao-post-read-conversion (len)
- (lao-compose-region (point) (+ (point) len))
- len)
-
-;;;###autoload
-(defun lao-composition-function (from to pattern &optional string)
- "Compose Lao text in the region FROM and TO.
-The text matches the regular expression PATTERN.
-Optional 4th argument STRING, if non-nil, is a string containing text
-to compose.
-
-The return value is number of composed characters."
- (if (< (1+ from) to)
- (progn
- (if string
- (compose-string string from to)
- (compose-region from to))
- (- to from))))
+(defun lao-composition-function (pos &optional string)
+ (setq pos (1- pos))
+ (with-category-table lao-category-table
+ (if string
+ (if (and (>= pos 0)
+ (eq (string-match lao-composition-pattern string pos) pos))
+ (prog1 (match-end 0)
+ (compose-string string pos (match-end 0))))
+ (if (>= pos (point-min))
+ (save-excursion
+ (goto-char pos)
+ (if (looking-at lao-composition-pattern)
+ (prog1 (match-end 0)
+ (compose-region pos (match-end 0)))))))))
;;;###autoload
(defun lao-compose-region (from to)
;;; lao.el --- support for Lao -*- coding: iso-2022-7bit; no-byte-compile: t -*-
- ;; Copyright (C) 2001 Free Software Foundation, Inc.
- ;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ ;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
+ ;; Free Software Foundation, Inc.
+ ;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
+ ;; 2007, 2008
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
+;; Copyright (C) 2003
+;; National Institute of Advanced Industrial Science and Technology (AIST)
+;; Registration Number H13PRO009
;; Keywords: multilingual, Lao
;;; Code:
-(make-coding-system
- 'lao 2 ?L
- "8-bit encoding for ASCII (MSB=0) and LAO (MSB=1)."
- '(ascii lao nil nil
- nil nil nil nil nil nil nil nil nil nil nil t)
- '((safe-charsets ascii lao)
- (post-read-conversion . lao-post-read-conversion)))
+(define-coding-system 'lao
+ "8-bit encoding for ASCII (MSB=0) and LAO (MSB=1)."
+ :coding-type 'charset
+ :mnemonic ?L
+ :charset-list '(lao))
(set-language-info-alist
"Lao" '((charset lao)
(coding-system lao)
(coding-priority lao)
(input-method . "lao")
- (nonascii-translation . lao)
(unibyte-display . lao)
(features lao-util)
(documentation . t)))
-(aset use-default-ascent ?\e(1;\e(B t)
-(aset use-default-ascent ?\e$,1D;\e(B t)
-(aset use-default-ascent ?\e(1=\e(B t)
-(aset use-default-ascent ?\e$,1D=\e(B t)
-(aset use-default-ascent ?\e(1?\e(B t)
-(aset use-default-ascent ?\e$,1D?\e(B t)
-(aset use-default-ascent ?\e(1B\e(B t)
-(aset use-default-ascent ?\e$,1DB\e(B t)
-(aset ignore-relative-composition ?\e(1\\e(B t)
-(aset ignore-relative-composition ?\e$,1D\\e(B t)
-
-;; Register a function to compose Lao characters.
-(let ((patterns '(("\\c0\\c9?\\(\\(\\c2\\|\\c3\\)\\c4?\\|\\c4\\)?"
- . lao-composition-function))))
- (aset composition-function-table (make-char 'lao) patterns)
- (dotimes (i (1+ (- #xeff #xe80)))
- (aset composition-function-table (decode-char 'ucs (+ i #xe80)) patterns)))
+;; For automatic composition.
+;; (let ((chars "\e(1QTUVWXY[\hijklm\e(B"))
+;; (dotimes (i (length chars))
+;; (aset composition-function-table (aref chars i)
+;; 'lao-composition-function)))
+(set-char-table-range composition-function-table '(#xE80 . #xEDF)
+ '(("[\xE80-\xEDF]+" . font-shape-text)))
(provide 'lao)
;;; malayalam.el --- Support for Malayalam -*- coding: iso-2022-7bit; no-byte-compile: t -*-
- ;; Copyright (C) 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ ;; Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008
+ ; Free Software Foundation, Inc.
;; Maintainer: KAWABATA, Taichi <kawabata@m17n.org>
;; Keywords: multilingual, Indian, Malayalam
South Indian language Malayalam is supported in this language environment."))
'("Indian"))
+;; For automatic composition.
+(set-char-table-range composition-function-table '(#x0d00 . #x0d7f)
+ '(("[\x0D00-\x0D7F]+" . font-shape-text)))
+
(provide 'malayalam)
;;; arch-tag: 5f500e53-1e4f-4bb2-aa93-ad8736f0349f
;;; misc-lang.el --- support for miscellaneous languages (characters) -*- no-byte-compile: t -*-
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- ;; 2005, 2006, 2007
+ ;; 2005, 2006, 2007, 2008
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
IPA is International Phonetic Alphabet for English, French, German
and Italian.")))
+;; This is for Arabic. But, as we still don't have Arabic language
+;; support, we at least define a coding system here.
+
+(define-coding-system 'iso-8859-6
+ "ISO-8859-6 based encoding (MIME:ISO-8859-6)."
+ :coding-type 'charset
+ :mnemonic ?6
+ :charset-list '(iso-8859-6)
+ :mime-charset 'iso-8859-6)
+
(provide 'misc-lang)
;;; arch-tag: 6953585c-1a1a-4c09-be82-a2518afb6074
;;; mlm-util.el --- support for composing malayalam characters -*-coding: iso-2022-7bit;-*-
- ;; Copyright (C) 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ ;; Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008
+ ;; Free Software Foundation, Inc.
;; Maintainer: KAWABATA, Taichi <kawabata@m17n.org>
;; Keywords: multilingual, Malayalam
;;;###autoload
-(defun malayalam-composition-function (from to pattern &optional string)
- "Compose Malayalam characters in REGION, or STRING if specified.
-Assume that the REGION or STRING must fully match the composable
-PATTERN regexp."
- (if string (malayalam-compose-syllable-string string)
- (malayalam-compose-syllable-region from to))
- (- to from))
-
-;; Register a function to compose Malayalam characters.
-(mapc
- (function (lambda (ucs)
- (aset composition-function-table (decode-char 'ucs ucs)
- (list (cons malayalam-composable-pattern
- 'malayalam-composition-function)))))
- (nconc '(#x0d02 #x0d03) (malayalam-range #x0d05 #x0d39)))
+(defun malayalam-composition-function (pos &optional string)
+ "Compose Malayalam characters after the position POS.
+If STRING is not nil, it is a string, and POS is an index to the string.
+In this case, compose characters after POS of the string."
+ (if string
+ (if auto-compose-current-font
+ (if (eq (string-match "[\e$,1@ \e(B-\e$,1A?\e(B]+" pos) pos)
+ (or (font-shape-text 0 (match-end 0) auto-compose-current-font
+ string)
+ pos)))
+ (goto-char pos)
+ (if auto-compose-current-font
+ (if (looking-at "[\e$,1@ \e(B-\e$,1A?\e(B]+")
+ (or (font-shape-text pos (match-end 0) auto-compose-current-font)
+ pos)
+ (if (looking-at malayalam-composable-pattern)
+ (prog1 (match-end 0)
+ (malayalam-compose-syllable-region pos (match-end 0))))))))
;; Notes on conversion steps.
(narrow-to-region from to)
(goto-char (point-min))
;; char-glyph-conversion
- (while (re-search-forward mlm-char-glyph-regexp nil t)
- (setq match-str (match-string 0))
- (setq glyph-str
- (concat glyph-str (gethash match-str mlm-char-glyph-hash))))
+ (while (not (eobp))
+ (if (looking-at mlm-char-glyph-regexp)
+ (progn
+ (setq match-str (match-string 0)
+ glyph-str
+ (concat glyph-str
+ (gethash match-str mlm-char-glyph-hash)))
+ (goto-char (match-end 0)))
+ (setq glyph-str (concat glyph-str (string (following-char))))
+ (forward-char 1)))
(when (string-match mlm-glyph-reorder-key-glyphs glyph-str)
;; glyph reordering
(setq glyph-reorder-regexps mlm-glyph-reordering-regexp-list)
;;; romanian.el --- support for Romanian -*- coding: iso-latin-2; no-byte-compile: t -*-
- ;; Copyright (C) 1998, 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ ;; Copyright (C) 1998, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
;; Free Software Foundation.
;; Author: Dan Nicolaescu <done@ece.arizona.edu>
-;; Keywords: multilingual, Romanian
+;; Keywords: multilingual, Romanian, i18n
;; This file is part of GNU Emacs.
;;; Commentary:
-;; Romanian ISO 8859-2 environment.
+;; Romanian ISO 8859-2 environment plus 8859-16 coding system.
;;; Code:
(set-language-info-alist
- "Romanian" '((charset . (ascii latin-iso8859-2))
- (coding-system . (iso-8859-2))
- (coding-priority . (iso-8859-2))
- (nonascii-translation . latin-iso8859-2)
+ "Romanian" '((charset iso-8859-2)
+ (coding-system iso-8859-2 iso-latin-10)
+ (coding-priority iso-8859-2)
+ (nonascii-translation . iso-8859-2)
(input-method . "latin-2-postfix")
- (unibyte-syntax . "latin-2")
(unibyte-display . iso-8859-2)
(tutorial . "TUTORIAL.ro")
(sample-text . "Bunã ziua, bine aþi venit!")
- (documentation . t))
+ (documentation . "Rmoanian environment using Latin-2 encoding.
+An environment for generic Latin-10 encoding is also available."))
'("European"))
+(define-coding-system 'iso-latin-10
+ "ISO 2022 based 8-bit encoding for Latin-10."
+ :coding-type 'charset
+ :mnemonic ?*
+ :charset-list '(iso-8859-16)
+ :mime-charset 'iso-8859-16)
+
+(define-coding-system-alias 'iso-8859-16 'iso-latin-10)
+(define-coding-system-alias 'latin-10 'iso-latin-10)
+
(provide 'romanian)
;;; arch-tag: a0bf93ee-2f02-4678-a477-c08acc35366b
;;; slovak.el --- support for Slovak -*- coding: iso-2022-7bit; no-byte-compile: t -*-
- ;; Copyright (C) 1998, 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ ;; Copyright (C) 1998, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
;; Free Software Foundation.
;; Authors: Tibor \e,B)\e(Bimko <tibor.simko@fmph.uniba.sk>,
"Slovak" '((charset . (ascii latin-iso8859-2))
(coding-system . (iso-8859-2))
(coding-priority . (iso-8859-2))
- (nonascii-translation . latin-iso8859-2)
+ (nonascii-translation . iso-8859-2)
(input-method . "slovak")
- (unibyte-syntax . "latin-2")
(unibyte-display . iso-8859-2)
(tutorial . "TUTORIAL.sk")
(sample-text . "Prajeme V\e,Ba\e(Bm pr\e,Bm\e(Bjemn\e,B}\e(B de\e,Br\e(B!")
;;; tamil.el --- Support for Tamil -*- coding: iso-2022-7bit; no-byte-compile: t -*-
- ;; Copyright (C) 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ ;; Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008
+ ;; Free Software Foundation, Inc.
;; Maintainer: KAWABATA, Taichi <batta@beige.ocn.ne.jp>
;; Keywords: multilingual, Indian, Tamil
South Indian Language Tamil supported in this language environment."))
'("Indian"))
+;; For automatic composition.
+(set-char-table-range composition-function-table '(#x0b80 . #x0bff)
+ '(("[\x0B80-\x0BFF]+" . font-shape-text)))
(provide 'tamil)
;;; arch-tag: 2201ac78-7d1e-4674-9bcb-9923c7a2bd9c
;;; thai-util.el --- utilities for Thai -*- coding: iso-2022-7bit; -*-
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- ;; 2005, 2006, 2007
+ ;; 2005, 2006, 2007, 2008
;; National Institute of Advanced Industrial Science and Technology (AIST)
- ;; Registration Number H13PRO009
- ;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ ;; Registration Number H14PRO021
+ ;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
;; Free Software Foundation, Inc.
-;; Keywords: mule, multilingual, thai
+;; Keywords: mule, multilingual, Thai, i18n
;; This file is part of GNU Emacs.
"\\cc\\(\\cu\\|\\cI\\cU\\|\\cv\\ct?\\)\\|\\cv\\ct\\|\\cI\\cU"
"Regular expression matching a Thai composite sequence.")
-(defun thai-self-insert-command (&optional n)
- "Insert the Thai character you type.
-The character will be composed with the surrounding Thai character
-if necessary."
- (interactive "*p")
- (let ((pos (point))
- category-set ch)
- (self-insert-command n)
- (or thai-auto-composition-mode
- (thai-auto-composition (1- (point)) (point) 0))))
-
(let ((l '((?\e,T!\e(B consonant "LETTER KO KAI") ; 0xA1
(?\e,T"\e(B consonant "LETTER KHO KHAI") ; 0xA2
(?\e,T#\e(B consonant "LETTER KHO KHUAT") ; 0xA3
(?\e,T|\e(B invalid nil) ; 0xFC
(?\e,T}\e(B invalid nil) ; 0xFD
(?\e,T~\e(B invalid nil) ; 0xFE
-
- ;; Unicode equivalents
- (?\e$,1Ba\e(B consonant "LETTER KO KAI")
- (?\e$,1Bb\e(B consonant "LETTER KHO KHAI")
- (?\e$,1Bc\e(B consonant "LETTER KHO KHUAT")
- (?\e$,1Bd\e(B consonant "LETTER KHO KHWAI")
- (?\e$,1Be\e(B consonant "LETTER KHO KHON")
- (?\e$,1Bf\e(B consonant "LETTER KHO RAKHANG")
- (?\e$,1Bg\e(B consonant "LETTER NGO NGU")
- (?\e$,1Bh\e(B consonant "LETTER CHO CHAN")
- (?\e$,1Bi\e(B consonant "LETTER CHO CHING")
- (?\e$,1Bj\e(B consonant "LETTER CHO CHANG")
- (?\e$,1Bk\e(B consonant "LETTER SO SO")
- (?\e$,1Bl\e(B consonant "LETTER CHO CHOE")
- (?\e$,1Bm\e(B consonant "LETTER YO YING")
- (?\e$,1Bn\e(B consonant "LETTER DO CHADA")
- (?\e$,1Bo\e(B consonant "LETTER TO PATAK")
- (?\e$,1Bp\e(B consonant "LETTER THO THAN")
- (?\e$,1Bq\e(B consonant "LETTER THO NANGMONTHO")
- (?\e$,1Br\e(B consonant "LETTER THO PHUTHAO")
- (?\e$,1Bs\e(B consonant "LETTER NO NEN")
- (?\e$,1Bt\e(B consonant "LETTER DO DEK")
- (?\e$,1Bu\e(B consonant "LETTER TO TAO")
- (?\e$,1Bv\e(B consonant "LETTER THO THUNG")
- (?\e$,1Bw\e(B consonant "LETTER THO THAHAN")
- (?\e$,1Bx\e(B consonant "LETTER THO THONG")
- (?\e$,1By\e(B consonant "LETTER NO NU")
- (?\e$,1Bz\e(B consonant "LETTER BO BAIMAI")
- (?\e$,1B{\e(B consonant "LETTER PO PLA")
- (?\e$,1B|\e(B consonant "LETTER PHO PHUNG")
- (?\e$,1B}\e(B consonant "LETTER FO FA")
- (?\e$,1B~\e(B consonant "LETTER PHO PHAN")
- (?\e$,1B\7f\e(B consonant "LETTER FO FAN")
- (?\e$,1C \e(B consonant "LETTER PHO SAMPHAO")
- (?\e$,1C!\e(B consonant "LETTER MO MA")
- (?\e$,1C"\e(B consonant "LETTER YO YAK")
- (?\e$,1C#\e(B consonant "LETTER RO RUA")
- (?\e$,1C$\e(B vowel-base "LETTER RU (Pali vowel letter)")
- (?\e$,1C%\e(B consonant "LETTER LO LING")
- (?\e$,1C&\e(B vowel-base "LETTER LU (Pali vowel letter)")
- (?\e$,1C'\e(B consonant "LETTER WO WAEN")
- (?\e$,1C(\e(B consonant "LETTER SO SALA")
- (?\e$,1C)\e(B consonant "LETTER SO RUSI")
- (?\e$,1C*\e(B consonant "LETTER SO SUA")
- (?\e$,1C+\e(B consonant "LETTER HO HIP")
- (?\e$,1C,\e(B consonant "LETTER LO CHULA")
- (?\e$,1C-\e(B consonant "LETTER O ANG")
- (?\e$,1C.\e(B consonant "LETTER HO NOK HUK")
- (?\e$,1C/\e(B special "PAI YAN NOI (abbreviation)")
- (?\e$,1C0\e(B vowel-base "VOWEL SIGN SARA A")
- (?\e$,1C1\e(B vowel-upper "VOWEL SIGN MAI HAN-AKAT N/S-T")
- (?\e$,1C2\e(B vowel-base "VOWEL SIGN SARA AA")
- (?\e$,1C3\e(B vowel-base "VOWEL SIGN SARA AM")
- (?\e$,1C4\e(B vowel-upper "VOWEL SIGN SARA I N/S-T")
- (?\e$,1C5\e(B vowel-upper "VOWEL SIGN SARA II N/S-T")
- (?\e$,1C6\e(B vowel-upper "VOWEL SIGN SARA UE N/S-T")
- (?\e$,1C7\e(B vowel-upper "VOWEL SIGN SARA UEE N/S-T")
- (?\e$,1C8\e(B vowel-lower "VOWEL SIGN SARA U N/S-B")
- (?\e$,1C9\e(B vowel-lower "VOWEL SIGN SARA UU N/S-B")
- (?\e$,1C:\e(B vowel-lower "VOWEL SIGN PHINTHU N/S-B (Pali virama)")
- (?\e$,1C?\e(B special "BAHT SIGN (currency symbol)")
- (?\e$,1C@\e(B vowel-base "VOWEL SIGN SARA E")
- (?\e$,1CA\e(B vowel-base "VOWEL SIGN SARA AE")
- (?\e$,1CB\e(B vowel-base "VOWEL SIGN SARA O")
- (?\e$,1CC\e(B vowel-base "VOWEL SIGN SARA MAI MUAN")
- (?\e$,1CD\e(B vowel-base "VOWEL SIGN SARA MAI MALAI")
- (?\e$,1CE\e(B vowel-base "LAK KHANG YAO")
- (?\e$,1CF\e(B special "MAI YAMOK (repetion)")
- (?\e$,1CG\e(B sign-upper "VOWEL SIGN MAI TAI KHU N/S-T")
- (?\e$,1CH\e(B tone "TONE MAI EK N/S-T")
- (?\e$,1CI\e(B tone "TONE MAI THO N/S-T")
- (?\e$,1CJ\e(B tone "TONE MAI TRI N/S-T")
- (?\e$,1CK\e(B tone "TONE MAI CHATTAWA N/S-T")
- (?\e$,1CL\e(B sign-upper "THANTHAKHAT N/S-T (cancellation mark)")
- (?\e$,1CM\e(B sign-upper "NIKKHAHIT N/S-T (final nasal)")
- (?\e$,1CN\e(B sign-upper "YAMAKKAN N/S-T")
- (?\e$,1CO\e(B special "FONRMAN")
- (?\e$,1CP\e(B special "DIGIT ZERO")
- (?\e$,1CQ\e(B special "DIGIT ONE")
- (?\e$,1CR\e(B special "DIGIT TWO")
- (?\e$,1CS\e(B special "DIGIT THREE")
- (?\e$,1CT\e(B special "DIGIT FOUR")
- (?\e$,1CU\e(B special "DIGIT FIVE")
- (?\e$,1CV\e(B special "DIGIT SIX")
- (?\e$,1CW\e(B special "DIGIT SEVEN")
- (?\e$,1CX\e(B special "DIGIT EIGHT")
- (?\e$,1CY\e(B special "DIGIT NINE")
- (?\e$,1CZ\e(B special "ANGKHANKHU (ellipsis)")
- (?\e$,1C[\e(B special "KHOMUT (beginning of religious texts)")
))
elm)
(while l
(ptype (nth 1 elm)))
(put-char-code-property char 'phonetic-type ptype)
(cond ((eq ptype 'consonant)
- (modify-category-entry char ?c thai-category-table)
- (global-set-key (vector char) 'thai-self-insert-command))
+ (modify-category-entry char ?c thai-category-table))
((memq ptype '(vowel-upper vowel-lower))
(modify-category-entry char ?v thai-category-table)
- (if (or (= char ?\e,TT\e(B) (= char ?\e$,1C4\e(B))
+ (if (= char ?\e,TT\e(B)
;; Give category `I' to "SARA I".
- (modify-category-entry char ?I thai-category-table))
- (global-set-key (vector char) 'thai-self-insert-command))
+ (modify-category-entry char ?I thai-category-table)))
((eq ptype 'tone)
(modify-category-entry char ?t thai-category-table)
- (modify-category-entry char ?u thai-category-table)
- (global-set-key (vector char) 'thai-self-insert-command))
+ (modify-category-entry char ?u thai-category-table))
((eq ptype 'sign-upper)
(modify-category-entry char ?u thai-category-table)
- (if (or (= char ?\e,Tl\e(B) (= char ?\e$,1CL\e(B))
+ (if (= char ?\e,Tl\e(B)
;; Give category `U' to "THANTHAKHAT".
- (modify-category-entry char ?U thai-category-table))
- (global-set-key (vector char) 'thai-self-insert-command)))
+ (modify-category-entry char ?U thai-category-table))))
(put-char-code-property char 'name (nth 2 elm)))))
(defun thai-compose-syllable (beg end &optional category-set string)
(thai-compose-region (point-min) (point-max)))
;;;###autoload
-(defun thai-post-read-conversion (len)
- (thai-compose-region (point) (+ (point) len))
- len)
-
-;;;###autoload
-(defun thai-composition-function (from to pattern &optional string)
- "Compose Thai text in the region FROM and TO.
-The text matches the regular expression PATTERN.
-Optional 4th argument STRING, if non-nil, is a string containing text
-to compose.
-
-The return value is number of composed characters."
- (when (and (not thai-auto-composition-mode)
- (< (1+ from) to))
- (with-category-table thai-category-table
- (if string
- (if (eq (string-match thai-composition-pattern string from) from)
- (thai-compose-syllable from (match-end 0) nil string))
- (if (save-excursion
- (goto-char from)
- (and (looking-at thai-composition-pattern)
- (setq to (match-end 0))))
- (thai-compose-syllable from to))))))
-
-(defun thai-auto-composition (beg end len)
+(defun thai-composition-function (pos to font-object string)
+ (setq pos (1- pos))
(with-category-table thai-category-table
- (let (category-set)
- (while (and (> beg (point-min))
- (setq category-set (char-category-set (char-after (1- beg))))
- (or (aref category-set ?v) (aref category-set ?u)))
- (setq beg (1- beg)))
- (if (and (> beg (point-min))
- (aref (char-category-set (char-after (1- beg))) ?c))
- (setq beg (1- beg)))
- (while (and (< end (point-max))
- (setq category-set (char-category-set (char-after end)))
- (or (aref category-set ?v) (aref category-set ?u)))
- (setq end (1+ end)))
- (if (< beg end)
- (thai-compose-region beg end)))))
-
-(put 'thai-auto-composition-mode 'permanent-local t)
-
-;;;###autoload
-(define-minor-mode thai-auto-composition-mode
- "Minor mode for automatically correct Thai character composition."
- :group 'mule
- (cond ((null thai-auto-composition-mode)
- (remove-hook 'after-change-functions 'thai-auto-composition))
- (t
- (add-hook 'after-change-functions 'thai-auto-composition))))
+ (if string
+ (if (and (>= pos 0)
+ (eq (string-match thai-composition-pattern string pos) pos))
+ (prog1 (match-end 0)
+ (thai-compose-syllable pos (match-end 0) nil string)))
+ (if (>= pos (point-min))
+ (progn
+ (goto-char pos)
+ (if (looking-at thai-composition-pattern)
+ (prog1 (match-end 0)
+ (thai-compose-syllable pos (match-end 0)))))))))
;; Thai-word-mode requires functions in the feature `thai-word'.
(require 'thai-word)
;;; thai.el --- support for Thai -*- coding: iso-2022-7bit; no-byte-compile: t -*-
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- ;; 2005, 2006, 2007
+ ;; 2005, 2006, 2007, 2008
;; National Institute of Advanced Industrial Science and Technology (AIST)
+;; Registration Number H13PRO009
+;; Copyright (C) 2005
+;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
;; Copyright (C) 1997, 1998, 2000, 2001, 2002, 2003, 2004, 2005,
- ;; 2006, 2007 Free Software Foundation, Inc.
+ ;; 2006, 2007, 2008 Free Software Foundation, Inc.
-;; Keywords: multilingual, Thai
+;; Keywords: multilingual, Thai, i18n
;; This file is part of GNU Emacs.
;;; Code:
-(make-coding-system
- 'thai-tis620 2 ?T
- "8-bit encoding for ASCII (MSB=0) and Thai TIS620 (MSB=1)."
- '(ascii thai-tis620 nil nil
- nil nil nil nil nil nil nil nil nil nil nil t)
- '((safe-charsets ascii thai-tis620)
- (mime-charset . tis-620)
- (post-read-conversion . thai-post-read-conversion)))
+(define-coding-system 'thai-tis620
+ "8-bit encoding for ASCII (MSB=0) and Thai TIS620 (MSB=1)."
+ :coding-type 'charset
+ :mnemonic ?T
+ :charset-list '(tis620-2533))
(define-coding-system-alias 'th-tis620 'thai-tis620)
(define-coding-system-alias 'tis620 'thai-tis620)
(set-language-info-alist
"Thai" '((tutorial . "TUTORIAL.th")
(charset thai-tis620)
- (coding-system thai-tis620)
+ (coding-system thai-tis620 iso-8859-11 cp874)
(coding-priority thai-tis620)
- (nonascii-translation . thai-tis620)
+ (nonascii-translation . tis620-2533)
(input-method . "thai-kesmanee")
(unibyte-display . thai-tis620)
(features thai-util)
(exit-function . exit-thai-language-environment-internal)
(sample-text
. (thai-compose-string
- (copy-sequence "Thai (\e,T@RIRd7B\e(B) \e,TJ\e0GQ\e1J\e04U\e1$\e0CQ\e1:\e(B, \e,TJ\e0GQ\e1J\e04U\e1\e0$h\e1P\e(B")))
+ (copy-sequence "Thai (\e,T@RIRd7B\e(B) \e,TJGQJ4U$CQ:\e(B, \e,TJGQJ4U$hP\e(B")))
(documentation . t)))
-
-;; Register a function to compose Thai characters.
-(let ((patterns '(("\\c0?\\(\\c2\\|\\c3\\|\\c4\\)+"
- . thai-composition-function))))
- (aset composition-function-table (make-char 'thai-tis620) patterns)
- (dotimes (i (1+ (- #xe7f #xe00)))
- (aset composition-function-table (decode-char 'ucs (+ i #xe00)) patterns)))
+(define-coding-system 'cp874
+ "DOS codepage 874 (Thai)"
+ :coding-type 'charset
+ :mnemonic ?D
+ :charset-list '(cp874)
+ :mime-charset 'cp874)
+(define-coding-system-alias 'ibm874 'cp874)
+
+(define-coding-system 'iso-8859-11
+ "ISO/IEC 8859/11 (Latin/Thai)
+This is the same as `thai-tis620' with the addition of no-break-space."
+ :coding-type 'charset
+ :mnemonic ?*
+ :mime-charset 'iso-8859-11 ; not actually registered as of 2002-05-24
+ :charset-list '(iso-8859-11))
+
+;; For automatic composition.
+(let ((chars "\e,TQTUVWXYZghijklmn\e(B"))
+ (dotimes (i (length chars))
+ (aset composition-function-table (aref chars i)
+ 'thai-composition-function)))
(provide 'thai)
;;; tibet-util.el --- utilities for Tibetan -*- coding: iso-2022-7bit; -*-
- ;; Copyright (C) 1997, 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ ;; Copyright (C) 1997, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
;; Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- ;; 2005, 2006, 2007
+ ;; 2005, 2006, 2007, 2008
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
;;; Code:
(defconst tibetan-obsolete-glyphs
- `(("\e$(7!=\e(B" . "\e$(8!=\e(B") ; 2 col <-> 1 col
- ("\e$(7!?\e(B" . "\e$(8!?\e(B")
- ("\e$(7!@\e(B" . "\e$(8!@\e(B")
- ("\e$(7!A\e(B" . "\e$(8!A\e(B")
- ("\e$(7"`\e(B" . "\e$(8"`\e(B")
- ("\e$(7!;\e(B" . "\e$(8!;\e(B")
- ("\e$(7!D\e(B" . "\e$(8!D\e(B")
+ `(("\e$(7!=\e(B" . "\e$(7!=\e(B") ; 2 col <-> 1 col
+ ("\e$(7!?\e(B" . "\e$(7!?\e(B")
+ ("\e$(7!@\e(B" . "\e$(7!@\e(B")
+ ("\e$(7!A\e(B" . "\e$(7!A\e(B")
+ ("\e$(7"`\e(B" . "\e$(7"`\e(B")
+ ("\e$(7!;\e(B" . "\e$(7!;\e(B")
+ ("\e$(7!D\e(B" . "\e$(7!D\e(B")
;; Yes these are dirty. But ...
("\e$(7!>\e(B \e$(7!>\e(B" . ,(compose-string "\e$(7!>\e(B \e$(7!>\e(B" 0 3 [?\e$(7!>\e(B (Br . Bl) ? (Br . Bl) ?\e$(7!>\e(B]))
("\e$(7!4!5!5\e(B" . ,(compose-string
;;;
;;; Here are examples of the words "bsgrubs" and "hfauM"
;;;
-;;; \e4\e$(7"7\e0"7\e1\e4%qx!"U\e0"G###C"U\e1\e4"7\e0"7\e1\e4"G\e0"G\e1\e(B \e4\e$(7"Hx!"Rx!"Ur'"_\e0"H"R"U"_\e1\e(B
+;;; \e$(7"7"G###C"U"7"G\e(B \e$(7"H"R"U"_\e(B
;;;
;;; M
;;; b s b s h
;; If 'a follows a consonant, turn it into the subjoined form.
;; * Disabled by Tomabechi 2000/06/09 *
;; Because in Unicode, \e$(7"A\e(B may follow directly a consonant without
- ;; any intervening vowel, as in \e4\e$(7"9\e0"9\e1\e4""\e0"""Q\e1\e4"A\e0"A\e1!;\e(B=\e4\e$(7"9\e0"9\e1\e(B \e4\e$(7""\e0""\e1\e(B \e4\e$(7"A\e0"A\e1\e(B not \e4\e$(7"9\e0"9\e1\e(B \e4\e$(7""\e0""\e1\e(B \e$(7"Q\e(B \e4\e$(7"A\e0"A\e1\e(B
+ ;; any intervening vowel, as in \e$(7"9"""Q"A!;\e(B=\e$(7"9\e(B \e$(7""\e(B \e$(7"A\e(B not \e$(7"9\e(B \e$(7""\e(B \e$(7"Q\e(B \e$(7"A\e(B
;;(if (and (= char ?\e$(7"A\e(B)
;; (aref (char-category-set (car last)) ?0))
;; (setq char ?\e$(7"R\e(B)) ;; modified for new font by Tomabechi 1999/12/10
;; Compose lower vowel sign vertically under.
((aref (char-category-set char) ?3)
- (if (eq char ?\e$(7"Q\e(B) ;; `\e$(7"Q\e(B' should not visible when composed.
+ (if (or (eq char ?\e$(7"Q\e(B) ;; `\e$(7"Q\e(B' and `\e$,1FP\e(B' should not visible when composed.
+ (eq char #xF70))
(setq rule nil)
(setq rule stack-under)))
;; Transform ra-mgo (superscribed r) if followed by a subjoined
new))
;;;###autoload
-(defun tibetan-composition-function (from to pattern &optional string)
+(defun tibetan-composition-function (pos &optional string)
(if string
- (tibetan-compose-string string)
- (tibetan-compose-region from to))
- (- to from))
+ (if auto-compose-current-font
+ (if (eq (string-match "[\e$(7!0\e(B-\e$,1GQ\e(B]+" pos) pos)
+ (or (font-shape-text 0 (match-end 0) auto-compose-current-font
+ string)
+ pos)))
+ (goto-char pos)
+ (if auto-compose-current-font
+ (if (looking-at "[\e$(7!0\e(B-\e$,1GQ\e(B]+")
+ (or (font-shape-text pos (match-end 0) auto-compose-current-font)
+ pos)
+ (if (looking-at tibetan-composable-pattern)
+ (prog1 (match-end 0)
+ (tibetan-compose-region pos (match-end 0))))))))
;;;
;;; This variable is used to avoid repeated decomposition.
;;; tibetan.el --- support for Tibetan language -*- coding: iso-2022-7bit; -*-
- ;; Copyright (C) 1997, 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ ;; Copyright (C) 1997, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
;; Free Software Foundation, Inc.
- ;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ ;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
+ ;; 2006, 2007, 2008
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
+;; Copyright (C) 2003
+;; National Institute of Advanced Industrial Science and Technology (AIST)
+;; Registration Number H13PRO009
-;; Keywords: multilingual, Tibetan
+;; Keywords: multilingual, Tibetan, i18n
;; This file is part of GNU Emacs.
;;;
-(make-coding-system
- 'tibetan-iso-8bit 2 ?Q
- "8-bit encoding for ASCII (MSB=0) and TIBETAN (MSB=1)."
- '(ascii tibetan nil nil
- nil nil)
- '((safe-charsets ascii tibetan)
- (post-read-conversion . tibetan-post-read-conversion)
- (pre-write-conversion . tibetan-pre-write-conversion)))
+(define-coding-system 'tibetan-iso-8bit
+ "8-bit encoding for ASCII (MSB=0) and TIBETAN (MSB=1)."
+ :coding-type 'iso-2022
+ :mnemonic ?Q
+ :designation [ascii tibetan nil nil]
+ :charset-list '(ascii tibetan))
(define-coding-system-alias 'tibetan 'tibetan-iso-8bit)
(input-method . "tibetan-wylie")
(features tibet-util)
(documentation . t)
- (sample-text
- . (tibetan-compose-string
- (copy-sequence
-"Tibetan (\e4\e$(7"7r'"]\e0"7"]\e1\e4"2\e0"2\e1!;\e4%P\e0"G#!"Q\e1\e4"2\e0"2\e1!;\e(B) \e$(7!4!5!5!>\e4"7\e0"7\e1\e4$P\e0"!#C"Q\e1!;\e4"Er'"S\e0"E"S\e1\e4"G\e0"G\e1!;\e4"7\e0"7\e1\e4"2r'"[\e0"2"[\e1!;\e4"Dr'"[\e0"D"[\e1\e4"#\e0"#\e1\e4"G\e0"G\e1!>\e4"Ir'"]r'"_\e0"I"]"_\e1!;\e4"9\e0"9"Q\e1!;\e4"/r'"S\e0"/"S\e1!;\e4"5\e0"5"Q\e1\e4#2x!#9r'"[\e0"2#9"[\e1!;\e4"Hx!"Rx!"Ur'"c\e0"H"A"U"c\e1!>\e(B")))))
-
+ (sample-text "Tibetan (\e$(7"7"]"2!;"G#!"Q"2!;\e(B) \e$(7!4!5!5!>"7"!#C"Q!;"E"S"G!;"7"2"[!;"D"["#"G!>"I"]"_!;"9"Q!;"/"S!;"5"Q"2#9"[!;"H"A"U"c!>\e(B")))
;; `\e$(7"A\e(B' is included in the pattern for subjoined consonants because we
;; treat it specially in tibetan-add-components.
;; \e$(7"A\e(B is removed from the class of subjoined. Tomabechi 2000/06/08
;; (for Unicode support)
(defconst tibetan-composable-pattern
- "[\e$(7"!\e(B-\e$(7"J"K\e(B][\e$(7#!\e(B-\e$(7#J#K#L#M\e(B]*[\e$(7"Q"R"S\e(B-\e$(7"^"a"b"e\e(B]*[\e$(7"_"c"d"g\e(B-\e$(7"l!I!e!g\e(B]*"
+ "[\e$(7"!\e(B-\e$(7"J"K\e(B][\e$(7#!\e(B-\e$(7#J#K#L#M\e(B]*[\e$,1FP\e$(7"Q"R"S\e(B-\e$(7"^"a"b"e\e(B]*[\e$(7"_"c"d"g\e(B-\e$(7"l!I!e!g\e(B]*"
"Regexp matching a composable sequence of Tibetan characters.")
-;; Register a function to compose Tibetan characters.
-(aset composition-function-table (make-char 'tibetan)
- (list (cons tibetan-composable-pattern 'tibetan-composition-function)))
-
;;;
;;; Definitions of conversion data.
;;;
(defvar tibetan-decomposed nil)
(defvar tibetan-decomposed-temp nil)
+;; For automatic composition.
+(set-char-table-range composition-function-table '(#xF00 . #xFD1)
+ '(("[\xF00-\xFD1]+" . font-shape-text)))
+
(provide 'tibetan)
;;; arch-tag: 8d37c8d7-f95d-450f-9ec2-819e61fc79a7
;;; tml-util.el --- support for composing tamil characters -*-coding: iso-2022-7bit;-*-
- ;; Copyright (C) 2001, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ ;; Copyright (C) 2001, 2003, 2004, 2005, 2006, 2007, 2008
+ ;; Free Software Foundation, Inc.
;; Maintainer: KAWABATA, Taichi <kawabata@m17n.org>
;; Keywords: multilingual, Indian, Tamil
(function (lambda (x y) (> (length x) (length y))))))))
-;;;###autoload
-(defun tamil-composition-function (from to pattern &optional string)
- "Compose Tamil characters in REGION, or STRING if specified.
-Assume that the REGION or STRING must fully match the composable
-PATTERN regexp."
- (if string (tamil-compose-syllable-string string)
- (tamil-compose-syllable-region from to))
- (- to from))
-
-;; Register a function to compose Tamil characters.
-(mapc
- (function (lambda (ucs)
- (aset composition-function-table (decode-char 'ucs ucs)
- (list (cons tamil-composable-pattern
- 'tamil-composition-function)))))
- (nconc '(#x0b82 #x0b83) (tamil-range #x0b85 #x0bb9)))
-
;; Notes on conversion steps.
;; 1. chars to glyphs
(defvar tml-char-glyph
'(;; various signs
- ;;("\e$,1<"\e(B" . "")
+ ("\e$,1<"\e(B" . "\e$,4)b\e(B") ;; not good
("\e$,1<#\e(B" . "\e$,4*G\e(B")
;; Independent Vowels
("\e$,1<%\e(B" . "\e$,4*<\e(B")
(narrow-to-region from to)
(goto-char (point-min))
;; char-glyph-conversion
- (while (re-search-forward tml-char-glyph-regexp nil t)
- (setq match-str (match-string 0))
- (setq glyph-str
- (concat glyph-str (gethash match-str tml-char-glyph-hash))))
+ (while (not (eobp))
+ (if (looking-at tml-char-glyph-regexp)
+ (progn
+ (setq match-str (match-string 0)
+ glyph-str
+ (concat glyph-str
+ (gethash match-str tml-char-glyph-hash)))
+ (goto-char (match-end 0)))
+ (setq glyph-str (concat glyph-str (string (following-char))))
+ (forward-char 1)))
+ (or glyph-str
+ (aset glyph-str 0 (following-char)))
;; glyph reordering
(when (string-match tml-glyph-reorder-key-glyphs glyph-str)
(if (string-match (car tml-glyph-reordering-regexp-list)
glyph-str))))
(compose-region from to glyph-str)))))
+;;;###autoload
+(defun tamil-composition-function (pos &optional string)
+ "Compose Tamil characters after the position POS.
+If STRING is not nil, it is a string, and POS is an index to the string.
+In this case, compose characters after POS of the string."
+ (if string
+ (if auto-compose-current-font
+ (if (eq (string-match "[\e$,1< \e(B-\e$,1=?\e(B]+" pos) pos)
+ (or (font-shape-text 0 (match-end 0) auto-compose-current-font
+ string)
+ pos)))
+ (goto-char pos)
+ (if auto-compose-current-font
+ (if (looking-at "[\e$,1< \e(B-\e$,1=?\e(B]+")
+ (or (font-shape-text pos (match-end 0) auto-compose-current-font))
+ (if (looking-at tamil-composable-pattern)
+ (prog1 (match-end 0)
+ (tamil-compose-syllable-region pos (match-end 0))))))))
+
(provide 'tml-util)
;;; arch-tag: 4d1c9737-e7b1-44cf-a040-4f64c50e773e
;;; utf-8-lang.el --- generic UTF-8 language environment -*- no-byte-compile: t -*-
- ;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ ;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
;; Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;;; Code:
(set-language-info-alist
- "UTF-8" `((coding-system mule-utf-8)
- (coding-priority mule-utf-8)
- (setup-function
- . (lambda ()
- ;; Use Unicode font under Windows. Jason Rumney fecit.
- (if (and (fboundp 'w32-add-charset-info)
- (not (boundp 'w32-unicode-charset-defined)))
- (w32-add-charset-info "iso10646-1" 'w32-charset-ansi t))))
+ "UTF-8" `((coding-system utf-8)
+ (coding-priority utf-8)
+;; Presumably not relevant now.
+;; (setup-function
+;; . (lambda ()
+;; ;; Use Unicode font under Windows. Jason Rumney fecit.
+;; (if (and (fboundp 'w32-add-charset-info)
+;; (not (boundp 'w32-unicode-charset-defined)))
+;; (w32-add-charset-info "iso10646-1" 'w32-charset-ansi t))))
;; Is this appropriate?
;; (exit-function
;; . (lambda ()
;; w32-charset-info-alist)))))
(input-method . "rfc1345") ; maybe not the best choice
(documentation . "\
-This language environment is a generic one for a subset of the Unicode
-character set encoded in UTF-8."))
+This language environment is a generic one for the Unicode character set
+encoded in UTF-8."))
nil)
(provide 'utf-8-lang)
;;; viet-util.el --- utilities for Vietnamese -*- coding: iso-2022-7bit; -*-
- ;; Copyright (C) 1998, 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ ;; Copyright (C) 1998, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
;; Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- ;; 2005, 2006, 2007
+ ;; 2005, 2006, 2007, 2008
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
+;; Copyright (C) 2003
+;; National Institute of Advanced Industrial Science and Technology (AIST)
+;; Registration Number H13PRO009
;; Keywords: mule, multilingual, Vietnamese
;;;###autoload
(defun viet-encode-viscii-char (char)
"Return VISCII character code of CHAR if appropriate."
- (aref (char-table-extra-slot viet-viscii-nonascii-translation-table 0)
- char))
+ (encode-char char 'viscii))
;; VIQR is a menmonic encoding specification for Vietnamese.
;; It represents diacritical marks by ASCII characters as follows:
;;; vietnamese.el --- support for Vietnamese -*- coding: iso-2022-7bit; -*-
- ;; Copyright (C) 1998, 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ ;; Copyright (C) 1998, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
;; Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- ;; 2005, 2006, 2007
+ ;; 2005, 2006, 2007, 2008
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
+;; Copyright (C) 2003
+;; National Institute of Advanced Industrial Science and Technology (AIST)
+;; Registration Number H13PRO009
-;; Keywords: multilingual, Vietnamese
+;; Keywords: multilingual, Vietnamese, i18n
;; This file is part of GNU Emacs.
;;; Code:
-(defvar viet-viscii-decode-table
- [;; VISCII is a full 8-bit code.
- 0 1 ?\e,2F\e(B 3 4 ?\e,2G\e(B ?\e,2g\e(B 7 8 9 10 11 12 13 14 15
- 16 17 18 19 ?\e,2V\e(B 21 22 23 24 ?\e,2[\e(B 26 27 28 29 ?\e,2\\e(B 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,2U\e(B ?\e,2!\e(B ?\e,2"\e(B ?\e,2#\e(B ?\e,2$\e(B ?\e,2%\e(B ?\e,2&\e(B ?\e,2'\e(B ?\e,2(\e(B ?\e,2)\e(B ?\e,2*\e(B ?\e,2+\e(B ?\e,2,\e(B ?\e,2-\e(B ?\e,2.\e(B ?\e,2/\e(B
- ?\e,20\e(B ?\e,21\e(B ?\e,22\e(B ?\e,25\e(B ?\e,2~\e(B ?\e,2>\e(B ?\e,26\e(B ?\e,27\e(B ?\e,28\e(B ?\e,2v\e(B ?\e,2w\e(B ?\e,2o\e(B ?\e,2|\e(B ?\e,2{\e(B ?\e,2x\e(B ?\e,2O\e(B
- ?\e,2u\e(B ?\e,1!\e(B ?\e,1"\e(B ?\e,1#\e(B ?\e,1$\e(B ?\e,1%\e(B ?\e,1&\e(B ?\e,1'\e(B ?\e,1(\e(B ?\e,1)\e(B ?\e,1*\e(B ?\e,1+\e(B ?\e,1,\e(B ?\e,1-\e(B ?\e,1.\e(B ?\e,1/\e(B
- ?\e,10\e(B ?\e,11\e(B ?\e,12\e(B ?\e,2^\e(B ?\e,2=\e(B ?\e,15\e(B ?\e,16\e(B ?\e,17\e(B ?\e,18\e(B ?\e,2q\e(B ?\e,2Q\e(B ?\e,2W\e(B ?\e,2X\e(B ?\e,1=\e(B ?\e,1>\e(B ?\e,2_\e(B
- ?\e,2`\e(B ?\e,2a\e(B ?\e,2b\e(B ?\e,2c\e(B ?\e,2d\e(B ?\e,2e\e(B ?\e,1F\e(B ?\e,1G\e(B ?\e,2h\e(B ?\e,2i\e(B ?\e,2j\e(B ?\e,2k\e(B ?\e,2l\e(B ?\e,2m\e(B ?\e,2n\e(B ?\e,1O\e(B
- ?\e,2p\e(B ?\e,1Q\e(B ?\e,2r\e(B ?\e,2s\e(B ?\e,2t\e(B ?\e,1U\e(B ?\e,1V\e(B ?\e,1W\e(B ?\e,1X\e(B ?\e,2y\e(B ?\e,2z\e(B ?\e,1[\e(B ?\e,1\\e(B ?\e,2}\e(B ?\e,1^\e(B ?\e,1_\e(B
- ?\e,1`\e(B ?\e,1a\e(B ?\e,1b\e(B ?\e,1c\e(B ?\e,1d\e(B ?\e,1e\e(B ?\e,1f\e(B ?\e,1g\e(B ?\e,1h\e(B ?\e,1i\e(B ?\e,1j\e(B ?\e,1k\e(B ?\e,1l\e(B ?\e,1m\e(B ?\e,1n\e(B ?\e,1o\e(B
- ?\e,1p\e(B ?\e,1q\e(B ?\e,1r\e(B ?\e,1s\e(B ?\e,1t\e(B ?\e,1u\e(B ?\e,1v\e(B ?\e,1w\e(B ?\e,1x\e(B ?\e,1y\e(B ?\e,1z\e(B ?\e,1{\e(B ?\e,1|\e(B ?\e,1}\e(B ?\e,1~\e(B ?\e,2f\e(B ]
- "Vietnamese VISCII decoding table.")
-
-(let ((table (make-translation-table-from-vector viet-viscii-decode-table)))
- (define-translation-table 'viet-viscii-nonascii-translation-table table)
- (define-translation-table 'viet-viscii-encode-table
- (char-table-extra-slot table 0)))
-
-;;;
-;;; VSCII is a pre-version of TCVN-5712 and deprecated
-;;;
-(defvar viet-vscii-decode-table
- [;; VSCII is a full 8-bit code.
- 0 ?\e,2z\e(B ?\e,2x\e(B 3 ?\e,2W\e(B ?\e,2X\e(B ?\e,2f\e(B 7 8 9 10 11 12 13 14 15
- 16 ?\e,2Q\e(B ?\e,2_\e(B ?\e,2O\e(B ?\e,2V\e(B ?\e,2[\e(B ?\e,2}\e(B ?\e,2\\e(B 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,2`\e(B ?\e,2d\e(B ?\e,2c\e(B ?\e,2a\e(B ?\e,2U\e(B ?\e,2#\e(B ?\e,2'\e(B ?\e,2h\e(B ?\e,2k\e(B ?\e,2(\e(B ?\e,2i\e(B ?\e,2)\e(B ?\e,2.\e(B ?\e,2l\e(B ?\e,2o\e(B ?\e,2n\e(B
- ?\e,2m\e(B ?\e,28\e(B ?\e,2r\e(B ?\e,2v\e(B ?\e,2u\e(B ?\e,2s\e(B ?\e,2w\e(B ?\e,25\e(B ?\e,26\e(B ?\e,27\e(B ?\e,2^\e(B ?\e,2>\e(B ?\e,2~\e(B ?\e,2y\e(B ?\e,2|\e(B ?\e,2{\e(B
- 160 ?\e,2e\e(B ?\e,2b\e(B ?\e,2j\e(B ?\e,2t\e(B ?\e,2=\e(B ?\e,2_\e(B ?\e,2p\e(B ?\e,1e\e(B ?\e,1b\e(B ?\e,1j\e(B ?\e,1t\e(B ?\e,1=\e(B ?\e,1y\e(B ?\e,1p\e(B ?\e,2"\e(B
- 192 193 194 195 196 ?\e,1`\e(B ?\e,1d\e(B ?\e,1c\e(B ?\e,1a\e(B ?\e,1U\e(B ?\e,2F\e(B ?\e,1"\e(B ?\e,1F\e(B ?\e,1G\e(B ?\e,1!\e(B ?\e,2G\e(B
- ?\e,2!\e(B ?\e,2%\e(B ?\e,2&\e(B ?\e,2g\e(B ?\e,2%\e(B ?\e,2+\e(B ?\e,1#\e(B ?\e,1%\e(B ?\e,1&\e(B ?\e,1g\e(B ?\e,1$\e(B ?\e,1'\e(B ?\e,1h\e(B ?\e,2,\e(B ?\e,1k\e(B ?\e,1(\e(B
- ?\e,1i\e(B ?\e,1)\e(B ?\e,1+\e(B ?\e,1,\e(B ?\e,1-\e(B ?\e,1*\e(B ?\e,1.\e(B ?\e,1l\e(B ?\e,1o\e(B ?\e,2-\e(B ?\e,2*\e(B ?\e,20\e(B ?\e,1n\e(B ?\e,1m\e(B ?\e,18\e(B ?\e,1r\e(B
- ?\e,21\e(B ?\e,1v\e(B ?\e,1u\e(B ?\e,1s\e(B ?\e,1w\e(B ?\e,10\e(B ?\e,11\e(B ?\e,12\e(B ?\e,1/\e(B ?\e,15\e(B ?\e,16\e(B ?\e,17\e(B ?\e,1^\e(B ?\e,1>\e(B ?\e,1~\e(B ?\e,1y\e(B
- ?\e,22\e(B ?\e,1|\e(B ?\e,1{\e(B ?\e,1z\e(B ?\e,1x\e(B ?\e,1W\e(B ?\e,1X\e(B ?\e,1f\e(B ?\e,1Q\e(B ?\e,1q\e(B ?\e,1O\e(B ?\e,1V\e(B ?\e,1[\e(B ?\e,1}\e(B ?\e,1\\e(B ?\e,2/\e(B]
- "Vietnamese VSCII decoding table.")
-
-(let ((table (make-translation-table-from-vector viet-vscii-decode-table)))
- (define-translation-table 'viet-vscii-nonascii-translation-table table)
- (define-translation-table 'viet-vscii-encode-table
- (char-table-extra-slot table 0)))
-
-;; Does not support combining characters in the range [176, 180]
-(defvar viet-tcvn-decode-table
- [;; TCVN is a full 8-bit code.
- 0 ?\e,2z\e(B ?\e,2x\e(B 3 ?\e,2W\e(B ?\e,2X\e(B ?\e,2f\e(B 7 8 9 10 11 12 13 14 15
- 16 ?\e,2Q\e(B ?\e,2q\e(B ?\e,2O\e(B ?\e,2V\e(B ?\e,2[\e(B ?\e,2}\e(B ?\e,2\\e(B 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,2`\e(B ?\e,2d\e(B ?\e,2c\e(B ?\e,2a\e(B ?\e,2U\e(B ?\e,2#\e(B ?\e,2'\e(B ?\e,2h\e(B ?\e,2k\e(B ?\e,2(\e(B ?\e,2i\e(B ?\e,2)\e(B ?\e,2.\e(B ?\e,2l\e(B ?\e,2o\e(B ?\e,2n\e(B
- ?\e,2m\e(B ?\e,28\e(B ?\e,2r\e(B ?\e,2v\e(B ?\e,2u\e(B ?\e,2s\e(B ?\e,2w\e(B ?\e,25\e(B ?\e,26\e(B ?\e,27\e(B ?\e,2^\e(B ?\e,2>\e(B ?\e,2~\e(B ?\e,2y\e(B ?\e,2|\e(B ?\e,2{\e(B
- 160 ?\e,2e\e(B ?\e,2b\e(B ?\e,2j\e(B ?\e,2t\e(B ?\e,2=\e(B ?\e,2_\e(B ?\e,2p\e(B ?\e,1e\e(B ?\e,1b\e(B ?\e,1j\e(B ?\e,1t\e(B ?\e,1=\e(B ?\e,1_\e(B ?\e,1p\e(B ?\e,2"\e(B
- 176 177 178 179 180 ?\e,1`\e(B ?\e,1d\e(B ?\e,1c\e(B ?\e,1a\e(B ?\e,1U\e(B ?\e,2F\e(B ?\e,1"\e(B ?\e,1F\e(B ?\e,1G\e(B ?\e,1!\e(B ?\e,2G\e(B
- ?\e,2!\e(B ?\e,2%\e(B ?\e,2&\e(B ?\e,2g\e(B ?\e,2$\e(B ?\e,2+\e(B ?\e,1#\e(B ?\e,1%\e(B ?\e,1&\e(B ?\e,1g\e(B ?\e,1$\e(B ?\e,1'\e(B ?\e,1h\e(B ?\e,2,\e(B ?\e,1k\e(B ?\e,1(\e(B
- ?\e,1i\e(B ?\e,1)\e(B ?\e,1+\e(B ?\e,1,\e(B ?\e,1-\e(B ?\e,1*\e(B ?\e,1.\e(B ?\e,1l\e(B ?\e,1o\e(B ?\e,2-\e(B ?\e,2*\e(B ?\e,20\e(B ?\e,1n\e(B ?\e,1m\e(B ?\e,18\e(B ?\e,1r\e(B
- ?\e,21\e(B ?\e,1v\e(B ?\e,1u\e(B ?\e,1s\e(B ?\e,1w\e(B ?\e,10\e(B ?\e,11\e(B ?\e,12\e(B ?\e,1/\e(B ?\e,15\e(B ?\e,16\e(B ?\e,17\e(B ?\e,1^\e(B ?\e,1>\e(B ?\e,1~\e(B ?\e,1y\e(B
- ?\e,22\e(B ?\e,1|\e(B ?\e,1{\e(B ?\e,1z\e(B ?\e,1x\e(B ?\e,1W\e(B ?\e,1X\e(B ?\e,1f\e(B ?\e,1Q\e(B ?\e,1q\e(B ?\e,1O\e(B ?\e,1V\e(B ?\e,1[\e(B ?\e,1}\e(B ?\e,1\\e(B ?\e,2/\e(B]
- "Vietnamese TCVN-5712 decoding table.")
-
-(let ((table (make-translation-table-from-vector viet-tcvn-decode-table)))
- (define-translation-table 'viet-tcvn-nonascii-translation-table table)
- (define-translation-table 'viet-tcvn-encode-table
- (char-table-extra-slot table 0)))
-
-;; (defvar viet-vps-decode-table
-;; [;; VPS is a full 8-bit code.
-;; 0 1 ?\e,2U\e(B ?\e,2'\e(B ?\e,2#\e(B ?\e,2)\e(B ?\e,2.\e(B 7 8 9 10 11 12 13 14 15
-;; ?\e,28\e(B ?\e,2w\e(B ?\e,25\e(B ?\e,2~\e(B ?\e,2x\e(B ?\e,2q\e(B 22 23 24 ?\e,2\\e(B 26 27 ?\e,2g\e(B ?\e,2f\e(B 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,2`\e(B ?\e,2d\e(B ?\e,2c\e(B ?\e,2$\e(B ?\e,2%\e(B ?\e,2&\e(B ?\e,1w\e(B ?\e,12\e(B ?\e,2e\e(B ?\e,1*\e(B ?\e,1+\e(B ?\e,1,\e(B ?\e,1.\e(B ?\e,2!\e(B ?\e,2"\e(B ?\e,2F\e(B
-;; ?\e,2*\e(B 145 146 ?\e,2+\e(B ?\e,2,\e(B ?\e,2-\e(B ?\e,2/\e(B ?\e,20\e(B ?\e,21\e(B ?\e,22\e(B ?\e,1}\e(B ?\e,1V\e(B ?\e,1\\e(B ?\e,2>\e(B ?\e,26\e(B ?\e,27\e(B
-;; 160 ?\e,1!\e(B ?\e,1"\e(B ?\e,1F\e(B ?\e,1G\e(B ?\e,1#\e(B ?\e,2^\e(B ?\e,1>\e(B ?\e,2y\e(B ?\e,16\e(B ?\e,17\e(B ?\e,1^\e(B ?\e,2{\e(B ?\e,2Q\e(B ?\e,1~\e(B ?\e,2W\e(B
-;; ?\e,11\e(B ?\e,2X\e(B ?\e,2O\e(B ?\e,2[\e(B ?\e,2m\e(B ?\e,2l\e(B ?\e,15\e(B ?\e,2o\e(B ?\e,2n\e(B ?\e,2s\e(B ?\e,1X\e(B ?\e,1f\e(B ?\e,2r\e(B ?\e,2v\e(B ?\e,2u\e(B ?\e,1q\e(B
-;; ?\e,1%\e(B ?\e,2a\e(B ?\e,2b\e(B ?\e,1$\e(B ?\e,1&\e(B ?\e,1g\e(B ?\e,1'\e(B ?\e,1p\e(B ?\e,1k\e(B ?\e,2i\e(B ?\e,2j\e(B ?\e,1)\e(B ?\e,1o\e(B ?\e,1-\e(B ?\e,18\e(B ?\e,1[\e(B
-;; ?\e,2_\e(B ?\e,2|\e(B ?\e,10\e(B ?\e,1/\e(B ?\e,2t\e(B ?\e,1v\e(B ?\e,1=\e(B ?\e,2h\e(B ?\e,1W\e(B ?\e,1Q\e(B ?\e,2z\e(B ?\e,1{\e(B ?\e,1_\e(B ?\e,2}\e(B ?\e,2k\e(B 223
-;; ?\e,1`\e(B ?\e,1a\e(B ?\e,1b\e(B ?\e,1c\e(B ?\e,1d\e(B ?\e,1U\e(B ?\e,1e\e(B 231 ?\e,1h\e(B ?\e,1i\e(B ?\e,1j\e(B ?\e,1(\e(B ?\e,1l\e(B ?\e,1m\e(B 238 ?\e,1n\e(B
-;; ?\e,2G\e(B ?\e,2p\e(B ?\e,1r\e(B ?\e,1s\e(B ?\e,1t\e(B ?\e,1u\e(B 246 ?\e,2=\e(B ?\e,1x\e(B ?\e,1y\e(B ?\e,1z\e(B ?\e,1|\e(B 252 ?\e,2V\e(B ?\e,2(\e(B ?\e,1O\e(B]
-;; "Vietnamese VPS decoding table.")
-;;
-;; (let ((table (make-translation-table-from-vector viet-vps-decode-table)))
-;; (define-translation-table 'viet-vps-nonascii-translation-table table)
-;; (define-translation-table 'viet-vps-encode-table
-;; (char-table-extra-slot table 0)))
-
-(define-ccl-program ccl-decode-viscii
- `(3
- ((loop
- (r0 = 0)
- (read r1)
- (translate-character viet-viscii-nonascii-translation-table r0 r1)
- (write-multibyte-character r0 r1)
- (repeat))))
- "CCL program to decode VISCII 1.1")
-
-(define-ccl-program ccl-encode-viscii
- `(1
- ((loop
- (read-multibyte-character r0 r1)
- (translate-character viet-viscii-encode-table r0 r1)
- (write-repeat r1))))
- "CCL program to encode VISCII 1.1")
-
-(define-ccl-program ccl-encode-viscii-font
- `(0
- ;; In: R0:vietnamese-viscii-lower/vietnamese-viscii-upper
- ;; R1:position code
- ;; Out: R1:font code point
- (translate-character viet-viscii-encode-table r0 r1))
- "CCL program to encode Vietnamese chars to VISCII 1.1 font")
-
-(define-ccl-program ccl-decode-vscii
- `(3
- ((loop
- (r0 = 0)
- (read r1)
- (translate-character viet-vscii-nonascii-translation-table r0 r1)
- (write-multibyte-character r0 r1)
- (repeat))))
- "CCL program to decode VSCII-1.")
-
-(define-ccl-program ccl-encode-vscii
- `(1
- ((loop
- (read-multibyte-character r0 r1)
- (translate-character viet-vscii-encode-table r0 r1)
- (write-repeat r1))))
- "CCL program to encode VSCII-1.")
-
-(define-ccl-program ccl-encode-vscii-font
- `(0
- ;; In: R0:vietnamese-viscii-lower/vietnamese-viscii-upper
- ;; R1:position code
- ;; Out: R1:font code point
- (translate-character viet-vscii-encode-table r0 r1))
- "CCL program to encode Vietnamese chars to VSCII-1 font.")
-
-(define-ccl-program ccl-decode-tcvn
- `(3
- ((loop
- (r0 = 0)
- (read r1)
- (translate-character viet-tcvn-nonascii-translation-table r0 r1)
- (write-multibyte-character r0 r1)
- (repeat))))
- "CCL program to decode TCVN-5712.")
-
-(define-ccl-program ccl-encode-tcvn
- `(1
- ((loop
- (read-multibyte-character r0 r1)
- (translate-character viet-tcvn-encode-table r0 r1)
- (write-repeat r1))))
- "CCL program to encode TCVN-5712.")
-
-(define-ccl-program ccl-encode-tcvn-font
- `(0
- ;; In: R0:vietnamese-viscii-lower/vietnamese-viscii-upper
- ;; R1:position code
- ;; Out: R1:font code point
- (translate-character viet-tcvn-encode-table r0 r1))
- "CCL program to encode Vietnamese chars to TCVN-5712 font.")
-
-;; (define-ccl-program ccl-decode-vps
-;; `(3
-;; ((loop
-;; (r0 = 0)
-;; (read r1)
-;; (translate-character viet-vps-nonascii-translation-table r0 r1)
-;; (write-multibyte-character r0 r1)
-;; (repeat))))
-;; "CCL program to decode VPS.")
-;;
-;; (define-ccl-program ccl-encode-vps
-;; `(1
-;; ((loop
-;; (read-multibyte-character r0 r1)
-;; (translate-character viet-vps-encode-table r0 r1)
-;; (write-repeat r1))))
-;; "CCL program to encode VPS.")
-;;
-;; (define-ccl-program ccl-encode-vps-font
-;; `(0
-;; ;; In: R0:vietnamese-viscii-lower/vietnamese-viscii-upper
-;; ;; R1:position code
-;; ;; Out: R1:font code point
-;; (translate-character viet-vps-encode-table r0 r1))
-;; "CCL program to encode Vietnamese chars to VPS font.")
-
-(make-coding-system
- 'vietnamese-viscii 4 ?V
- "8-bit encoding for Vietnamese VISCII 1.1 (MIME:VISCII)"
- '(ccl-decode-viscii . ccl-encode-viscii)
- '((safe-charsets ascii vietnamese-viscii-lower vietnamese-viscii-upper)
- (mime-charset . viscii)
- (valid-codes (0 . 255))))
+(define-coding-system 'vietnamese-viscii
+ "8-bit encoding for Vietnamese VISCII 1.1 (MIME:VISCII)."
+ :coding-type 'charset
+ :mnemonic ?V
+ :charset-list '(viscii)
+ :mime-charset 'viscii
+ :suitable-for-file-name t)
(define-coding-system-alias 'viscii 'vietnamese-viscii)
-(make-coding-system
- 'vietnamese-vscii 4 ?v
- "8-bit encoding for Vietnamese VSCII-1"
- '(ccl-decode-vscii . ccl-encode-vscii)
- '((safe-charsets ascii vietnamese-viscii-lower vietnamese-viscii-upper)
- (valid-codes (0 . 255))))
+(define-coding-system 'vietnamese-vscii
+ "8-bit encoding for Vietnamese VSCII-1."
+ :coding-type 'charset
+ :mnemonic ?v
+ :charset-list '(vscii)
+ :suitable-for-file-name t)
(define-coding-system-alias 'vscii 'vietnamese-vscii)
-(make-coding-system
- 'vietnamese-tcvn 4 ?t
- "8-bit encoding for Vietnamese TCVN-5712"
- '(ccl-decode-tcvn . ccl-encode-tcvn)
- '((safe-charsets ascii vietnamese-viscii-lower vietnamese-viscii-upper)
- (valid-codes (0 . 255))))
-
-(define-coding-system-alias 'tcvn 'vietnamese-tcvn)
-(define-coding-system-alias 'tcvn-5712 'vietnamese-tcvn)
-
;; (make-coding-system
;; 'vietnamese-vps 4 ?p
;; "8-bit encoding for Vietnamese VPS"
;;
;; (define-coding-system-alias 'vps 'vietnamese-vps)
-(make-coding-system
- 'vietnamese-viqr 0 ?q
- "Vietnamese latin transcription (VIQR)"
- nil
- '((safe-charsets ascii vietnamese-viscii-lower vietnamese-viscii-upper)
- (post-read-conversion . viqr-post-read-conversion)
- (pre-write-conversion . viqr-pre-write-conversion)
- (charset-origin-alist
- (vietnamese-viscii-lower "VISCII" viet-encode-viscii-char)
- (vietnamese-viscii-upper "VISCII" viet-encode-viscii-char))))
-
+(define-coding-system 'vietnamese-viqr
+ "Vietnamese latin transcription (VIQR)."
+ :coding-type 'utf-8
+ :mnemonic ?q
+ :charset-list '(ascii viscii)
+ :post-read-conversion 'viqr-post-read-conversion
+ :pre-write-conversion 'viqr-pre-write-conversion)
(define-coding-system-alias 'viqr 'vietnamese-viqr)
-(setq font-ccl-encoder-alist
- (cons '("viscii" . ccl-encode-viscii-font) font-ccl-encoder-alist))
-
-(setq font-ccl-encoder-alist
- (cons '("vscii" . ccl-encode-vscii-font) font-ccl-encoder-alist))
-
-(setq font-ccl-encoder-alist
- (cons '("tcvn" . ccl-encode-tcvn-font) font-ccl-encoder-alist))
-
(set-language-info-alist
- "Vietnamese" `((charset vietnamese-viscii-lower vietnamese-viscii-upper)
- (nonascii-translation
- . ,(get 'viet-viscii-nonascii-translation-table
- 'translation-table))
- (coding-system vietnamese-viscii vietnamese-vscii vietnamese-tcvn
- vietnamese-viqr)
+ "Vietnamese" `((charset viscii)
+ (coding-system vietnamese-viscii vietnamese-vscii
+ vietnamese-tcvn vietnamese-viqr windows-1258)
+ (nonascii-translation . viscii)
(coding-priority vietnamese-viscii)
(input-method . "vietnamese-viqr")
(unibyte-display . vietnamese-viscii)
(sample-text . "Vietnamese (Ti\e,1*\e(Bng Vi\e,1.\e(Bt) Ch\e,1`\e(Bo b\e,1U\e(Bn")
(documentation . "\
For Vietnamese, Emacs uses special charsets internally.
-They can be decoded from and encoded to VISCII, VSCII, TCVN-5712, and
-VIQR. VSCII is deprecated in favour of TCVN-5712. Current setting
-puts higher priority to the coding system VISCII than TCVN-5712. If
-you prefer TCVN-5712, please do: (prefer-coding-system 'vietnamese-tcvn).
-There are two Vietnamese input methods: VIQR and Telex, VIQR is the
-default setting.")
- ))
+They can be decoded from and encoded to VISCII, VSCII, TCVN-5712, VIQR
+and windows-1258. VSCII is deprecated in favour of TCVN-5712. The
+Current setting gives higher priority to the coding system VISCII than
+TCVN-5712. If you prefer TCVN-5712, please do: (prefer-coding-system
+'vietnamese-tcvn). There are two Vietnamese input methods: VIQR and
+Telex, VIQR is the default setting.")))
+
+(define-coding-system 'windows-1258
+ "windows-1258 encoding for Vietnamese (MIME: WINDOWS-1258)"
+ :coding-type 'charset
+ :mnemonic ?*
+ :charset-list '(windows-1258)
+ :mime-charset 'windows-1258)
+(define-coding-system-alias 'cp1258 'windows-1258)
+
+(define-coding-system 'vietnamese-tcvn
+ "8-bit encoding for Vietnamese TCVN-5712"
+ :coding-type 'charset
+ :mnemonic ?t
+ :charset-list '(tcvn-5712)
+ :suitable-for-file-name t)
+(define-coding-system-alias 'tcvn 'vietnamese-tcvn)
+(define-coding-system-alias 'tcvn-5712 'vietnamese-tcvn)
(provide 'vietnamese)
;;; loadup.el --- load up standardly loaded Lisp files for Emacs
;; Copyright (C) 1985, 1986, 1992, 1994, 2001, 2002, 2003,
- ;; 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ ;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: internal
;; get autoloaded when bootstrapping
(if (or (equal (nth 3 command-line-args) "bootstrap")
(equal (nth 4 command-line-args) "bootstrap")
+ (equal (nth 3 command-line-args) "unidata-gen.el")
+ (equal (nth 4 command-line-args) "unidata-gen-files")
;; in case CANNOT_DUMP
(equal (nth 0 command-line-args) "../src/bootstrap-emacs"))
(let ((dir (car load-path)))
;; multilingual text.
(load "international/mule-cmds")
(load "case-table")
-(load "international/utf-8")
-(load "international/utf-16")
(load "international/characters")
+(load "composite")
+;; This file doesn't exist when building Emacs from CVS. It is
+;; generated just after temacs is build.
+(load "international/charprop.el" t)
-(let ((set-case-syntax-set-multibyte t))
- (load "international/latin-1")
- (load "international/latin-2")
- (load "international/latin-3")
- (load "international/latin-4")
- (load "international/latin-5")
- (load "international/latin-8")
- (load "international/latin-9"))
;; Load language-specific files.
(load "language/chinese")
(load "language/cyrillic")
(load "language/japanese")
(load "language/korean")
(load "language/lao")
+(load "language/tai-viet")
(load "language/thai")
(load "language/tibetan")
(load "language/vietnamese")
(load "language/misc-lang")
(load "language/utf-8-lang")
(load "language/georgian")
-
-(load "international/ucs-tables")
-
-(update-coding-systems-internal)
+(load "language/khmer")
+(load "language/myanmar")
(load "indent")
(load "window")
(load "vms-patch")))
(if (eq system-type 'windows-nt)
(progn
- (load "international/ccl")
- (load "international/code-pages")
(load "w32-vars")
(load "term/w32-win")
(load "ls-lisp")
(equal (nth 4 command-line-args) "bootstrap"))
(setcdr load-path nil))
+(clear-charset-maps)
(garbage-collect)
;;; At this point, we're ready to resume undo recording for scratch.
;;; emacsbug.el --- command to report Emacs bugs to appropriate mailing list
;; Copyright (C) 1985, 1994, 1997, 1998, 2000, 2001, 2002, 2003,
- ;; 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ ;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: K. Shane Hartman
;; Maintainer: FSF
'(lambda (var)
(insert (format " value of $%s: %s\n" var (getenv var))))
'("LC_ALL" "LC_COLLATE" "LC_CTYPE" "LC_MESSAGES"
- "LC_MONETARY" "LC_NUMERIC" "LC_TIME" "LANG"))
+ "LC_MONETARY" "LC_NUMERIC" "LC_TIME" "LANG" "XMODIFIERS"))
(insert (format " locale-coding-system: %s\n" locale-coding-system))
(insert (format " default-enable-multibyte-characters: %s\n"
default-enable-multibyte-characters))
(insert "\n")
(insert (format "Major mode: %s\n"
- (buffer-local-value 'mode-name from-buffer)))
+ (format-mode-line
+ (buffer-local-value 'mode-name from-buffer)
+ nil nil from-buffer)))
(insert "\n")
(insert "Minor modes in effect:\n")
(dolist (mode minor-mode-list)
;;; rmail.el --- main code of "RMAIL" mail reader for Emacs
;; Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995, 1996, 1997, 1998,
- ;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ ;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
;; Free Software Foundation, Inc.
;; Maintainer: FSF
(unless (and coding-system
(coding-system-p coding-system))
(setq coding-system
- ;; Emacs 21.1 and later writes RMAIL files in emacs-mule, but
- ;; earlier versions did that with the current buffer's encoding.
- ;; So we want to favor detection of emacs-mule (whose normal
- ;; priority is quite low), but still allow detection of other
- ;; encodings if emacs-mule won't fit. The call to
- ;; detect-coding-with-priority below achieves that.
- (car (detect-coding-with-priority
- from to
- '((coding-category-emacs-mule . emacs-mule))))))
- (unless (memq coding-system
- '(undecided undecided-unix))
+ ;; If rmail-file-coding-system is nil, Emacs 21 writes
+ ;; RMAIL files in emacs-mule, Emacs 22 in utf-8, but
+ ;; earlier versions did that with the current buffer's
+ ;; encoding. So we want to favor detection of emacs-mule
+ ;; (whose normal priority is quite low) and utf-8, but
+ ;; still allow detection of other encodings if they won't
+ ;; fit. The call to with-coding-priority below achieves
+ ;; that.
+ (with-coding-priority '(emacs-mule utf-8)
+ (detect-coding-region from to 'highest))))
+ (unless (eq (coding-system-type coding-system) 'undecided)
(set-buffer-modified-p t) ; avoid locking when decoding
(let ((buffer-undo-list t))
(decode-coding-region from to coding-system))
;;; sendmail.el --- mail sending commands for Emacs. -*- byte-compile-dynamic: t -*-
;; Copyright (C) 1985, 1986, 1992, 1993, 1994, 1995, 1996, 1998, 2000,
- ;; 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ ;; 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: mail
(/= (point) (point-max)))
selected-coding
(setq charset
- (coding-system-get selected-coding 'mime-charset))
+ (coding-system-get selected-coding :mime-charset))
(goto-char delimline)
(insert "MIME-version: 1.0\n"
"Content-type: text/plain; charset="
(define-key (current-local-map) "v"
(lambda ()
(interactive)
- (let ((coding-system-for-read 'emacs-mule-unix))
+ (let ((coding-system-for-read 'utf-8-emacs-unix))
(dired-view-file))))
(define-key (current-local-map) "\C-c\C-c"
(lambda ()
(let ((fname (dired-get-filename))
;; Auto-saved files are written in the internal
;; representation, so they should be read accordingly.
- (coding-system-for-read 'emacs-mule-unix))
+ (coding-system-for-read 'utf-8-emacs-unix))
(switch-to-buffer-other-window "*mail*")
(let ((buffer-read-only nil))
(erase-buffer)
(insert-file-contents fname nil)
;; insert-file-contents will set buffer-file-coding-system
- ;; to emacs-mule, which is probably not what they want to
+ ;; to utf-8-emacs, which is probably not what they want to
;; use for sending the message. But we don't know what
;; was its value before the buffer was killed or Emacs
;; crashed. We therefore reset buffer-file-coding-system
(buffer-coding buffer-file-coding-system)
;; Auto-save files are written in internal
;; representation of non-ASCII characters.
- (coding-system-for-read 'emacs-mule-unix))
+ (coding-system-for-read 'utf-8-emacs-unix))
(erase-buffer)
(insert-file-contents file-name nil)
(setq buffer-file-coding-system buffer-coding)))))
# -*- Makefile -*- for GNU Emacs on the Microsoft W32 API.
# Copyright (C) 2000, 2001, 2002, 2003, 2004,
- # 2005, 2006, 2007 Free Software Foundation, Inc.
+ # 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
#
# This file is part of GNU Emacs.
#
# Set EMACSLOADPATH correctly (already defined in environment).
EMACSLOADPATH=$(lisp)
+# Use C locale
+LC_ALL = C
+
lisptagsfiles1 = $(lisp)/*.el
lisptagsfiles2 = $(lisp)/*/*.el
ETAGS = "../lib-src/$(BLD)/etags"
pre-mh-loaddefs.el-SH:
echo ";;; mh-loaddefs.el --- automatically extracted autoloads" > $@
echo ";;" >> $@
- echo ";; Copyright (C) 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc." >> $@
+ echo ";; Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc." >> $@
echo ";; Author: Bill Wohler <wohler@newt.com>" >> $@
echo ";; Keywords: mail" >> $@
echo ";;; Commentary:" >> $@
pre-mh-loaddefs.el-CMD:
echo ;;; mh-loaddefs.el --- automatically extracted autoloads> $@
echo ;;>> $@
- echo ;; Copyright (C) 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.>> $@
+ echo ;; Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.>> $@
echo ;; Author: Bill Wohler (wohler@newt.com)>> $@
echo ;; Keywords: mail>> $@
echo ;;; Commentary:>> $@
;;; swedish.el --- miscellaneous functions for dealing with Swedish
- ;; Copyright (C) 1988, 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ ;; Copyright (C) 1988, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
;; Free Software Foundation, Inc.
;; Author: Howard Gayle
;;; Commentary:
+;; Fixme: Is this actually used? if so, it should be in language,
+;; possibly as a feature property of Swedish, probably defining a
+;; `swascii' coding system.
+
;;; Code:
;; Written by Howard Gayle. See case-table.el for details.
;; See iso-swed.el for a description of the character set.
-(require 'latin-1)
-
(defvar mail-send-hook)
(defvar news-group-hook-alist)
(defvar news-inews-hook)
;;; gamegrid.el --- library for implementing grid-based games on Emacs
;; Copyright (C) 1997, 1998, 2001, 2002, 2003, 2004,
- ;; 2005, 2006, 2007 Free Software Foundation, Inc.
+ ;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Glynn Clements <glynn@sensei.co.uk>
;; Version: 1.02
(< max-height height))
(setq max-height height))))))
(when (and max-height (< max-height 1))
- (face-spec-set gamegrid-face `((t :height ,max-height)))))))
+ (let ((default-font-height (face-attribute 'default :height))
+ (resy (/ (display-pixel-height) (/ (display-mm-height) 25.4)))
+ point-size pixel-size)
+ (setq point-size (/ (* (float default-font-height) max-height) 10)
+ pixel-size (floor (* resy (/ point-size 72.27)))
+ point-size (* (/ pixel-size resy) 72.27))
+ (face-spec-set gamegrid-face
+ `((t :height ,(floor (* point-size 10))))))))))
(defun gamegrid-initialize-display ()
(setq gamegrid-display-mode (gamegrid-display-type))
;;; perl-mode.el --- Perl code editing commands for GNU Emacs
- ;; Copyright (C) 1990, 1994, 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ ;; Copyright (C) 1990, 1994, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
;; Free Software Foundation, Inc.
;; Author: William F. Mann
(while (< (point) limit)
(cond
((or (null (setq char (nth 3 state)))
- (and (char-valid-p char) (eq (char-syntax (nth 3 state)) ?\")))
+ (and (characterp char) (eq (char-syntax (nth 3 state)) ?\")))
;; Normal text, or comment, or docstring, or normal string.
nil)
((eq (nth 3 state) ?\n)
;;; sh-script.el --- shell-script editing commands for Emacs
;; Copyright (C) 1993, 1994, 1995, 1996, 1997, 1999, 2001, 2002,
- ;; 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ ;; 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Daniel Pfeiffer <occitan@esperanto.org>
;; Version: 2.0f
"The width for further indentation in Shell-Script mode."
:type 'integer
:group 'sh-script)
-
+ (put 'sh-indentation 'safe-local-variable 'integerp)
(defcustom sh-remember-variable-min 3
"Don't remember variables less than this length for completing reads."
(defun sh-font-lock-syntactic-face-function (state)
(let ((q (nth 3 state)))
(if q
- (if (char-valid-p q)
+ (if (characterp q)
(if (eq q ?\`) 'sh-quoted-exec font-lock-string-face)
sh-heredoc-face)
font-lock-comment-face)))
;;; ps-bdf.el --- BDF font file handler for ps-print
- ;; Copyright (C) 1998, 1999, 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ ;; Copyright (C) 1998, 1999, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
;; Free Software Foundation, Inc.
- ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
+ ;; 2008
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
+;; Copyright (C) 2003
+;; National Institute of Advanced Industrial Science and Technology (AIST)
+;; Registration Number H13PRO009
+
;; Keywords: wp, BDF, font, PostScript
;; Maintainer: Kenichi Handa <handa@m17n.org>
;;; Code:
(eval-and-compile
- (require 'ps-mule)
-
- ;; to avoid XEmacs compilation gripes
- (defvar installation-directory nil)
- (defvar coding-system-for-read nil))
+ (require 'ps-mule))
;;;###autoload
(defvar bdf-directory-list
(if (file-name-absolute-p bdfname)
(and (file-readable-p bdfname)
bdfname)
- (let ((dir-list bdf-directory-list)
- dir)
- (while (and dir-list
- (progn
- (setq dir (expand-file-name bdfname (car dir-list)))
- (not (file-readable-p dir))))
- (setq dir nil
- dir-list (cdr dir-list)))
- dir)))
+ (catch 'tag
+ (dolist (dir bdf-directory-list)
+ (let ((absolute-path (expand-file-name bdfname dir)))
+ (if (file-readable-p absolute-path)
+ (throw 'tag absolute-path)))))))
(defsubst bdf-file-mod-time (filename)
"Return modification time of FILENAME.
"Return non-nil if and only if FILENAME is newer than MOD-TIME.
MOD-TIME is a modification time as a list of two integers, the first
integer has high-order 16 bits, the second has low 16 bits."
- (let ((file-name (bdf-expand-file-name filename)))
- (and file-name
- (let* ((new-mod-time (bdf-file-mod-time file-name))
- (new-time (car new-mod-time))
- (time (car mod-time)))
- (or (> new-time time)
- (and (= new-time time)
- (> (nth 1 new-mod-time) (nth 1 mod-time))))))))
+ (let* ((new-mod-time (bdf-file-mod-time filename))
+ (new-time (car new-mod-time))
+ (time (car mod-time)))
+ (or (> new-time time)
+ (and (= new-time time)
+ (> (nth 1 new-mod-time) (nth 1 mod-time))))))
(defun bdf-find-file (bdfname)
"Return a buffer visiting a bdf file BDFNAME.
-If BDFNAME is not an absolute path, directories listed in
-`bdf-directory-list' is searched.
+BDFNAME must be an absolute file name.
If BDFNAME doesn't exist, return nil."
- (let ((file-name (bdf-expand-file-name bdfname)))
- (and file-name
- (let ((buf (generate-new-buffer " *bdf-work*"))
- (coding-system-for-read 'no-conversion))
- (save-excursion
- (set-buffer buf)
- (insert-file-contents file-name)
- buf)))))
+ (and (file-readable-p bdfname)
+ (let ((buf (generate-new-buffer " *bdf-work*"))
+ (coding-system-for-read 'no-conversion))
+ (save-excursion
+ (set-buffer buf)
+ (insert-file-contents bdfname)
+ buf))))
(defvar bdf-cache-file (if (eq system-type 'ms-dos)
;; convert-standard-filename doesn't
(defvar bdf-cache nil
"Cached information of `BDF' font files. It is a list of FONT-INFO.
FONT-INFO is a list of the following format:
- (BDFFILE ABSOLUTE-PATH MOD-TIME SIZE FONT-BOUNDING-BOX
+ (ABSOLUTE-FILE-NAME MOD-TIME SIZE FONT-BOUNDING-BOX
RELATIVE-COMPOSE BASELINE-OFFSET CODE-RANGE MAXLEN OFFSET-VECTOR)
See the documentation of the function `bdf-read-font-info' for more detail.")
(defun bdf-set-cache (font-info)
"Cache FONT-INFO as information about one `BDF' font file.
FONT-INFO is a list of the following format:
- (BDFFILE ABSOLUTE-PATH MOD-TIME SIZE FONT-BOUNDING-BOX
+ (ABSOLUTE-FILE-NAME MOD-TIME SIZE FONT-BOUNDING-BOX
RELATIVE-COMPOSE BASELINE-OFFSET CODE-RANGE MAXLEN OFFSET-VECTOR)
See the documentation of the function `bdf-read-font-info' for more detail."
(let ((slot (assoc (car font-info) bdf-cache)))
(defun bdf-read-font-info (bdfname)
"Read `BDF' font file BDFNAME and return information (FONT-INFO) of the file.
+BDFNAME must be an absolute file name.
FONT-INFO is a list of the following format:
- (BDFFILE ABSOLUTE-PATH MOD-TIME FONT-BOUNDING-BOX
+ (BDFFILE MOD-TIME FONT-BOUNDING-BOX
RELATIVE-COMPOSE BASELINE-OFFSET CODE-RANGE MAXLEN OFFSET-VECTOR)
-BDFFILE is a name of a font file (excluding directory part).
-
-ABSOLUTE-PATH is an absolute path of the font file.
-
MOD-TIME is last modification time as a list of two integers, the
first integer has high-order 16 bits, the second has low 16 bits.
-SIZE is a size of the font. This value is got from SIZE record of the
-font.
+SIZE is a size of the font on 72 dpi device. This value is got
+from SIZE record of the font.
FONT-BOUNDING-BOX is the font bounding box as a list of four integers,
BBX-WIDTH, BBX-HEIGHT, BBX-XOFF, and BBX-YOFF.
Nth element of OFFSET-VECTOR is a file position for the glyph of code
CODE, where N and CODE are in the following relation:
(bdf-compact-code CODE) => N, (bdf-expand-code N) => CODE"
- (let* ((absolute-path (bdf-expand-file-name bdfname))
- (buf (and absolute-path (bdf-find-file absolute-path)))
+ (let* ((buf (bdf-find-file bdfname))
(maxlen 0)
(relative-compose 'false)
(baseline-offset 0)
size
+ dpi
font-bounding-box
default-char
code-range
(- (aref font-bounding-box 3))))
(goto-char (point-min))
- (search-forward "\nSIZE ")
- (setq size (read (current-buffer)))
- ;; The following kludgy code is t avoid bugs of several
- ;; fonts which have wrong SIZE record.
- (and (<= size (/ (aref font-bounding-box 1) 3))
- (setq size (aref font-bounding-box 1)))
+ (search-forward "\nFONT ")
+ (if (looking-at "-[^-]*-[^-]*-[^-]*-[^-]*-[^-]*-[^-]*-\\([0-9]+\\)")
+ (setq size (string-to-int (match-string 1)))
+ (search-forward "\nSIZE ")
+ (setq size (read (current-buffer)))
+ ;; The following kludgy code is t avoid bugs of several
+ ;; fonts which have wrong SIZE record.
+ (and (string-match "jiskan" bdfname)
+ (<= size (/ (aref font-bounding-box 1) 3))
+ (setq size (aref font-bounding-box 1)))
+ (setq dpi (read (current-buffer)))
+ (if (and (> dpi 0) (/= dpi 72))
+ (setq size (/ (* size dpi) 72))))
(setq default-char (bdf-search-and-read "\nDEFAULT_CHAR" nil))
(kill-buffer buf))
(message "Reading %s...done" bdfname)
- (list bdfname absolute-path (bdf-file-mod-time absolute-path)
+ (list bdfname (bdf-file-mod-time bdfname)
size font-bounding-box relative-compose baseline-offset
code-range maxlen offset-vector)))
-(defsubst bdf-info-absolute-path (font-info) (nth 1 font-info))
-(defsubst bdf-info-mod-time (font-info) (nth 2 font-info))
-(defsubst bdf-info-size (font-info) (nth 3 font-info))
-(defsubst bdf-info-font-bounding-box (font-info) (nth 4 font-info))
-(defsubst bdf-info-relative-compose (font-info) (nth 5 font-info))
-(defsubst bdf-info-baseline-offset (font-info) (nth 6 font-info))
-(defsubst bdf-info-code-range (font-info) (nth 7 font-info))
-(defsubst bdf-info-maxlen (font-info) (nth 8 font-info))
-(defsubst bdf-info-offset-vector (font-info) (nth 9 font-info))
+(defsubst bdf-info-absolute-path (font-info) (nth 0 font-info))
+(defsubst bdf-info-mod-time (font-info) (nth 1 font-info))
+(defsubst bdf-info-size (font-info) (nth 2 font-info))
+(defsubst bdf-info-font-bounding-box (font-info) (nth 3 font-info))
+(defsubst bdf-info-relative-compose (font-info) (nth 4 font-info))
+(defsubst bdf-info-baseline-offset (font-info) (nth 5 font-info))
+(defsubst bdf-info-code-range (font-info) (nth 6 font-info))
+(defsubst bdf-info-maxlen (font-info) (nth 7 font-info))
+(defsubst bdf-info-offset-vector (font-info) (nth 8 font-info))
(defun bdf-get-font-info (bdfname)
"Return information about `BDF' font file BDFNAME.
+BDFNAME must be an absolute file name.
The value FONT-INFO is a list of the following format:
- (BDFFILE ABSOLUTE-PATH MOD-TIME SIZE FONT-BOUNDING-BOX
+ (BDFNAME MOD-TIME SIZE FONT-BOUNDING-BOX
RELATIVE-COMPOSE BASELINE-OFFSET CODE-RANGE MAXLEN OFFSET-VECTOR)
See the documentation of the function `bdf-read-font-info' for more detail."
(or bdf-cache
(bdf-read-cache))
(let ((font-info (assoc bdfname bdf-cache)))
(if (or (not font-info)
- (not (file-readable-p (bdf-info-absolute-path font-info)))
+ (not (file-readable-p bdfname))
(bdf-file-newer-than-time bdfname (bdf-info-mod-time font-info)))
(progn
(setq font-info (bdf-read-font-info bdfname))
(bdf-set-cache font-info)))
font-info))
-(defun bdf-find-font-info (bdfnames)
- "Return information about `BDF' font file with alternative names BDFNAMES.
-
-If BDFNAMES is a list of file names, this function finds the first file
-in the list which exists and is readable, then calls `bdf-get-font-info'
-on that file name."
- (let ((fnlist bdfnames)
- (fname bdfnames))
- (if (consp fnlist)
- (while (and fnlist
- (progn
- (setq fname (car fnlist))
- (null (bdf-expand-file-name fname))))
- (setq fname nil
- fnlist (cdr fnlist))))
- (bdf-get-font-info (or fname (car bdfnames)))))
-
-(defun bdf-read-bitmap (bdfname offset maxlen)
+(defun bdf-read-bitmap (bdfname offset maxlen relative-compose)
"Read `BDF' font file BDFNAME to get bitmap data at file position OFFSET.
BDFNAME is an absolute path name of the font file.
MAXLEN specifies how many bytes we should read at least.
BBX is a bounding box of the glyph.
BITMAP-STRING is a string representing bits by hexadecimal digits."
(let* ((coding-system-for-read 'no-conversion)
- (bbx (elt (bdf-get-font-info bdfname) 4))
+ (bbx (bdf-info-font-bounding-box (bdf-get-font-info bdfname)))
(dwidth (elt bbx 0))
(bitmap-string "")
height yoff)
(goto-char (point-min))
(search-forward "\nDWIDTH")
(setq dwidth (read (current-buffer)))
+ (if (= dwidth 0)
+ (setq dwidth 0.1))
(goto-char (point-min))
(search-forward "\nBBX")
(setq bbx (vector (read (current-buffer)) (read (current-buffer))
(delete-char 1))
(setq bitmap-string (buffer-string)))
(error nil))
- (list dwidth bbx bitmap-string)))
-
-(defun bdf-get-bitmaps (bdfname codes)
- "Return bitmap information of glyphs of CODES in `BDF' font file BDFNAME.
-CODES is a list of encoding number of glyphs in the file.
-The value is a list of CODE, DWIDTH, BBX, and BITMAP-STRING.
+ (vector dwidth (aref bbx 0) (aref bbx 1) (aref bbx 2) (aref bbx 3)
+ (concat "<" bitmap-string ">")
+ (or relative-compose 'false))))
+
+(defun bdf-get-bitmap (bdfname code)
+ "Return bitmap information of glyph of CODE in `BDF' font file BDFNAME.
+CODE is an encoding number of glyph in the file.
+The value is a list (DWIDTH BBX BITMAP-STRING).
DWIDTH is a pixel width of a glyph.
BBX is a bounding box of the glyph.
BITMAP-STRING is a string representing bits by hexadecimal digits."
- (let* ((font-info (bdf-find-font-info bdfname))
- (absolute-path (bdf-info-absolute-path font-info))
- ;;(font-bounding-box (bdf-info-font-bounding-box font-info))
- (maxlen (bdf-info-maxlen font-info))
- (code-range (bdf-info-code-range font-info))
- (offset-vector (bdf-info-offset-vector font-info)))
- (mapcar '(lambda (x)
- (cons x (bdf-read-bitmap
- absolute-path
- (aref offset-vector (bdf-compact-code x code-range))
- maxlen)))
- codes)))
-
-;;; Interface to ps-print.el
+ (let* ((info (bdf-get-font-info bdfname))
+ (maxlen (bdf-info-maxlen info))
+ (code-range (bdf-info-code-range info))
+ (offset-vector (bdf-info-offset-vector info)))
+ (bdf-read-bitmap bdfname
+ (aref offset-vector (bdf-compact-code code code-range))
+ maxlen (bdf-info-relative-compose info))))
+
+;;; Interface to ps-mule.el
;; Called from ps-mule-init-external-library.
(defun bdf-generate-prologue ()
(bdf-initialize))
(ps-mule-generate-bitmap-prologue))
+;; Called from ps-mule-check-font.
+(defun bdf-check-font (font-spec)
+ (let ((font-name-list (ps-mule-font-spec-name font-spec)))
+ (ps-mule-font-spec-set-name
+ font-spec
+ (if (stringp font-name-list)
+ (bdf-expand-file-name font-name-list)
+ (catch 'tag
+ (dolist (font-name font-name-list)
+ (setq font-name (bdf-expand-file-name font-name))
+ (if font-name
+ (throw 'tag font-name))))))))
+
;; Called from ps-mule-generate-font.
-(defun bdf-generate-font (charset font-spec)
- (let* ((font-name (ps-mule-font-spec-name font-spec))
- (font-info (bdf-find-font-info font-name))
- (font-name (if (consp font-name) (car font-name) font-name)))
- (ps-mule-generate-bitmap-font font-name
- (ps-mule-font-spec-bytes font-spec)
- (charset-width charset)
- (bdf-info-size font-info)
- (bdf-info-relative-compose font-info)
- (bdf-info-baseline-offset font-info)
- (bdf-info-font-bounding-box font-info))))
-
-;; Called from ps-mule-generate-glyphs.
-(defun bdf-generate-glyphs (font-spec code-list bytes)
- (let ((font-name (ps-mule-font-spec-name font-spec)))
- (mapcar '(lambda (x)
- (apply 'ps-mule-generate-bitmap-glyph
- (if (consp font-name) (car font-name) font-name)
- x))
- (bdf-get-bitmaps font-name code-list))))
+(defun bdf-generate-font (font-spec)
+ (let ((info (bdf-get-font-info (ps-mule-font-spec-name font-spec))))
+ (ps-mule-font-spec-set-extra
+ font-spec (bdf-info-absolute-path info))
+ (ps-mule-generate-bitmap-font font-spec
+ (bdf-info-size info)
+ (bdf-info-relative-compose info)
+ (bdf-info-baseline-offset info)
+ (bdf-info-font-bounding-box info))))
+
+;; Called from ps-mule-generate-glyph.
+(defun bdf-generate-glyph (font-spec char)
+ (let ((font-name (ps-mule-font-spec-extra font-spec))
+ (code (ps-mule-encode-char char font-spec)))
+ (ps-mule-generate-bitmap-glyph font-spec char code
+ (bdf-get-bitmap font-name code))))
(provide 'ps-bdf)
;;; ps-mule.el --- provide multi-byte character facility to ps-print
;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- ;; 2005, 2006, 2007 Free Software Foundation, Inc.
+ ;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
;; Kenichi Handa <handa@m17n.org> (multi-byte characters)
;;; Code:
(eval-and-compile
- (require 'ps-print)
-
- ;; to avoid XEmacs compilation gripes
- (defvar leading-code-private-22 157)
- (or (fboundp 'charset-bytes)
- (defun charset-bytes (charset) 1)) ; ascii
- (or (fboundp 'charset-dimension)
- (defun charset-dimension (charset) 1)) ; ascii
- (or (fboundp 'charset-id)
- (defun charset-id (charset) 0)) ; ascii
- (or (fboundp 'charset-width)
- (defun charset-width (charset) 1)) ; ascii
- (or (fboundp 'find-charset-region)
- (defun find-charset-region (beg end &optional table)
- (list 'ascii)))
- (or (fboundp 'char-valid-p)
- (defun char-valid-p (char)
- (< (following-char) 256)))
- (or (fboundp 'split-char)
- (defun split-char (char)
- (list (if (char-valid-p char)
- 'ascii
- 'unknow)
- char)))
- (or (fboundp 'char-width)
- (defun char-width (char) 1)) ; ascii
- (or (fboundp 'chars-in-region)
- (defun chars-in-region (beg end)
- (- (max beg end) (min beg end))))
- (or (fboundp 'forward-point)
- (defun forward-point (arg)
- (save-excursion
- (let ((count (abs arg))
- (step (if (zerop arg)
- 0
- (/ arg arg))))
- (while (and (> count 0)
- (< (point-min) (point)) (< (point) (point-max)))
- (forward-char step)
- (setq count (1- count)))
- (+ (point) (* count step))))))
- (or (fboundp 'decompose-composite-char)
- (defun decompose-composite-char (char &optional type
- with-composition-rule)
- nil))
- (or (fboundp 'encode-coding-string)
- (defun encode-coding-string (string coding-system &optional nocopy)
- (if nocopy
- string
- (copy-sequence string))))
- (or (fboundp 'coding-system-p)
- (defun coding-system-p (obj) nil))
- (or (fboundp 'ccl-execute-on-string)
- (defun ccl-execute-on-string (ccl-prog status str
- &optional contin unibyte-p)
- str))
- (or (fboundp 'define-ccl-program)
- (defmacro define-ccl-program (name ccl-program &optional doc)
- `(defconst ,name nil ,doc)))
- (or (fboundp 'multibyte-string-p)
- (defun multibyte-string-p (str)
- (let ((len (length str))
- (i 0)
- multibyte)
- (while (and (< i len) (not (setq multibyte (> (aref str i) 255))))
- (setq i (1+ i)))
- multibyte)))
- (or (fboundp 'string-make-multibyte)
- (defalias 'string-make-multibyte 'copy-sequence))
- (or (fboundp 'encode-char)
- (defun encode-char (ch ccs)
- ch)))
+ (require 'ps-print))
;;;###autoload
See also the variable `ps-font-info-database'.")
(defconst ps-mule-font-info-database-latin
- '((latin-iso8859-1
- (normal nil nil iso-latin-1)))
+ '((iso-8859-1
+ (normal nil nil)))
"Sample setting of `ps-mule-font-info-database' to use latin fonts.")
(defcustom ps-mule-font-info-database-default
(defconst ps-mule-font-info-database-ps
'((katakana-jisx0201
- (normal builtin "Ryumin-Light.Katakana" ps-mule-encode-7bit 1)
- (bold builtin "GothicBBB-Medium.Katakana" ps-mule-encode-7bit 1)
- (bold-italic builtin "GothicBBB-Medium.Katakana" ps-mule-encode-7bit 1))
+ (normal builtin "Ryumin-Light.Katakana")
+ (bold builtin "GothicBBB-Medium.Katakana")
+ (bold-italic builtin "GothicBBB-Medium.Katakana"))
(latin-jisx0201
- (normal builtin "Ryumin-Light.Hankaku" ps-mule-encode-7bit 1)
- (bold builtin "GothicBBB-Medium.Hankaku" ps-mule-encode-7bit 1))
+ (normal builtin "Ryumin-Light.Hankaku")
+ (bold builtin "GothicBBB-Medium.Hankaku"))
(japanese-jisx0208
- (normal builtin "Ryumin-Light-H" ps-mule-encode-7bit 2)
- (bold builtin "GothicBBB-Medium-H" ps-mule-encode-7bit 2))
+ (normal builtin "Ryumin-Light-H")
+ (bold builtin "GothicBBB-Medium-H"))
(korean-ksc5601
- (normal builtin "Munhwa-Regular-KSC-EUC-H" ps-mule-encode-7bit 2)
- (bold builtin "Munhwa-Bold-KSC-EUC-H" ps-mule-encode-7bit 2))
+ (normal builtin "Munhwa-Regular-KSC-EUC-H")
+ (bold builtin "Munhwa-Bold-KSC-EUC-H"))
)
"Sample setting of the `ps-mule-font-info-database' to use builtin PS font.
Currently, data for Japanese and Korean PostScript printers are listed.")
(defconst ps-mule-font-info-database-bdf
- '((ascii
- (normal bdf ("lt1-24-etl.bdf" "etl24-latin1.bdf") nil 1)
- (bold bdf ("lt1-16b-etl.bdf" "etl16b-latin1.bdf") nil 1)
- (italic bdf ("lt1-16i-etl.bdf" "etl16i-latin1.bdf") nil 1)
- (bold-italic bdf ("lt1-16bi-etl.bdf" "etl16bi-latin1.bdf") nil 1))
- (latin-iso8859-1
- (normal bdf ("lt1-24-etl.bdf" "etl24-latin1.bdf") iso-latin-1 1)
- (bold bdf ("lt1-16b-etl.bdf" "etl16b-latin1.bdf") iso-latin-1 1)
- (italic bdf ("lt1-16i-etl.bdf" "etl16i-latin1.bdf") iso-latin-1 1)
- (bold-italic bdf ("lt1-16bi-etl.bdf" "etl16bi-latin1.bdf") iso-latin-1 1))
- (latin-iso8859-2
- (normal bdf ("lt2-24-etl.bdf" "etl24-latin2.bdf") iso-latin-2 1))
- (latin-iso8859-3
- (normal bdf ("lt3-24-etl.bdf" "etl24-latin3.bdf") iso-latin-3 1))
- (latin-iso8859-4
- (normal bdf ("lt4-24-etl.bdf" "etl24-latin4.bdf") iso-latin-4 1))
+ '((iso-8859-1
+ (normal bdf ("lt1-24-etl.bdf" "etl24-latin1.bdf"))
+ (bold bdf ("lt1-16b-etl.bdf" "etl16b-latin1.bdf"))
+ (italic bdf ("lt1-16i-etl.bdf" "etl16i-latin1.bdf"))
+ (bold-italic bdf ("lt1-16bi-etl.bdf" "etl16bi-latin1.bdf")))
+ (iso-8859-2
+ (normal bdf ("lt2-24-etl.bdf" "etl24-latin2.bdf")))
+ (iso-8859-3
+ (normal bdf ("lt3-24-etl.bdf" "etl24-latin3.bdf")))
+ (iso-8859-4
+ (normal bdf ("lt4-24-etl.bdf" "etl24-latin4.bdf")))
(thai-tis620
- (normal bdf ("thai24.bdf" "thai-24.bdf") thai-tis620 1))
+ (normal bdf ("thai24.bdf" "thai-24.bdf") iso-8859-11))
(greek-iso8859-7
- (normal bdf ("grk24-etl.bdf" "etl24-greek.bdf") greek-iso-8bit 1))
- ;; (arabic-iso8859-6 nil) ; not yet available
+ (normal bdf ("grk24-etl.bdf" "etl24-greek.bdf") iso-8859-7))
(hebrew-iso8859-8
- (normal bdf ("heb24-etl.bdf" "etl24-hebrew.bdf") hebrew-iso-8bit 1))
- (katakana-jisx0201
- (normal bdf "12x24rk.bdf" ps-mule-encode-8bit 1))
- (latin-jisx0201
- (normal bdf "12x24rk.bdf" ps-mule-encode-7bit 1))
+ (normal bdf ("heb24-etl.bdf" "etl24-hebrew.bdf") iso-8859-8))
+ (jisx0201
+ (normal bdf "12x24rk.bdf" jisx0201))
(cyrillic-iso8859-5
- (normal bdf ("cyr24-etl.bdf" "etl24-cyrillic.bdf") cyrillic-iso-8bit 1))
- (latin-iso8859-9
- (normal bdf ("lt5-24-etl.bdf" "etl24-latin5.bdf") iso-latin-5 1))
- (japanese-jisx0208-1978
- (normal bdf "jiskan24.bdf" ps-mule-encode-7bit 2))
+ (normal bdf ("cyr24-etl.bdf" "etl24-cyrillic.bdf") iso-8859-5))
+ (iso-8859-9
+ (normal bdf ("lt5-24-etl.bdf" "etl24-latin5.bdf") iso-8859-9))
(chinese-gb2312
- (normal bdf "gb24st.bdf" ps-mule-encode-7bit 2))
+ (normal bdf "gb24st.bdf"))
(japanese-jisx0208
- (normal bdf "jiskan24.bdf" ps-mule-encode-7bit 2))
+ (normal bdf "jiskan24.bdf"))
(korean-ksc5601
- (normal bdf "hanglm24.bdf" ps-mule-encode-7bit 2))
+ (normal bdf "hanglm24.bdf"))
(japanese-jisx0212
- (normal bdf ("jksp40.bdf" "jisksp40.bdf") ps-mule-encode-7bit 2))
+ (normal bdf ("jksp40.bdf" "jisksp40.bdf")))
(chinese-cns11643-1
- (normal bdf ("cns1-40.bdf" "cns-1-40.bdf") ps-mule-encode-7bit 2))
+ (normal bdf ("cns1-40.bdf" "cns-1-40.bdf")))
(chinese-cns11643-2
- (normal bdf ("cns2-40.bdf" "cns-2-40.bdf") ps-mule-encode-7bit 2))
- (chinese-big5-1
- (normal bdf "taipei24.bdf" chinese-big5 2))
- (chinese-big5-2
- (normal bdf "taipei24.bdf" chinese-big5 2))
+ (normal bdf ("cns2-40.bdf" "cns-2-40.bdf")))
+ (big5
+ (normal bdf "taipei24.bdf"))
(chinese-sisheng
- (normal bdf ("sish24-etl.bdf" "etl24-sisheng.bdf") ps-mule-encode-7bit 1))
+ (normal bdf ("sish24-etl.bdf" "etl24-sisheng.bdf")))
(ipa
- (normal bdf ("ipa24-etl.bdf" "etl24-ipa.bdf") ps-mule-encode-8bit 1))
- (vietnamese-viscii-lower
- (normal bdf ("visc24-etl.bdf" "etl24-viscii.bdf") vietnamese-viscii 1))
- (vietnamese-viscii-upper
- (normal bdf ("visc24-etl.bdf" "etl24-viscii.bdf") vietnamese-viscii 1))
+ (normal bdf ("ipa24-etl.bdf" "etl24-ipa.bdf") ipa))
+ (viscii
+ (normal bdf ("visc24-etl.bdf" "etl24-viscii.bdf")))
(arabic-digit
- (normal bdf ("arab24-0-etl.bdf" "etl24-arabic0.bdf") ps-mule-encode-7bit 1))
+ (normal bdf ("arab24-0-etl.bdf" "etl24-arabic0.bdf")))
(arabic-1-column
- (normal bdf ("arab24-1-etl.bdf" "etl24-arabic1.bdf") ps-mule-encode-7bit 1))
- ;; (ascii-right-to-left nil) ; not yet available
+ (normal bdf ("arab24-1-etl.bdf" "etl24-arabic1.bdf")))
(lao
- (normal bdf ("lao24-mule.bdf" "mule-lao-24.bdf") lao 1))
+ (normal bdf ("lao24-mule.bdf" "mule-lao-24.bdf") ps-mule-encode-lao 1))
(arabic-2-column
- (normal bdf ("arab24-2-etl.bdf" "etl24-arabic2.bdf") ps-mule-encode-7bit 1))
+ (normal bdf ("arab24-2-etl.bdf" "etl24-arabic2.bdf")))
+ (devanagari-cdac
+ (normal bdf "dvsr0ntt-32.bdf"))
+ (malayalam-cdac
+ (normal bdf "mlkr0ntt-32.bdf"))
+ (tamil-cdac
+ (normal bdf "tmvl0ntt-32.bdf"))
(indian-is13194
- (normal bdf ("isci24-mule.bdf" "mule-iscii-24.bdf") ps-mule-encode-7bit 1))
+ (normal bdf ("isci24-mule.bdf" "mule-iscii-24.bdf")))
(indian-1-column
- (normal bdf ("ind1c24-mule.bdf" "mule-indian-1col-24.bdf") ps-mule-encode-7bit 2))
- (tibetan-1-column
- (normal bdf ("tib1c24-mule.bdf" "mule-tibmdx-1col-24.bdf") ps-mule-encode-7bit 2))
+ (normal bdf ("ind1c24-mule.bdf" "mule-indian-1col-24.bdf")))
(ethiopic
- (normal bdf ("ethio24f-uni.bdf" "ethiomx24f-uni.bdf") ps-mule-encode-ethiopic 2))
+ (normal bdf ("ethio24f-uni.bdf" "ethiomx24f-uni.bdf") unicode-bmp))
(chinese-cns11643-3
- (normal bdf ("cns3-40.bdf" "cns-3-40.bdf") ps-mule-encode-7bit 2))
+ (normal bdf ("cns3-40.bdf" "cns-3-40.bdf")))
(chinese-cns11643-4
- (normal bdf ("cns4-40.bdf" "cns-4-40.bdf") ps-mule-encode-7bit 2))
+ (normal bdf ("cns4-40.bdf" "cns-4-40.bdf")))
(chinese-cns11643-5
- (normal bdf ("cns5-40.bdf" "cns-5-40.bdf") ps-mule-encode-7bit 2))
+ (normal bdf ("cns5-40.bdf" "cns-5-40.bdf")))
(chinese-cns11643-6
- (normal bdf ("cns6-40.bdf" "cns-6-40.bdf") ps-mule-encode-7bit 2))
+ (normal bdf ("cns6-40.bdf" "cns-6-40.bdf")))
(chinese-cns11643-7
- (normal bdf ("cns7-40.bdf" "cns-7-40.bdf") ps-mule-encode-7bit 2))
+ (normal bdf ("cns7-40.bdf" "cns-7-40.bdf")))
(indian-2-column
- (normal bdf ("ind24-mule.bdf" "mule-indian-24.bdf") ps-mule-encode-7bit 2))
+ (normal bdf ("ind24-mule.bdf" "mule-indian-24.bdf")))
(tibetan
- (normal bdf ("tib24p-mule.bdf" "tib24-mule.bdf" "mule-tibmdx-24.bdf")
- ps-mule-encode-7bit 2))
- (mule-unicode-0100-24ff
- (normal bdf "etl24-unicode.bdf" ps-mule-encode-ucs2 2))
- (mule-unicode-2500-33ff
- (normal bdf "etl24-unicode.bdf" ps-mule-encode-ucs2 2))
- (mule-unicode-e000-ffff
- (normal bdf "etl24-unicode.bdf" ps-mule-encode-ucs2 2)))
+ (normal bdf ("tib24p-mule.bdf" "tib24-mule.bdf" "mule-tibmdx-24.bdf")))
+ (unicode-bmp
+ (normal bdf "etl24-unicode.bdf"))
+ )
"Sample setting of the `ps-mule-font-info-database' to use BDF fonts.
BDF (Bitmap Distribution Format) is a format used for distributing X's font
source file.
See also `ps-mule-font-info-database-bdf'.")
-;; Two typical encoding functions for PostScript fonts.
-
-(defun ps-mule-encode-7bit (string)
- (ps-mule-encode-bit string 0))
-
-(defun ps-mule-encode-8bit (string)
- (ps-mule-encode-bit string 128))
-
-(defun ps-mule-encode-bit (string delta)
- (let* ((dim (charset-dimension (char-charset (string-to-char string))))
- (len (length string))
- (str (make-string (* len dim) 0))
- (j 0))
- (if (= dim 1)
- ;; (apply 'string
- ;; (mapcar (lambda (c) (+ (nth 1 (split-char c)) delta))
- ;; string))
- (dotimes (i len)
- (aset str i
- (+ (nth 1 (split-char (aref string i))) delta)))
- ;; (mapconcat (lambda (c)
- ;; (let ((split (split-char c)))
- ;; (string (+ (nth 1 split) delta)
- ;; (+ (nth 2 split) delta))))
- ;; string "")
- (dotimes (i len)
- (let ((split (split-char (aref string i))))
- (aset str j (+ (nth 1 split) delta))
- (aset str (1+ j) (+ (nth 2 split) delta))
- (setq j (+ j 2)))))
- str))
-
-;; Special encoding function for Ethiopic.
-(if (boundp 'mule-version) ; only if mule package is loaded
- (define-ccl-program ccl-encode-ethio-unicode
- `(1
- ((read r2)
- (loop
- (if (r2 == ,leading-code-private-22)
- ((read r0)
- (if (r0 == ,(charset-id 'ethiopic))
- ((read r1 r2)
- (r1 &= 127) (r2 &= 127)
- (call ccl-encode-ethio-font)
- (write r1)
- (write-read-repeat r2))
- ((write r2 r0)
- (repeat))))
- (write-read-repeat r2))))))
- ;; to avoid compilation gripes
- (defvar ccl-encode-ethio-unicode nil))
-
-(defalias 'ps-mule-encode-ethiopic
- (if (boundp 'mule-version)
- ;; Bound mule-version.
- (lambda (string)
- (ccl-execute-on-string (symbol-value 'ccl-encode-ethio-unicode)
- (make-vector 9 nil)
- string))
- ;; Unbound mule-version.
- #'identity))
-
-;; Special encoding for mule-unicode-* characters.
-(defun ps-mule-encode-ucs2 (string)
- (let* ((len (length string))
- (str (make-string (* 2 len) 0))
- (j 0)
- ch hi lo)
- (dotimes (i len)
- (setq ch (encode-char (aref string i) 'ucs)
- hi (lsh ch -8)
- lo (logand ch 255))
- (aset str j hi)
- (aset str (1+ j) lo)
- (setq j (+ j 2)))
- str))
-
-;; A charset which we are now processing.
-(defvar ps-mule-current-charset nil)
-
-(defun ps-mule-get-font-spec (charset font-type)
- "Return FONT-SPEC for printing characters CHARSET with FONT-TYPE.
-FONT-SPEC is a list that has the form:
-
- (FONT-SRC FONT-NAME ENCODING BYTES)
-
-FONT-SPEC is extracted from `ps-mule-font-info-database'.
-
-See the documentation of `ps-mule-font-info-database' for the meaning of each
-element of the list."
- (let ((slot (cdr (assq charset ps-mule-font-info-database))))
- (and slot
- (cdr (or (assq font-type slot)
- (and (eq font-type 'bold-italic)
- (or (assq 'bold slot) (assq 'italic slot)))
- (assq 'normal slot))))))
+(defvar ps-mule-font-spec-list nil
+ "Array of FONT-SPEC lists for each font type.
+
+Elements are for `normal' font, `bold' font, `italic' font, and
+`bold-italic' font in this order.
+
+Each element is a list of FONT-SPEC which has this form:
+
+ (ID CHARSET (FONT-SRC FONT-NAME ENCODING) EXTRA-DATA)
+
+Where
+
+ID is a number for this FONT-SPEC and is unique in the list.
+
+CHARSET, FONT-SRC, FONT-NAME, ENCODING are the same as those in
+`ps-mule-font-info-database' (which see).
+
+EXTRA-DATA is a data attached by external libraries.
+
+Each list is ordered by the current charset priorities.
+
+This variable is setup by `ps-mule-begin-job' from
+`ps-mule-font-info-database'.")
;; Functions to access each element of FONT-SPEC.
-(defsubst ps-mule-font-spec-src (font-spec) (car font-spec))
-(defsubst ps-mule-font-spec-name (font-spec) (nth 1 font-spec))
-(defsubst ps-mule-font-spec-encoding (font-spec) (nth 2 font-spec))
-(defsubst ps-mule-font-spec-bytes (font-spec) (nth 3 font-spec))
-
-(defsubst ps-mule-printable-p (charset)
- "Non-nil if characters in CHARSET is printable."
- ;; ASCII and Latin-1 are always printable.
- (or (eq charset 'ascii)
- (eq charset 'latin-iso8859-1)
- (ps-mule-get-font-spec charset 'normal)))
+(defsubst ps-mule-font-spec-id (font-spec) (aref font-spec 0))
+(defsubst ps-mule-font-spec-charset (font-spec) (aref font-spec 1))
+(defsubst ps-mule-font-spec-font-id (font-spec) (aref font-spec 2))
+(defsubst ps-mule-font-spec-src (font-spec) (aref font-spec 3))
+(defsubst ps-mule-font-spec-name (font-spec) (aref font-spec 4))
+(defsubst ps-mule-font-spec-set-name (font-spec name)
+ (aset font-spec 4 name))
+(defsubst ps-mule-font-spec-encoding (font-spec) (aref font-spec 5))
+(defsubst ps-mule-font-spec-bytes (font-spec) (aref font-spec 6))
+(defsubst ps-mule-font-spec-extra (font-spec) (aref font-spec 7))
+(defsubst ps-mule-font-spec-set-extra (font-spec extra)
+ (aset font-spec 7 extra))
+
+;; Functions to encode character into glyph code.
+(defun ps-mule-encode-lao (char)
+ (- char #x0DE0))
+
+(defun ps-mule-encode-char (char font-spec)
+ (let ((encoding (ps-mule-font-spec-encoding font-spec)))
+ (cond ((charsetp encoding)
+ (encode-char char encoding))
+ ((fboundp encoding)
+ (funcall encoding char))
+ (t
+ char))))
+
+;; Array of FONT-SPEC-TABLEs; Nth element is for FONT-TYPE N.
+;;
+;; FONT-TYPE is 0, 1, 2, or 3 representing normal, bold, italic, and
+;; bold-italic respectively.
+;;
+;; FONT-SPEC-TABLE is a char-table of FONT-SPECs. It records which
+;; character is printed by which FONT-SPEC. It has one extra slot
+;; whose value is an alist of the form:
+;; (CHARSET . FONT-SPEC)
+;; FONT-SPEC is a vecotr of the form:
+;; (ID FONT-SRC FONT-NAME ENCODING EXTRA)
+(defvar ps-mule-font-spec-tables nil)
+
+;; Array of FONT-TYPEs; Nth element FONT-NUMBER N.
+;;
+;; FONT-NUMBER is 0, 1, 2, 3, 4, 5, 6 representing fonts f0, f1, f2,
+;; f3, h0, h1, and H0.
+(defconst ps-mule-font-number-to-type [ 0 1 2 3 1 0 0 ])
+
+(defsubst ps-mule-get-font-spec (char font-spec-table font-spec)
+ "Return a font spec for printing CHAR with FONT-SPEC-TABLE.
+
+FONT-SPEC, if non-nil, is a font spec to try at first.
+
+See the documentation of `ps-mule-font-spec-tables' for the
+format of font spec."
+
+ (or (aref font-spec-table char)
+ (aset font-spec-table char
+ (or (and (< char 256)
+ (cdr (car (char-table-extra-slot font-spec-table 0))))
+ (and font-spec
+ (encode-char char (ps-mule-font-spec-charset font-spec))
+ font-spec)
+ (catch 'tag
+ (dolist (elt (char-table-extra-slot font-spec-table 0))
+ (and (encode-char char (car elt))
+ (throw 'tag (cdr elt)))))
+ ;; Record that no font-spec exist for CHAR.
+ t))))
(defconst ps-mule-external-libraries
- '((builtin nil nil
+ '((builtin nil nil nil
nil nil nil)
- (bdf ps-bdf nil
- bdf-generate-prologue bdf-generate-font bdf-generate-glyphs)
- (pcf nil nil
- pcf-generate-prologue pcf-generate-font pcf-generate-glyphs)
- (vflib nil nil
- vflib-generate-prologue vflib-generate-font vflib-generate-glyphs))
+ (bdf ps-bdf nil bdf-generate-prologue
+ bdf-check-font bdf-generate-font bdf-generate-glyph)
+ (pcf nil nil pcf-generate-prologue
+ pcf-check-font pcf-generate-font pcf-generate-glyph)
+ (vflib nil nil vflib-generate-prologue
+ vflib-check-font vflib-generate-font vflib-generate-glyphs))
"Alist of external libraries information to support PostScript printing.
Each element has the form:
- (FONT-SRC FEATURE INITIALIZED-P
- PROLOGUE-FUNC FONT-FUNC GLYPHS-FUNC)
+ (FONT-SRC FEATURE INITIALIZED-P PROLOGUE-FUNC
+ CHECK-FUNC FONT-FUNC GLYPH-FUNC)
FONT-SRC is the font source: builtin, bdf, pcf, or vflib.
PostScript procedures that will be called by FONT-FUNC and GLYPHS-FUNC. It is
called with no argument, and should return a list of strings.
+CHECK-FUNC is a function to check if a font is available or not.
+It is called with one argument FONT-SPEC, and should return non-nil iff the
+font specified in FONT-SPEC is available.
+
FONT-FUNC is a function to generate PostScript code which define a new font.
It is called with one argument FONT-SPEC, and should return a list of strings.
-GLYPHS-FUNC is a function to generate PostScript code which define glyphs of
-characters. It is called with three arguments FONT-SPEC, CODE-LIST, and BYTES,
-and should return a list of strings.")
-
-(defun ps-mule-init-external-library (font-spec)
- "Initialize external library specified by FONT-SPEC for PostScript printing.
-See the documentation of `ps-mule-get-font-spec' for FONT-SPEC's meaning."
- (let* ((font-src (ps-mule-font-spec-src font-spec))
- (slot (assq font-src ps-mule-external-libraries)))
+GLYPH-FUNC is a function to generate PostScript code which define glyphs of
+characters. It is called with two arguments FONT-SPEC and CODE, and should
+return a list of strings.")
+
+(defsubst ps-mule-exlib-feature (exlib) (nth 1 exlib))
+(defsubst ps-mule-exlib-initialized-p (exlib) (nth 2 exlib))
+(defsubst ps-mule-exlib-set-initialized-p (exlib val)
+ (setcar (nthcdr 2 exlib) val))
+(defsubst ps-mule-exlib-prologue (exlib) (nth 3 exlib))
+(defsubst ps-mule-exlib-check (exlib) (nth 4 exlib))
+(defsubst ps-mule-exlib-font (exlib) (nth 5 exlib))
+(defsubst ps-mule-exlib-glyph (exlib) (nth 6 exlib))
+
+(defun ps-mule-init-external-library (exlib)
+ "Initialize external library specified by EXLIB for PostScript printing.
+See the documentation of `ps-mule-external-libraries' for EXLIB's meaning."
+ (or (ps-mule-exlib-initialized-p exlib)
+ (let ((prologue-func (ps-mule-exlib-prologue exlib)))
+ (if prologue-func
+ (let ((feature (ps-mule-exlib-feature exlib)))
+ (if feature
+ (require feature))
+ (ps-output-prologue (funcall prologue-func))))
+ (ps-mule-exlib-set-initialized-p exlib t))))
+
+(defvar ps-mule-output-list nil)
+
+(defun ps-mule-check-font (font-spec)
+ "Check if a font specified in FONT-SPEC is available or not."
+ (let ((font-src (ps-mule-font-spec-src font-spec)))
(or (not font-src)
- (nth 2 slot)
- (let ((func (nth 3 slot)))
- (if func
- (progn
- (require (nth 1 slot))
- (ps-output-prologue (funcall func))))
- (setcar (nthcdr 2 slot) t)))))
-
-;; Cached glyph information of fonts, alist of:
-;; (FONT-NAME ((FONT-TYPE-NUMBER . SCALED-FONT-NAME) ...)
-;; cache CODE0 CODE1 ...)
-(defvar ps-mule-font-cache nil)
-
-(defun ps-mule-generate-font (font-spec charset &optional header-p)
- "Generate PostScript codes to define a new font in FONT-SPEC for CHARSET.
-
-If optional 3rd arg HEADER-P is non-nil, generate codes to define a header
-font."
- (let* ((font-name (ps-mule-font-spec-name font-spec))
- (font-name (if (consp font-name) (car font-name) font-name))
- (font-cache (assoc font-name ps-mule-font-cache))
- (font-src (ps-mule-font-spec-src font-spec))
- (func (nth 4 (assq font-src ps-mule-external-libraries)))
- (font-size (if header-p (if (eq ps-current-font 0)
- ps-header-title-font-size-internal
- ps-header-font-size-internal)
- ps-font-size-internal))
- (current-font (+ ps-current-font (if header-p 10 0)))
- (scaled-font-name
- (cond (header-p
- (format "h%d" ps-current-font))
- ((eq charset 'ascii)
- (format "f%d" ps-current-font))
- (t
- (format "f%02x-%d" (charset-id charset) ps-current-font)))))
- (and func (not font-cache)
- (ps-output-prologue (funcall func charset font-spec)))
- (ps-output-prologue
- (list (format "/%s %f /%s Def%sFontMule\n"
- scaled-font-name font-size font-name
- (if (or header-p
- (eq ps-mule-current-charset 'ascii))
- "Ascii" ""))))
- (if font-cache
- (setcar (cdr font-cache)
- (cons (cons current-font scaled-font-name)
- (nth 1 font-cache)))
- (setq font-cache (list font-name
- (list (cons current-font scaled-font-name))
- 'cache)
- ps-mule-font-cache (cons font-cache ps-mule-font-cache)))
- font-cache))
-
-(defun ps-mule-generate-glyphs (font-spec code-list)
- "Generate PostScript codes which generate glyphs for CODE-LIST of FONT-SPEC."
- (let* ((font-src (ps-mule-font-spec-src font-spec))
- (func (nth 5 (assq font-src ps-mule-external-libraries))))
- (and func
- (ps-output-prologue
- (funcall func font-spec code-list
- (ps-mule-font-spec-bytes font-spec))))))
-
-(defun ps-mule-prepare-font (font-spec string charset
- &optional no-setfont header-p)
- "Generate PostScript codes to print STRING of CHARSET by font FONT-SPEC.
-
-The generated code is inserted on prologue part except the code that sets the
-current font (using PostScript procedure `FM').
-
-If optional 4th arg NO-SETFONT is non-nil, don't generate the code for setting
-the current font.
-
-If optional 5th arg HEADER-P is non-nil, generate a code for setting a header
-font."
- (let* ((font-name (ps-mule-font-spec-name font-spec))
- (font-name (if (consp font-name) (car font-name) font-name))
- (current-font (+ ps-current-font (if header-p 10 0)))
- (font-cache (assoc font-name ps-mule-font-cache)))
- (or (and font-cache (assq current-font (nth 1 font-cache)))
- (setq font-cache (ps-mule-generate-font font-spec charset header-p)))
- (or no-setfont
- (let ((new-font (cdr (assq current-font (nth 1 font-cache)))))
- (or (equal new-font ps-last-font)
- (progn
- (ps-output (format "/%s FM\n" new-font))
- (setq ps-last-font new-font)))))
- (if (nth 5 (assq (ps-mule-font-spec-src font-spec)
- ps-mule-external-libraries))
- ;; We have to generate PostScript codes which define glyphs.
- (let* ((cached-codes (nthcdr 2 font-cache))
- (bytes (ps-mule-font-spec-bytes font-spec))
- (len (length string))
- (i 0)
- newcodes code)
- (while (< i len)
- (setq code (if (= bytes 1)
- (aref string i)
- (+ (* (aref string i) 256) (aref string (1+ i)))))
- (or (memq code cached-codes)
- (progn
- (setq newcodes (cons code newcodes))
- (setcdr cached-codes (cons code (cdr cached-codes)))))
- (setq i (+ i bytes)))
- (and newcodes
- (ps-mule-generate-glyphs font-spec newcodes))))))
+ (let ((exlib (assq font-src ps-mule-external-libraries)))
+ (ps-mule-init-external-library exlib)
+ (or (not (ps-mule-exlib-check exlib))
+ (funcall (ps-mule-exlib-check exlib) font-spec))))))
-;;;###autoload
-(defun ps-mule-prepare-ascii-font (string)
- "Setup special ASCII font for STRING.
-STRING should contain only ASCII characters."
- (let ((font-spec
- (ps-mule-get-font-spec
- 'ascii
- (car (nth ps-current-font (ps-font-alist 'ps-font-for-text))))))
- (and font-spec
- (ps-mule-prepare-font font-spec string 'ascii))))
-
-;;;###autoload
-(defun ps-mule-set-ascii-font ()
- (unless (eq ps-mule-current-charset 'ascii)
- (ps-set-font ps-current-font)
- (setq ps-mule-current-charset 'ascii)))
-
-;; List of charsets of multi-byte characters in a text being printed.
-;; If the text doesn't contain any multi-byte characters (i.e. only ASCII),
-;; the value is nil.
-(defvar ps-mule-charset-list nil)
+(defun ps-mule-prepare-font (font-spec)
+ "Generate PostScript codes defining a new font of FONT-SPEC for charset."
+ (let* ((font-src (ps-mule-font-spec-src font-spec))
+ (exlib (assq font-src ps-mule-external-libraries))
+ (id (ps-mule-font-spec-id font-spec))
+ (ftag (format "%02X" id))
+ (font-func (ps-mule-exlib-font exlib))
+ output-list)
+ (if font-func
+ (setq output-list (funcall font-func font-spec))
+ (setq output-list
+ (format "/F%s /%s findfont def\n"
+ ftag (or (ps-mule-font-spec-name font-spec) "Courier")))
+ (ps-mule-font-spec-set-extra font-spec t))
+ (and output-list
+ (nconc ps-mule-output-list (list output-list)))))
+
+(defun ps-mule-prepare-glyph (char font-spec)
+ "Generate PostScript codes to print CHAR by FONT-SPEC.
+
+If CHAR is a cons (FROM TO), generate codes for characters
+specified by the character code range FROM and TO.
+
+The generated code is inserted on prologue part."
+ (if (vectorp font-spec)
+ (progn
+ (or (ps-mule-font-spec-extra font-spec)
+ (ps-mule-prepare-font font-spec))
+ (let ((glyph-func (ps-mule-exlib-glyph
+ (assq (ps-mule-font-spec-src font-spec)
+ ps-mule-external-libraries))))
+ (if glyph-func
+ (let (from to output-list)
+ (if (consp char)
+ (setq from (car char) to (cdr char))
+ (setq from char to char))
+ (while (<= from to)
+ (setq output-list
+ (funcall glyph-func font-spec from))
+ (and output-list
+ (ps-output-prologue output-list))
+ (setq from (1+ from)))))))))
;; This is a PostScript code inserted in the header of generated PostScript.
(defconst ps-mule-prologue
"%%%% Start of Mule Section
-%% Working dictionary for general use.
-/MuleDict 10 dict def
-
-%% Adjust /RelativeCompose properly by checking /BaselineOffset.
-/AdjustRelativeCompose { % fontdict |- fontdict
- dup length 2 add dict begin
- { 1 index /FID ne { def } { pop pop } ifelse } forall
- currentdict /BaselineOffset known {
- BaselineOffset false eq { /BaselineOffset 0 def } if
- } {
- /BaselineOffset 0 def
- } ifelse
- currentdict /RelativeCompose known not {
- /RelativeCompose [ 0 0.1 ] def
- } {
- RelativeCompose false ne {
- [ BaselineOffset RelativeCompose BaselineOffset add
- [ FontMatrix { FontSize div } forall ] transform ]
- /RelativeCompose exch def
- } if
- } ifelse
- currentdict
- end
-} def
-
-%% Define already scaled font for non-ASCII character sets.
-/DefFontMule { % fontname size basefont |- --
- findfont exch scalefont AdjustRelativeCompose definefont pop
+/Latin1Encoding { % newname fontname | font
+ findfont dup length dict begin
+ { 1 index /FID ne { def } { pop pop } ifelse } forall
+ /Encoding ISOLatin1Encoding def
+ currentdict
+ end
+ definefont
} bind def
-%% Define already scaled font for ASCII character sets.
-/DefAsciiFontMule { % fontname size basefont |-
- MuleDict begin
- findfont dup /Encoding get /ISOLatin1Encoding exch def
- exch scalefont AdjustRelativeCompose reencodeFontISO
- end
-} def
-
-/CurrentFont false def
-
-%% Set the specified font to use.
-%% For non-ASCII font, don't install Ascent, etc.
-/FM { % fontname |- --
- /font exch def
- font /f0 eq font /f1 eq font /f2 eq font /f3 eq or or or {
- font F
- } {
- font findfont setfont
- } ifelse
+%% Redefine fonts for multiple charsets.
+/ReDefFont { % fontname encoding fdepvector size | -
+ 20 dict begin
+ 3 index findfont {
+ 1 index /FID ne 2 index /UniqueID ne and {def} {pop pop} ifelse
+ } forall
+ /FontType 0 def
+ /FMapType 3 def
+ /EscChar 0 def
+ % FontMatrix ::= [ size 0 0 size 0 0 ]
+ /FontMatrix exch [ exch dup 0 exch 0 exch 0 0 ] def
+ /FDepVector exch def
+ /Encoding exch def
+ currentdict
+ end % fontname dic
+ definefont pop
} bind def
-
-%% Show vacant box for characters which don't have appropriate font.
-/SB { % count column |- --
- SpaceWidth mul /w exch def
- 1 exch 1 exch { %for
- pop
- gsave
- 0 setlinewidth
- 0 Descent rmoveto w 0 rlineto
- 0 LineHeight rlineto w neg 0 rlineto closepath stroke
- grestore
- w 0 rmoveto
- } for
-} bind def
-
-%% Flag to tell if we are now handling a composition. This is
-%% defined here because both composition handler and bitmap font
-%% handler require it.
-/Composing false def
-
-%%%% End of Mule Section
-
"
"PostScript code for printing multi-byte characters.")
(defvar ps-mule-prologue-generated nil)
+;; EscChar used in generated composite fonts.
+(defconst ps-mule-esc-char 0)
+
(defun ps-mule-prologue-generated ()
(unless ps-mule-prologue-generated
(ps-output-prologue ps-mule-prologue)
+ (ps-output-prologue
+ (format "\n/EscChar %d def\n\n%%%% End of Mule Section\n\n"
+ ps-mule-esc-char))
(setq ps-mule-prologue-generated t)))
-(defun ps-mule-find-wrappoint (from to char-width &optional composition)
- "Find the longest sequence which is printable in the current line.
-
-The search starts at FROM and goes until TO.
-
-Optional 4th arg COMPOSITION, if non-nil, is information of
-composition starting at FROM.
-
-If COMPOSITION is nil, it is assumed that all characters between FROM
-and TO belong to a charset in `ps-mule-current-charset'. Otherwise,
-it is assumed that all characters between FROM and TO belong to the
-same composition.
-
-CHAR-WIDTH is the average width of ASCII characters in the current font.
-
-Returns the value:
+(defun ps-mule-encode-region (from to font-spec-table)
+ "Generate PostScript code for plotting characters in the region FROM and TO.
- (ENDPOS . RUN-WIDTH)
+FONT-SPEC-TABLE is 0, 1, 2, 3, 4, 5, or 6, each represents font tags f0, f1,
+f2, f3, h0, h1, and H0 respectively."
+ (let* ((font-spec nil)
+ (font-id 0)
+ (string-list nil)
+ ;; At most 4-byte (EscChar FONT-ID CODE1 CODE2) per character.
+ (str (make-string (* (- to from) 4) 0))
+ (i 0))
+ (goto-char from)
+ (while (< (point) to)
+ (let* ((char (following-char))
+ (this-spec (ps-mule-get-font-spec char font-spec-table font-spec))
+ this-id)
+ (if (vectorp this-spec)
+ (setq this-id (ps-mule-font-spec-font-id this-spec))
+ ;; Can't print CHAR. Replace it with '?'.
+ (setq char ??
+ this-spec (ps-mule-get-font-spec char font-spec-table nil)
+ this-id (ps-mule-font-spec-font-id this-spec)))
+ (or (= font-id this-id)
+ (progn
+ (if font-spec
+ (setq string-list (cons (substring str 0 i) string-list)
+ i 0))
+ (setq font-id this-id)
+ (or (= font-id 0)
+ (progn
+ (aset str i ps-mule-esc-char)
+ (setq i (1+ i))
+ (aset str i font-id)
+ (setq i (1+ i))))))
+ (setq font-spec this-spec)
+ (if (< char 128)
+ (aset str i char)
+ (let* ((code (ps-mule-encode-char char font-spec)))
+ (if (= (ps-mule-font-spec-bytes font-spec) 1)
+ (aset str i code)
+ (aset str i (/ code 256))
+ (setq i (1+ i))
+ (aset str i (% code 256)))))
+ (setq i (1+ i))
+ (forward-char 1)))
+ (nreverse (cons (substring str 0 i) string-list))))
+
+(defun ps-mule-plot-composition (composition font-spec-table)
+ "Generate PostScript code for plotting COMPOSITION with FONT-SPEC-TABLE."
+ (ps-output "[")
+ (let ((components (copy-sequence (nth 2 composition)))
+ (font-spec nil))
+ (dotimes (i (length components))
+ (let ((elt (aref components i))
+ this-spec)
+ (if (consp elt)
+ ;; ELT is a composition rule.
+ (ps-output (format " %d" (encode-composition-rule elt)))
+ ;; ELT is a glyph character.
+ (setq this-spec
+ (ps-mule-get-font-spec elt font-spec-table font-spec))
+ (or (vectorp this-spec)
+ ;; Can't print CHAR. Replace it with '?'.
+ (setq elt ??
+ this-spec
+ (ps-mule-get-font-spec elt font-spec-table font-spec)))
+ (setq font-spec this-spec)
+ (let* ((bytes (ps-mule-font-spec-bytes font-spec))
+ (code (ps-mule-encode-char elt font-spec))
+ (font-id (ps-mule-font-spec-font-id font-spec))
+ (str (make-string (if (= font-id 0) 1 (+ 2 bytes)) 0)))
+ (if (= font-id 0)
+ (aset str 0 code)
+ (aset str 0 ps-mule-esc-char)
+ (aset str 1 font-id)
+ (if (= bytes 1)
+ (aset str 2 code)
+ (aset str 2 (/ code 256))
+ (aset str 3 (% code 256))))
+ (ps-output "[")
+ (ps-output-string str)
+ (ps-output (if (eq (ps-mule-font-spec-src font-spec) 'bdf)
+ (format "/C%02X-%X" (ps-mule-font-spec-id font-spec)
+ elt)
+ "false"))
+ (ps-output "]"))))))
+ (ps-output " ] " (if (nth 3 composition) "RLC" "RBC") "\n"))
-Where ENDPOS is the end position of the sequence and RUN-WIDTH is the width of
-the sequence."
- (if (or composition (eq ps-mule-current-charset 'composition))
- ;; We must draw one char by one.
- (let ((run-width (if composition
- (nth 5 composition)
- (* (char-width (char-after from)) char-width))))
- (if (> run-width ps-width-remaining)
- (cons from ps-width-remaining)
- (cons (if composition
- (nth 1 composition)
- (1+ from))
- run-width)))
- ;; We assume that all characters in this range have the same width.
- (setq char-width (* char-width (charset-width ps-mule-current-charset)))
- (let ((run-width (* (abs (- from to)) char-width)))
- (if (> run-width ps-width-remaining)
- (cons (min to
- (save-excursion
- (goto-char from)
- (forward-point
- (truncate (/ ps-width-remaining char-width)))))
- ps-width-remaining)
- (cons to run-width)))))
-
-;;;###autoload
(defun ps-mule-plot-string (from to &optional bg-color)
"Generate PostScript code for plotting characters in the region FROM and TO.
-It is assumed that all characters in this region belong to the same charset.
-
-Optional argument BG-COLOR specifies background color.
-
-Returns the value:
-
- (ENDPOS . RUN-WIDTH)
-
-Where ENDPOS is the end position of the sequence and RUN-WIDTH is the width of
-the sequence."
- (let ((ch (char-after from)))
- (setq ps-mule-current-charset
- (char-charset (or (aref ps-print-translation-table ch) ch))))
- (let* ((wrappoint (ps-mule-find-wrappoint
- from to (ps-avg-char-width 'ps-font-for-text)))
- (to (car wrappoint))
- (font-type (car (nth ps-current-font
- (ps-font-alist 'ps-font-for-text))))
- (font-spec (ps-mule-get-font-spec ps-mule-current-charset font-type))
- (string (buffer-substring-no-properties from to)))
- (dotimes (i (length string))
- (let ((ch (aref ps-print-translation-table (aref string i))))
- (if ch
- (aset string i ch))))
- (cond
- ((= from to)
- ;; We can't print any more characters in the current line.
- nil)
-
- (font-spec
- ;; We surely have a font for printing this character set.
- (ps-output-string (ps-mule-string-encoding font-spec string))
- (ps-output " S\n"))
-
- ((eq ps-mule-current-charset 'latin-iso8859-1)
- ;; Latin-1 can be printed by a normal ASCII font.
- (ps-output-string (ps-mule-string-ascii string))
- (ps-output " S\n"))
-
- ;; This case is obsolete for Emacs 21.
- ((eq ps-mule-current-charset 'composition)
- (ps-mule-plot-composition from (1+ from) bg-color))
-
- (t
- ;; No way to print this charset. Just show a vacant box of an
- ;; appropriate width.
- (ps-output (format "%d %d SB\n"
- (length string)
- (if (eq ps-mule-current-charset 'composition)
- (char-width (char-after from))
- (charset-width ps-mule-current-charset))))))
- wrappoint))
-
-;;;###autoload
-(defun ps-mule-plot-composition (from to &optional bg-color)
- "Generate PostScript code for plotting composition in the region FROM and TO.
-
-It is assumed that all characters in this region belong to the same
-composition.
-
-Optional argument BG-COLOR specifies background color.
+Optional argument BG-COLOR is ignored.
Returns the value:
Where ENDPOS is the end position of the sequence and RUN-WIDTH is the width of
the sequence."
- (let* ((composition (find-composition from nil nil t))
- (wrappoint (ps-mule-find-wrappoint
- from to (ps-avg-char-width 'ps-font-for-text)
- composition))
- (to (car wrappoint))
- (font-type (car (nth ps-current-font
- (ps-font-alist 'ps-font-for-text)))))
- (if (< from to)
- ;; We can print this composition in the current line.
- (let ((components (nth 2 composition)))
- (ps-mule-plot-components
- (ps-mule-prepare-font-for-components components font-type)
- (if (nth 3 composition) "RLC" "RBC"))))
- wrappoint))
-
-;; Prepare font of FONT-TYPE for printing COMPONENTS. By side effect,
-;; change character elements in COMPONENTS to the form:
-;; ENCODED-STRING or (FONTNAME . ENCODED-STRING)
-;; and change rule elements to the encoded value (integer).
-;; The latter form is used if we much change font for the character.
-
-(defun ps-mule-prepare-font-for-components (components font-type)
- (dotimes (i (length components))
- (let ((elt (aref components i)))
- (if (consp elt)
- ;; ELT is a composition rule.
- (setq elt (encode-composition-rule elt))
- ;; ELT is a glyph character.
- (let* ((charset (char-charset elt))
- (font (or (eq charset ps-mule-current-charset)
- (if (eq charset 'ascii)
- (format "/f%d" ps-current-font)
- (format "/f%02x-%d"
- (charset-id charset) ps-current-font))))
- str)
- (setq ps-mule-current-charset charset
- str (ps-mule-string-encoding
- (ps-mule-get-font-spec charset font-type)
- (char-to-string elt)
- 'no-setfont))
- (if (stringp font)
- (setq elt (cons font str) ps-last-font font)
- (setq elt str))))
- (aset components i elt)))
- components)
-
-(defun ps-mule-plot-components (components tail)
- (let ((elt (aref components 0))
- (len (length components))
- (i 1))
- (ps-output "[ ")
- (if (stringp elt)
- (ps-output-string elt)
- (ps-output (car elt) " ")
- (ps-output-string (cdr elt)))
- (while (< i len)
- (setq elt (aref components i) i (1+ i))
- (ps-output " ")
- (cond ((stringp elt)
- (ps-output-string elt))
- ((consp elt)
- (ps-output (car elt) " ")
- (ps-output-string (cdr elt)))
- (t ; i.e. (integerp elt)
- (ps-output (format "%d" elt)))))
- (ps-output " ] " tail "\n")))
-
-;; Composite font support
+ (let* ((average-width (ps-avg-char-width 'ps-font-for-text))
+ (point (point))
+ (composition (find-composition from to nil t))
+ (stop (if composition (car composition) to))
+ (ascii-or-latin-1 "[\000-\377]+")
+ (run-width 0)
+ (endpos nil)
+ (font-spec-table (aref ps-mule-font-spec-tables
+ (aref ps-mule-font-number-to-type
+ ps-current-font)))
+ width)
+ (goto-char from)
+ (while (not endpos)
+ (cond ((= (point) stop)
+ (if (= stop to)
+ (setq endpos stop)
+ (if (< from stop)
+ (dolist (l (ps-mule-encode-region from (point)
+ font-spec-table))
+ (ps-output-string l)
+ (ps-output " S\n")))
+ (setq width (* (nth 5 composition) average-width))
+ (if (< ps-width-remaining (+ run-width width))
+ (setq endpos stop)
+ (ps-mule-plot-composition composition font-spec-table)
+ (setq run-width (+ run-width width)
+ from (nth 1 composition))
+ (goto-char from)
+ (setq composition (find-composition (point) to nil t))
+ (setq stop (if composition (car composition) to)))))
+
+ ((looking-at ascii-or-latin-1)
+ (let ((nchars (- (min (match-end 0) stop) (point))))
+ (setq width (* average-width nchars))
+ (if (< ps-width-remaining (+ run-width width))
+ (setq nchars (truncate (- ps-width-remaining run-width)
+ average-width)
+ run-width (+ run-width (* nchars average-width))
+ endpos (+ (point) nchars))
+ (setq run-width (+ run-width width))
+ (forward-char nchars))))
+
+ (t
+ (while (and (< (point) stop) (not endpos))
+ (setq width (char-width (following-char)))
+ (if (< ps-width-remaining (+ run-width width))
+ (setq endpos (point))
+ (setq run-width (+ run-width width))
+ (forward-char 1))))))
+
+ (if (< from endpos)
+ (dolist (l (ps-mule-encode-region from endpos font-spec-table))
+ (ps-output-string l)
+ (ps-output " S\n")))
+ (goto-char point)
+ (cons endpos run-width)))
+
+;; Character composition support
(defvar ps-mule-composition-prologue-generated nil)
(defconst ps-mule-composition-prologue
- "%%%% Character composition handler
+ "%%%% Procedures for character composition.
/RelativeCompositionSkip 0.4 def
%% Get a bounding box (relative to currentpoint) of STR.
-/GetPathBox { % str |- --
- gsave
- currentfont /FontType get 3 eq { %ifelse
- stringwidth pop pop
+/GetPathBox { % [ str cname ] | -
+ dup 1 get dup false ne {
+ BitmapDict exch get /bmp exch def
+ %% bmp ::= [ DWIDTH WIDTH HEIGHT XOFF YOFF BITMAP RELATIVE-COMPOSE]
+ /LLY bmp 4 get def
+ /URY LLY bmp 2 get add def
+ /RelativeCompose bmp 6 get dup false ne {
+ dup LLY le { pop 1 } { URY ge { -1 } { 0 } ifelse } ifelse
+ } {
+ pop 0
+ } ifelse def
+ dup 0 get stringwidth pop dup /WIDTH exch def bmp 0 get div
+ dup LLY mul /LLY exch def
+ URY mul /URY exch def
} {
- currentpoint /y exch def /x exch def
- false charpath flattenpath pathbbox
- y sub /URY exch def x sub /URX exch def
- y sub /LLY exch def x sub /LLX exch def
+ pop
+ dup 0 get stringwidth pop /WIDTH exch def
+ gsave 0 0 moveto
+ dup 0 get false charpath flattenpath pathbbox
+ /URY exch def pop /LLY exch def pop
+ grestore
+ /RelativeCompose 0 def
} ifelse
- grestore
} bind def
-%% Apply effects (underline, strikeout, overline, box) to the
-%% rectangle specified by TOP BOTTOM LEFT RIGHT.
-/SpecialEffect { % -- |- --
+%% Apply effects except for shadow and outline to the rectangle
+%% specified by TOP BOTTOM LEFT RIGHT.
+/SpecialEffect { % -- | --
currentpoint dup TOP add /yy exch def BOTTOM add /YY exch def
dup LEFT add /xx exch def RIGHT add /XX exch def
%% Adjust positions for future shadowing.
Effect 16 and 0 ne { false 0 doBox } if % box
} def
-%% Show STR with effects (shadow, outline).
-/ShowWithEffect { % str |- --
- Effect 8 and 0 ne { dup doShadow } if
- Effect 32 and 0 ne { true doOutline } { show } ifelse
-} def
-
-%% Draw COMPONENTS which have the form [ font0? [str0 xoff0 yoff0] ... ].
-/ShowComponents { % components |- -
- LEFT 0 lt { LEFT neg 0 rmoveto } if
- {
- dup type /nametype eq { % font
- FM
- } { % [ str xoff yoff ]
- gsave
- aload pop rmoveto ShowWithEffect
- grestore
- } ifelse
+%% Draw COMPONENTS which has the form [ [str0 xoff0 yoff0] ... ] with
+%% effects shadow and outline.
+/ShowComponents { % components | -
+ gsave
+ { gsave aload pop rmoveto
+ Effect 8 and 0 ne { dup doShadow } if
+ Effect 32 and 0 ne { true doOutline } { show } ifelse
+ grestore
} forall
+ grestore
RIGHT 0 rmoveto
} def
%% Show relative composition.
-/RLC { % [ font0? str0 font1? str1 ... fontN? strN ] |- --
+/RLC { % [[str0 cname0] [str1 cname1] ... [strN cnameN]] | -
/components exch def
- /Composing true def
- /first true def
- gsave
- [ components {
- /elt exch def
- elt type /nametype eq { % font
- elt dup FM
- } { first { % first string
- /first false def
- elt GetPathBox
- %% Bounding box of overall glyphs.
- /LEFT LLX def
- /RIGHT URX def
- /TOP URY def
- /BOTTOM LLY def
- currentfont /RelativeCompose known {
- /relative currentfont /RelativeCompose get def
- relative false eq {
- %% Disable relative composition by setting sufficiently low
- %% and high positions.
- /relative [ -100000 100000 ] def
- } if
+ [ % push [str xoff yoff] one by one
+ [ components 0 get GetPathBox aload pop pop 0 0 ]
+ %% Bounding box of overall glyphs.
+ /LEFT 0 def
+ /RIGHT WIDTH def
+ /TOP URY def
+ /BOTTOM LLY def
+
+ 1 1 components length 1 sub {
+ components exch get
+ [ exch
+ GetPathBox
+ aload pop pop % str
+ 0 % xoff
+ RelativeCompose 1 eq { % compose on TOP
+ TOP LLY sub RelativeCompositionSkip add % yoff
+ /TOP TOP URY LLY sub add RelativeCompositionSkip add def
+ } { RelativeCompose -1 eq { % compose under BOTTOM
+ BOTTOM URY sub RelativeCompositionSkip sub % yoff
+ /BOTTOM BOTTOM URY LLY sub sub
+ RelativeCompositionSkip sub def
} {
- /relative [ -100000 100000 ] def
- } ifelse
- [ elt 0 0 ]
- } { % other strings
- elt GetPathBox
- [ elt % str
- LLX 0 lt { RIGHT } { 0 } ifelse % xoff
- LLY relative 1 get ge { % compose on TOP
- TOP LLY sub RelativeCompositionSkip add % yoff
- /TOP TOP URY LLY sub add RelativeCompositionSkip add def
- } { URY relative 0 get le { % compose under BOTTOM
- BOTTOM URY sub RelativeCompositionSkip sub % yoff
- /BOTTOM BOTTOM URY LLY sub sub
- RelativeCompositionSkip sub def
- } {
- 0 % yoff
- URY TOP gt { /TOP URY def } if
- LLY BOTTOM lt { /BOTTOM LLY def } if
- } ifelse } ifelse
- ]
- URX RIGHT gt { /RIGHT URX def } if
- } ifelse } ifelse
- } forall ] /components exch def
- grestore
-
- %% Reflect special effects.
- SpecialEffect
-
- %% Draw components while ignoring effects other than shadow and outline.
- components ShowComponents
- /Composing false def
-
+ 0 % yoff
+ URY TOP gt { /TOP URY def } if
+ LLY BOTTOM lt { /BOTTOM LLY def } if
+ } ifelse } ifelse
+ ]
+ } for
+ ]
+ SpecialEffect % Reflect special effects.
+ ShowComponents % Draw components.
} def
%% Show rule-base composition.
-/RBC { % [ font0? str0 rule1 font1? str1 rule2 ... strN ] |- --
+/RBC { % [[str0 cname0] rule1 [str1 cname0] rule2 ... [strN cnameN]] | -
/components exch def
- /Composing true def
- /first true def
- gsave
- [ components {
- /elt exch def
- elt type /nametype eq { % font
- elt dup FM
- } { elt type /integertype eq { % rule
- %% This RULE decoding should be compatible with macro
+ [ % push [str xoff yoff] one by one
+ [ components 0 get GetPathBox aload pop pop 0 0 ]
+ %% Bounding box of overall glyphs.
+ /LEFT 0 def
+ /RIGHT WIDTH def
+ /TOP URY def
+ /BOTTOM LLY def
+ 1 1 components length 1 sub {
+ components exch get /elt exch def
+ elt type /integertype eq { % rule
+ %% Do the same RULE decoding as the macro
%% COMPOSITION_DECODE_RULE in emacs/src/composite.h.
elt 12 idiv dup 3 mod /grefx exch def 3 idiv /grefy exch def
elt 12 mod dup 3 mod /nrefx exch def 3 idiv /nrefy exch def
- } { first { % first string
- /first false def
- elt GetPathBox
- %% Bounding box of overall glyphs.
- /LEFT LLX def
- /RIGHT URX def
- /TOP URY def
- /BOTTOM LLY def
- /WIDTH RIGHT LEFT sub def
- [ elt 0 0 ]
} { % other strings
+ [
elt GetPathBox
- /width URX LLX sub def
+ aload pop pop
/height URY LLY sub def
- /left LEFT [ 0 WIDTH 2 div WIDTH ] grefx get add
- [ 0 width 2 div width ] nrefx get sub def
+ /left LEFT [ 0 RIGHT LEFT sub dup 2 div exch ] grefx get add
+ [ 0 WIDTH 2 div WIDTH ] nrefx get sub def
/bottom [ TOP 0 BOTTOM TOP BOTTOM add 2 div ] grefy get
[ height LLY neg 0 height 2 div ] nrefy get sub def
%% Update bounding box
left LEFT lt { /LEFT left def } if
- left width add RIGHT gt { /RIGHT left width add def } if
- /WIDTH RIGHT LEFT sub def
+ left WIDTH add RIGHT gt { /RIGHT left WIDTH add def } if
bottom BOTTOM lt { /BOTTOM bottom def } if
bottom height add TOP gt { /TOP bottom height add def } if
- [ elt left LLX sub bottom LLY sub ]
- } ifelse } ifelse } ifelse
- } forall ] /components exch def
- grestore
-
- %% Reflect special effects.
- SpecialEffect
+ left bottom LLY sub ]
+ } ifelse
+ } for
+ ]
- %% Draw components while ignoring effects other than shadow and outline.
- components ShowComponents
+ LEFT 0 lt { % Adjust xoff to the right.
+ dup { dup 1 get LEFT sub 1 exch put } forall
+ /RIGHT RIGHT LEFT sub def
+ } if
- /Composing false def
+ SpecialEffect % Reflect special effects.
+ ShowComponents % Draw components.
} def
-%%%% End of character composition handler
+%%%% End of procedures for character composition
"
"PostScript code for printing character composition.")
-(defun ps-mule-string-ascii (str)
- (ps-set-font ps-current-font)
- (string-as-unibyte (encode-coding-string str 'iso-latin-1)))
-
-;; Encode STR for a font specified by FONT-SPEC and return the result.
-;; If necessary, it generates the PostScript code for the font and glyphs to
-;; print STR. If optional 4th arg HEADER-P is non-nil, it is assumed that STR
-;; is for headers.
-(defun ps-mule-string-encoding (font-spec str &optional no-setfont header-p)
- (let ((encoding (ps-mule-font-spec-encoding font-spec)))
- (setq str
- (string-as-unibyte
- (cond ((coding-system-p encoding)
- (encode-coding-string str encoding))
- ((functionp encoding)
- (funcall encoding str))
- (encoding
- (error "Invalid coding system or function: %s" encoding))
- (t
- str))))
- (if (ps-mule-font-spec-src font-spec)
- (ps-mule-prepare-font font-spec str ps-mule-current-charset
- (or no-setfont header-p)
- header-p)
- (or no-setfont
- (ps-set-font ps-current-font)))
- str))
+(defun ps-mule-composition-prologue-generated ()
+ (unless ps-mule-composition-prologue-generated
+ (ps-mule-prologue-generated)
+ (ps-output-prologue ps-mule-composition-prologue)
+ (setq ps-mule-composition-prologue-generated t)))
;; Bitmap font support
(defvar ps-mule-bitmap-prologue-generated nil)
(defconst ps-mule-bitmap-prologue
- "%%%% Bitmap font handler
-
-/str7 7 string def % working area
-
-%% We grow the dictionary one bunch (1024 entries) by one.
-/BitmapDictArray 256 array def
-/BitmapDictLength 1024 def
-/BitmapDictIndex -1 def
-
-/NewBitmapDict { % -- |- --
- /BitmapDictIndex BitmapDictIndex 1 add def
- BitmapDictArray BitmapDictIndex BitmapDictLength dict put
-} bind def
-
-%% Make at least one dictionary.
-NewBitmapDict
+ "%%%% Procedures for bitmap fonts.
-/AddBitmap { % gloval-charname bitmap-data |- --
- BitmapDictArray BitmapDictIndex get
- dup length BitmapDictLength ge {
- pop
- NewBitmapDict
- BitmapDictArray BitmapDictIndex get
- } if
- 3 1 roll put
-} bind def
-
-/GetBitmap { % gloval-charname |- bitmap-data
- 0 1 BitmapDictIndex { BitmapDictArray exch get begin } for
- load
- 0 1 BitmapDictIndex { pop end } for
-} bind def
-
-%% Return a global character name which can be used as a key in the
-%% bitmap dictionary.
-/GlobalCharName { % fontidx code1 code2 |- gloval-charname
- exch 256 mul add exch 65536 mul add 16777216 add 16 str7 cvrs 0 66 put
- str7 cvn
-} bind def
-
-%% Character code holder for a 2-byte character.
-/FirstCode -1 def
-
-%% Glyph rendering procedure
-/BuildGlyphCommon { % fontdict charname |- --
- 1 index /FontDimension get 1 eq { /FirstCode 0 store } if
- NameIndexDict exch get % STACK: fontdict charcode
- FirstCode 0 lt { %ifelse
- %% This is the first byte of a 2-byte character. Just
- %% remember it for the moment.
- /FirstCode exch store
- pop
- 0 0 setcharwidth
- } {
- 1 index /FontSize get /size exch def
- 1 index /FontSpaceWidthRatio get /ratio exch def
- 1 index /FontIndex get exch FirstCode exch
- GlobalCharName GetBitmap /bmp exch def
- %% bmp == [ DWIDTH BBX-WIDTH BBX-HEIGHT BBX-XOFF BBX-YOFF BITMAP ]
- Composing { %ifelse
- /FontMatrix get [ exch { size div } forall ] /mtrx exch def
- bmp 3 get bmp 4 get mtrx transform
- /LLY exch def /LLX exch def
- bmp 1 get bmp 3 get add bmp 2 get bmp 4 get add mtrx transform
- /URY exch def /URX exch def
- } {
- pop
- } ifelse
- /FirstCode -1 store
-
- bmp 0 get size div 0 % wx wy
- setcharwidth % We can't use setcachedevice here.
-
- bmp 1 get 0 gt bmp 2 get 0 gt and {
- bmp 1 get bmp 2 get % width height
- true % polarity
- [ size 0 0 size neg bmp 3 get neg bmp 2 get bmp 4 get add ] % matrix
- bmp 5 1 getinterval cvx % datasrc
- imagemask
- } if
- } ifelse
-} bind def
-
-/BuildCharCommon {
- 1 index /Encoding get exch get
- 1 index /BuildGlyph get exec
-} bind def
-
-%% Bitmap font creator
-
-%% Common Encoding shared by all bitmap fonts.
-/EncodingCommon 256 array def
-%% Mapping table from character name to character code.
-/NameIndexDict 256 dict def
-0 1 255 { %for
- /idx exch def
- /idxname idx 256 add 16 (XXX) cvrs dup 0 67 put cvn def % `C' == 67
- EncodingCommon idx idxname put
- NameIndexDict idxname idx put
-} for
-
-/GlobalFontIndex 0 def
-
-%% fontname dim col fontsize relative-compose baseline-offset fbbx |- --
-/BitmapFont {
- 15 dict begin
- /FontBBox exch def
+%% Create a base bitmap font.
+/NBF { % fontname fontsize relative-compose baseline-offset enc | --
+ 11 dict begin
+ /FontType 3 def
+ /FontMatrix matrix def
+ /FontBBox [ 0 0 0 0 ] def
+ /Encoding exch def
/BaselineOffset exch def
/RelativeCompose exch def
/FontSize exch def
- /FontBBox [ FontBBox { FontSize div } forall ] def
- FontBBox 2 get FontBBox 0 get sub exch div
- /FontSpaceWidthRatio exch def
- /FontDimension exch def
- /FontIndex GlobalFontIndex def
- /FontType 3 def
- /FontMatrix matrix def
- /Encoding EncodingCommon def
- /BuildGlyph { BuildGlyphCommon } def
- /BuildChar { BuildCharCommon } def
- currentdict end
- definefont pop
- /GlobalFontIndex GlobalFontIndex 1 add def
-} bind def
-
-%% Define a new bitmap font.
-%% fontname dim col fontsize relative-compose baseline-offset fbbx |- --
-/NF {
- /fbbx exch def
- %% Convert BDF's FontBoundingBox to PostScript's FontBBox
- [ fbbx 2 get fbbx 3 get
- fbbx 2 get fbbx 0 get add fbbx 3 get fbbx 1 get add ]
- BitmapFont
+ /FontMatrix [ 1 FontSize div 0 0 1 FontSize div 0 0 ] def
+ /BuildGlyph { % fontdict charname | -
+ BitmapDict exch get /bmp exch def pop
+ %% bmp ::= [ DWIDTH WIDTH HEIGHT XOFF YOFF BITMAP RELATIVE-COMPOSE ]
+ /llx bmp 3 get def
+ /lly bmp 4 get def
+ /urx llx bmp 1 get add def
+ /ury lly bmp 2 get add def
+ bmp 0 get 0 llx lly urx ury setcachedevice
+ bmp 5 get length 0 gt {
+ llx ury translate
+ bmp 1 get bmp 2 get
+ true [ 1 0 0 -1 0 0 ] { bmp 5 get } imagemask
+ } if
+ } bind def
+ /BuildChar { % fontdict byte | -
+ 1 index /Encoding get exch get
+ 1 index /BuildGlyph get exec
+ } bind def
+ dup currentdict end
+ definefont def
} bind def
-%% Define a glyph for the specified font and character.
-/NG { % fontname charcode bitmap-data |- --
- /bmp exch def
- exch findfont dup /BaselineOffset get bmp 4 get add bmp exch 4 exch put
- /FontIndex get exch
- dup 256 idiv exch 256 mod GlobalCharName
- bmp AddBitmap
+%% Create a parent font of 8/8 mapping.
+/NPF { % fontname encoding fdepvector | -
+ 8 dict begin
+ /FontType 0 def
+ /FMapType 2 def
+ /FontMatrix matrix def
+ /FDepVector exch def
+ /Encoding exch def
+ dup currentdict
+ end
+ definefont def
} bind def
-%%%% End of bitmap font handler
+%%%% End of procedures for bitmap fonts.
")
;; External library support.
+(defvar ps-mule-bitmap-dict-list nil)
+(defvar ps-mule-bitmap-font-record nil)
+
;; The following three functions are to be called from external
;; libraries which support bitmap fonts (e.g. `bdf') to get
;; appropriate PostScript code.
(defun ps-mule-generate-bitmap-prologue ()
(unless ps-mule-bitmap-prologue-generated
- (setq ps-mule-bitmap-prologue-generated t)
+ (setq ps-mule-bitmap-prologue-generated t
+ ps-mule-bitmap-dict-list nil
+ ps-mule-bitmap-font-record (make-vector 1024 nil))
(list ps-mule-bitmap-prologue)))
-(defun ps-mule-generate-bitmap-font (&rest args)
- (list (apply 'format "/%s %d %d %f %S %d %S NF\n" args)))
-
-(defun ps-mule-generate-bitmap-glyph (font-name code dwidth bbx bitmap)
- (format "/%s %d [ %d %d %d %d %d <%s> ] NG\n"
- font-name code
- dwidth (aref bbx 0) (aref bbx 1) (aref bbx 2) (aref bbx 3)
- bitmap))
+(defun ps-mule-generate-bitmap-font (font-spec size relative-compose
+ baselie-offset bbx)
+ (let* ((id (ps-mule-font-spec-id font-spec))
+ (bytes (ps-mule-font-spec-bytes font-spec))
+ output-list)
+ (if (= bytes 1)
+ (setq output-list
+ (list (format "/E%02X [ 0 1 255 {pop /.notdef} for ] def\n" id)
+ (format "%%%% %s\n" (ps-mule-font-spec-name font-spec))
+ (format "/F%02X %f %S %d E%02X NBF\n" id size
+ relative-compose baselie-offset id)))
+ (setq output-list
+ (list (list (format "/E%02X [ 0 1 255 { pop 0 } for ] def\n" id))
+ (list (format "/V%02X [" id))
+ " ] def\n"
+ (format "%%%% %s\n" (ps-mule-font-spec-name font-spec))
+ (format "/F%02X E%02X V%02X NPF\n" id id id))))
+ (aset ps-mule-bitmap-font-record id
+ (vector (= bytes 1) output-list
+ size relative-compose baselie-offset bbx))
+ (if ps-mule-bitmap-dict-list
+ output-list
+ (setq ps-mule-bitmap-dict-list (list "/BitmapDict <<\n" ">> def\n"))
+ (cons ps-mule-bitmap-dict-list output-list))))
+
+(defun ps-mule-generate-bitmap-glyph (font-spec char code bitmap)
+ (let* ((id (ps-mule-font-spec-id font-spec))
+ ;; FONT-RECORD ::= ([(SUBFONT-OUTPUT-LIST ...) | t]
+ ;; BASEFONT-OUTPUT-LIST SIZE REL-COMP B-OFFSET BBX)
+ (font-record (aref ps-mule-bitmap-font-record id))
+ enc-name
+ output-list)
+ (if (listp (aref font-record 0))
+ ;; This is a 2-dimensional font. Create a subfont for this
+ ;; glyph if not yet created.
+ (let* ((high (/ code 256))
+ (id2 (+ (* id 256) high)))
+ (setq output-list (cdr (assq high (aref font-record 0)))
+ code (% code 256))
+ (or output-list
+ ;; We must create a subfont.
+ (let ((enc-list (car (aref font-record 1)))
+ (fdep-list (nth 1 (aref font-record 1))))
+ (setq output-list
+ (list
+ (format "/E%04X [ 0 1 255 {pop /.notdef} for ] def\n"
+ id2)
+ (format "/F%04X %f %S %d E%04X NBF\n"
+ id2 (aref font-record 2) (aref font-record 3)
+ (aref font-record 4) id2)
+ (format "E%02X %d %d put\n"
+ id high (1- (length fdep-list)))))
+ (nconc enc-list (list output-list))
+ (nconc fdep-list (list (format " F%04X" id2)))
+ (aset font-record 0
+ (cons (cons high output-list) (aref font-record 0)))))
+ (setq enc-name (format "%04X" id2)))
+ (setq output-list (aref font-record 1)
+ enc-name (format "%02X" id)))
+ (setcdr ps-mule-bitmap-dict-list
+ (cons (format "/C%02X-%X %s\n" id char bitmap)
+ (cdr ps-mule-bitmap-dict-list)))
+ (setcdr output-list
+ (cons (format "E%s %d /C%02X-%X put\n" enc-name code id char)
+ (cdr output-list))))
+ nil)
;; Mule specific initializers.
;;;###autoload
(defun ps-mule-initialize ()
"Initialize global data for printing multi-byte characters."
- (setq ps-mule-font-cache nil
- ps-mule-prologue-generated nil
+ (setq ps-mule-prologue-generated nil
ps-mule-composition-prologue-generated nil
ps-mule-bitmap-prologue-generated nil)
(mapcar `(lambda (x) (setcar (nthcdr 2 x) nil))
ps-mule-external-libraries))
-(defvar ps-mule-header-charsets nil)
-
-;;;###autoload
(defun ps-mule-encode-header-string (string fonttag)
"Generate PostScript code for ploting STRING by font FONTTAG.
-FONTTAG should be a string \"/h0\" or \"/h1\"."
- (setq string (cond ((not (stringp string))
- "")
- ((multibyte-string-p string)
- (copy-sequence string))
- (t
- (string-make-multibyte string))))
- (when ps-mule-header-charsets
- (if (eq (car ps-mule-header-charsets) 'latin-iso8859-1)
- ;; Latin1 characters can be printed by the standard PostScript
- ;; font. Converts the other non-ASCII characters to `?'.
- (let ((len (length string)))
- (dotimes (i len)
- (or (memq (char-charset (aref string i)) '(ascii latin-iso8859-1))
- (aset string i ??)))
- (setq string (encode-coding-string string 'iso-latin-1)))
- ;; We must prepare a font for the first non-ASCII and non-Latin1
- ;; character in STRING.
- (let* ((ps-current-font (if (string= fonttag "/h0") 0 1))
- (ps-mule-current-charset (car ps-mule-header-charsets))
- (font-type (car (nth ps-current-font
- (ps-font-alist 'ps-font-for-header))))
- (font-spec (ps-mule-get-font-spec ps-mule-current-charset
- font-type)))
- (if (or (not font-spec)
- (/= (charset-dimension ps-mule-current-charset) 1))
- ;; We don't have a proper font, or we can't print them on
- ;; header because this kind of charset is not ASCII
- ;; compatible.
- (let ((len (length string)))
- (dotimes (i len)
- (or (memq (char-charset (aref string i))
- '(ascii latin-iso8859-1))
- (aset string i ??)))
- (setq string (encode-coding-string string 'iso-latin-1)))
- (let ((charsets (list 'ascii (car ps-mule-header-charsets)))
- (len (length string)))
- (dotimes (i len)
- (or (memq (char-charset (aref string i)) charsets)
- (aset string i ??))))
- (setq string (ps-mule-string-encoding font-spec string nil t))))))
- string)
-
-(defun ps-mule-show-warning (charsets from to header-footer-list)
- (let ((table (make-category-table))
- (buf (current-buffer))
- (max-unprintable-chars 15)
- char-pos-list)
- (define-category ?u "Unprintable charset" table)
- (dolist (cs charsets)
- (modify-category-entry (make-char cs) ?u table))
- (with-category-table table
- (save-excursion
- (goto-char from)
- (while (and (<= (length char-pos-list) max-unprintable-chars)
- (re-search-forward "\\cu" to t))
- (or (aref ps-print-translation-table (preceding-char))
- (push (cons (preceding-char) (1- (point))) char-pos-list)))))
- (with-output-to-temp-buffer "*Warning*"
- (with-current-buffer standard-output
- (when char-pos-list
- (let ((func #'(lambda (buf pos)
- (when (buffer-live-p buf)
- (pop-to-buffer buf)
- (goto-char pos))))
- (more nil))
- (if (>= (length char-pos-list) max-unprintable-chars)
- (setq char-pos-list (cdr char-pos-list)
- more t))
- (insert "These characters in the buffer can't be printed:\n")
- (dolist (elt (nreverse char-pos-list))
- (insert " ")
- (insert-text-button (string (car elt))
- :type 'help-xref
- 'help-echo
- "mouse-2, RET: jump to this character"
- 'help-function func
- 'help-args (list buf (cdr elt)))
- (insert ","))
- (if more
- (insert " and more...")
- ;; Delete the last comma.
- (delete-char -1))
- (insert "\nClick them to jump to the buffer position,\n"
- (substitute-command-keys "\
-or \\[universal-argument] \\[what-cursor-position] will give information about them.\n"))))
-
- (with-category-table table
- (let (string-list)
- (dolist (elt header-footer-list)
- (when (stringp elt)
- (when (string-match "\\cu+" elt)
- (setq elt (copy-sequence elt))
- (put-text-property (match-beginning 0) (match-end 0)
- 'face 'highlight elt)
- (while (string-match "\\cu+" elt (match-end 0))
- (put-text-property (match-beginning 0) (match-end 0)
- 'face 'highlight elt))
- (push elt string-list))))
- (when string-list
- (insert
- "These highlighted characters in header/footer can't be printed:\n")
- (dolist (elt string-list)
- (insert " " elt "\n")))))))))
+FONTTAG should be a string \"/h0\", \"/h1\", \"/L0\", or \"/H0\".
+Any other value is treated as \"/H0\"."
+ (with-temp-buffer
+ (insert string)
+ (ps-mule-encode-region (point-min) (point-max)
+ (aref ps-mule-font-spec-tables
+ (aref ps-mule-font-number-to-type
+ (cond ((string= fonttag "/h0") 4)
+ ((string= fonttag "/h1") 5)
+ ((string= fonttag "/L0") 6)
+ (t 0)))))))
;;;###autoload
(defun ps-mule-begin-job (from to)
"Start printing job for multi-byte chars between FROM and TO.
It checks if all multi-byte characters in the region are printable or not."
- (setq ps-mule-charset-list nil
- ps-mule-header-charsets nil
- ps-mule-font-info-database
- (cond ((eq ps-multibyte-buffer 'non-latin-printer)
- ps-mule-font-info-database-ps)
- ((eq ps-multibyte-buffer 'bdf-font)
- ps-mule-font-info-database-bdf)
- ((eq ps-multibyte-buffer 'bdf-font-except-latin)
- ps-mule-font-info-database-ps-bdf)
- (t
- ps-mule-font-info-database-default)))
- (and (boundp 'enable-multibyte-characters)
- enable-multibyte-characters
- ;; Initialize `ps-mule-charset-list'. If some characters aren't
- ;; printable, warn it.
- (let ((header-footer-list (ps-header-footer-string))
- unprintable-charsets)
- (setq ps-mule-charset-list
- (delq 'ascii (delq 'eight-bit-control
- (delq 'eight-bit-graphic
- (find-charset-region
- from to ps-print-translation-table))))
- ps-mule-header-charsets
- (delq 'ascii (delq 'eight-bit-control
- (delq 'eight-bit-graphic
- (find-charset-string
- (mapconcat
- 'identity header-footer-list "")
- ps-print-translation-table)))))
- (dolist (cs ps-mule-charset-list)
- (or (ps-mule-printable-p cs)
- (push cs unprintable-charsets)))
- (dolist (cs ps-mule-header-charsets)
- (or (ps-mule-printable-p cs)
- (memq cs unprintable-charsets)
- (push cs unprintable-charsets)))
- (when unprintable-charsets
- (ps-mule-show-warning unprintable-charsets from to
- header-footer-list)
- (or
- (y-or-n-p "Font for some characters not found, continue anyway? ")
- (error "Printing cancelled")))
-
- (or ps-mule-composition-prologue-generated
- (let ((use-composition (nth 2 (find-composition from to))))
- (or use-composition
- (let (str)
- (while header-footer-list
- (setq str (car header-footer-list))
- (if (and (stringp str)
- (nth 2 (find-composition 0 (length str) str)))
- (setq use-composition t
- header-footer-list nil)
- (setq header-footer-list (cdr header-footer-list))))))
- (when use-composition
- (progn
- (ps-mule-prologue-generated)
- (ps-output-prologue ps-mule-composition-prologue)
- (setq ps-mule-composition-prologue-generated t)))))))
-
- (setq ps-mule-current-charset 'ascii)
-
- (if (or ps-mule-charset-list ps-mule-header-charsets)
- (dolist (elt (append ps-mule-header-charsets ps-mule-charset-list))
- (ps-mule-prologue-generated)
- (ps-mule-init-external-library (ps-mule-get-font-spec elt 'normal))))
-
- ;; If ASCII font is also specified in ps-mule-font-info-database,
- ;; use it instead of what specified in ps-font-info-database.
- (let ((font-spec (ps-mule-get-font-spec 'ascii 'normal)))
- (if font-spec
- (progn
- (ps-mule-prologue-generated)
- (ps-mule-init-external-library font-spec)
- (let ((ps-current-font 0))
- (dolist (font (ps-font-alist 'ps-font-for-text))
- ;; Be sure to download a glyph for SPACE in advance.
- (ps-mule-prepare-font (ps-mule-get-font-spec 'ascii font)
- " " 'ascii 'no-setfont)
- (setq ps-current-font (1+ ps-current-font)))))))
-
- ;; If the header contains non-ASCII and non-Latin1 characters, prepare a font
- ;; and glyphs for the first occurrence of such characters.
- (if (and ps-mule-header-charsets
- (not (eq (car ps-mule-header-charsets) 'latin-iso8859-1))
- (= (charset-dimension (car ps-mule-header-charsets)) 1))
- (let ((font-spec (ps-mule-get-font-spec (car ps-mule-header-charsets)
- 'normal)))
- (if font-spec
- ;; Be sure to download glyphs for "0123456789/" in advance for page
- ;; numbering.
- (let ((ps-current-font 0))
- (ps-mule-prepare-font font-spec "0123456789/" 'ascii t t)))))
-
- (if ps-mule-charset-list
- ;; We must change this regexp for multi-byte buffer.
- (setq ps-control-or-escape-regexp
- (cond ((eq ps-print-control-characters '8-bit)
- "[^\040-\176]")
- ((eq ps-print-control-characters 'control-8-bit)
- (string-as-multibyte "[^\040-\176\240-\377]"))
- ((eq ps-print-control-characters 'control)
- (string-as-multibyte "[^\040-\176\200-\377]"))
- (t (string-as-multibyte "[^\000-\011\013\015-\377]"))))))
+ (auto-compose-region from to)
+ (if (and (not (find-composition from to))
+ (save-excursion
+ (goto-char from)
+ (= (skip-chars-forward "\x00-\xFF" to) to)))
+ ;; All characters can be printed by normal PostScript fonts.
+ (setq ps-basic-plot-string-function 'ps-basic-plot-string
+ ps-encode-header-string-function 'identity)
+ (setq ps-basic-plot-string-function 'ps-mule-plot-string
+ ps-encode-header-string-function 'ps-mule-encode-header-string
+ ps-mule-font-info-database
+ (cond ((eq ps-multibyte-buffer 'non-latin-printer)
+ ps-mule-font-info-database-ps)
+ ((eq ps-multibyte-buffer 'bdf-font)
+ ps-mule-font-info-database-bdf)
+ ((eq ps-multibyte-buffer 'bdf-font-except-latin)
+ ps-mule-font-info-database-ps-bdf)
+ (t
+ ps-mule-font-info-database-default)))
+
+ ;; Be sure to have font information for Latin-1.
+ (or (assq 'iso-8859-1 ps-mule-font-info-database)
+ (setq ps-mule-font-info-database
+ (cons '(iso-8859-1 (normal nil nil))
+ ps-mule-font-info-database)))
+
+ ;; Generate ps-mule-font-spec-tables.
+ (let ((font-spec-alist (make-vector 4 nil))
+ (id-max 0)
+ (font-id 0)
+ font-info-list)
+ ;; Generate properly ordered font-info-list from
+ ;; ps-mule-font-info-database.
+ (let ((charset-list
+ (copy-sequence (get-language-info current-language-environment
+ 'charset))))
+ (setq charset-list (cons 'iso-8859-1 (delq 'iso-8859-1 charset-list)))
+ (dolist (charset charset-list)
+ (let ((font-info (assq charset ps-mule-font-info-database)))
+ (and font-info
+ (setq font-info-list (cons font-info font-info-list)))))
+ (dolist (font-info ps-mule-font-info-database)
+ (or (memq (car font-info) charset-list)
+ (setq font-info-list (cons font-info font-info-list))))
+ (setq font-info-list (nreverse font-info-list)))
+
+ ;; Store FONT-SPECs in each element of font-spec-alist.
+ (dolist (font-info font-info-list)
+ (let ((font-spec-vec (make-vector 4 nil))
+ (charset (car font-info))
+ encoding font-spec)
+ (dolist (e (cdr font-info))
+ (setq encoding (or (nth 3 e) charset)
+ font-spec (vector id-max charset font-id
+ (nth 1 e) (nth 2 e) encoding
+ (or (nth 4 e) (charset-dimension encoding))
+ nil)
+ id-max (1+ id-max))
+ (if (ps-mule-check-font font-spec)
+ (aset font-spec-vec
+ (cond ((eq (car e) 'normal) 0)
+ ((eq (car e) 'bold) 1)
+ ((eq (car e) 'italic) 2)
+ (t 3)) font-spec)))
+ (when (aref font-spec-vec 0)
+ (or (aref font-spec-vec 3)
+ (aset font-spec-vec 3 (or (aref font-spec-vec 1)
+ (aref font-spec-vec 2)
+ (aref font-spec-vec 0))))
+ (or (aref font-spec-vec 1)
+ (aset font-spec-vec 1 (aref font-spec-vec 0)))
+ (or (aref font-spec-vec 2)
+ (aset font-spec-vec 2 (aref font-spec-vec 1)))
+ (dotimes (i 4)
+ (aset font-spec-alist i
+ (nconc (aref font-spec-alist i)
+ (list (cons charset (aref font-spec-vec i))))))
+ (setq font-id (1+ font-id)))))
+
+ ;; Make four FONT-SPEC-TABLEs and set them in
+ ;; ps-mule-font-spec-tables. Each char table has one extra slot
+ ;; whose value is an element of font-spec-alist.
+ (setq ps-mule-font-spec-tables (make-vector 4 nil))
+ (put 'font-spec-table 'char-table-extra-slots 1)
+ (dotimes (i 4)
+ (let ((table (make-char-table 'font-spec-table)))
+ (aset ps-mule-font-spec-tables i table)
+ (set-char-table-extra-slot table 0 (aref font-spec-alist i))
+ ;; Be sure to have glyphs for "0123456789/" in advance for
+ ;; page numbering.
+ (let ((str " 0123456789/"))
+ (dotimes (i (length str))
+ (or (vectorp (ps-mule-get-font-spec (aref str i) table nil))
+ (error "ASCII font not available")))))))
+
+ (ps-mule-prologue-generated)
+ (if (find-composition from to)
+ (ps-mule-composition-prologue-generated))))
+
+(defun ps-mule-restruct-output-list (list tail)
+ (dolist (elt list)
+ (if (listp elt)
+ (setq tail (ps-mule-restruct-output-list elt tail))
+ (setcdr tail (cons elt (cdr tail)))
+ (setq tail (cdr tail))))
+ tail)
+
+(defun ps-mule-redefine-font (font-number fonttag size ps-font)
+ (let* ((font-type (aref ps-mule-font-number-to-type font-number))
+ (font-spec-alist (char-table-extra-slot
+ (aref ps-mule-font-spec-tables font-type) 0)))
+ (ps-output-prologue
+ (list (if (ps-mule-font-spec-src (cdr (car font-spec-alist)))
+ ;; We ignore a font specfied in ps-font-info-database.
+ (format "/V%s VTOP%d def\n" fonttag font-type)
+ (format "/V%s [ VTOP%d aload pop ] def\n
+V%s 0 /%s-latin1 /%s Latin1Encoding put\n"
+ fonttag font-type fonttag ps-font ps-font))
+ (format "/%s ETOP%d V%s %f ReDefFont\n"
+ fonttag font-type fonttag size)))))
-;;;###autoload
-(defun ps-mule-begin-page ()
- (setq ps-mule-current-charset 'ascii))
+;;;###autoload
+(defun ps-mule-end-job ()
+ "Finish printing job for multi-byte chars."
+
+ ;; Prepare root and sub fonts while generating glyphs if necessary.
+ (let ((output-head (list t))
+ (ps-mule-output-list (list t)))
+ (dotimes (i 4)
+ (map-char-table 'ps-mule-prepare-glyph
+ (aref ps-mule-font-spec-tables i)))
+ (ps-mule-restruct-output-list (cdr ps-mule-output-list) output-head)
+ (ps-output-prologue (cdr output-head)))
+
+ ;; Prepare top Encoding and templates of FDepVector.
+ (dotimes (i 4)
+ (let ((font-spec-alist (char-table-extra-slot
+ (aref ps-mule-font-spec-tables i) 0))
+ font-list font-spec)
+ (dolist (elt font-spec-alist)
+ (setq font-spec (cdr elt))
+ (if (ps-mule-font-spec-extra font-spec)
+ (push (cons (ps-mule-font-spec-font-id font-spec)
+ (ps-mule-font-spec-id font-spec))
+ font-list)))
+ (setq font-list (nreverse font-list))
+ (ps-output-prologue
+ (list (format "/ETOP%d 256 array def\n" i)
+ (format "0 1 255 { ETOP%d exch 0 put } for\n" i)))
+ (let ((index 0))
+ (dolist (font font-list)
+ (ps-output-prologue (format "ETOP%d %d %d put\n" i (car font) index))
+ (setq index (1+ index))))
+ (ps-output-prologue (format "/VTOP%d [%s] def\n" i
+ (mapconcat #'(lambda (x)
+ (format "F%02X" (cdr x)))
+ font-list " ")))))
+
+ ;; Redefine fonts f0, f1, f2, f3, h0, h1, H0.
+ (ps-mule-redefine-font 4 "h0" ps-header-title-font-size-internal
+ (ps-font 'ps-font-for-header 'bold))
+ (ps-mule-redefine-font 5 "h1" ps-header-font-size-internal
+ (ps-font 'ps-font-for-header 'normal))
+ (ps-mule-redefine-font 6 "H0" ps-footer-font-size-internal
+ (ps-font 'ps-font-for-footer 'normal))
+ (let ((font (ps-font-alist 'ps-font-for-text))
+ (i 0))
+ (while font
+ (ps-mule-redefine-font i (format "f%d" i)
+ ps-font-size-internal
+ (ps-font 'ps-font-for-text (car (car font))))
+ (setq font (cdr font)
+ i (1+ i)))))
(provide 'ps-mule)
;;; ps-print.el --- print text from the buffer as PostScript
;; Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001,
- ;; 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ ;; 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Jim Thompson (was <thompson@wg2.waii.com>)
;; Jacques Duthen (was <duthen@cegelec-red.fr>)
;; Maintainer: Kenichi Handa <handa@m17n.org> (multi-byte characters)
;; Vinicius Jose Latorre <viniciusjl@ig.com.br>
;; Keywords: wp, print, PostScript
-;; Version: 6.8.1
+;; Version: 7.3.1
;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
-(defconst ps-print-version "6.8.1"
- "ps-print.el, v 6.8.1 <2007/11/21 vinicius>
+(defconst ps-print-version "7.3.1"
+ "ps-print.el, v 7.3.1 <2007/11/21 vinicius>
Vinicius's last change version -- this file may have been edited as part of
Emacs without changes to the version number. When reporting bugs, please also
;;
;; Faces are always treated as opaque.
;;
-;; Epoch, Lucid and Emacs 21 not supported. At all.
+;; Epoch, Lucid and Emacs 22 not supported. At all.
;;
;; Fixed-pitch fonts work better for line folding, but are not required.
;;
(require 'lpr)
+
(or (featurep 'lisp-float-type)
(error "`ps-print' requires floating point support"))
+
(if (featurep 'xemacs)
()
(unless (and (boundp 'emacs-major-version)
- (>= emacs-major-version 22))
- (error "`ps-print' only supports Emacs 22 and higher")))
-
-
-;; GNU Emacs
-(or (fboundp 'line-beginning-position)
- (defun line-beginning-position (&optional n)
- (save-excursion
- (and n (/= n 1) (forward-line (1- n)))
- (beginning-of-line)
- (point))))
-
-
-;; to avoid compilation gripes
-
-;; GNU Emacs
-(defalias 'ps-e-find-composition (if (fboundp 'find-composition)
- 'find-composition
- 'ignore))
+ (>= emacs-major-version 23))
+ (error "`ps-print' only supports Emacs 23 and higher")))
(defconst ps-windows-system
(memq system-type '(emx win32 w32 mswindows ms-dos windows-nt)))
(defconst ps-lp-system
- (memq system-type '(usg-unix-v dgux hpux irix)))
+ (memq system-type '(usg-unix-v hpux irix)))
-(defun ps-xemacs-color-name (color)
- (when (featurep 'xemacs)
- (if (color-specifier-p color)
- (color-name color)
- color)))
-
-(defalias 'ps-frame-parameter
- (if (fboundp 'frame-parameter) 'frame-parameter 'frame-property))
-
-(defalias 'ps-mark-active-p
- (if (featurep 'xemacs)
- 'region-active-p ; XEmacs
- (defvar mark-active) ; To shup up XEmacs's byte compiler.
- (lambda () mark-active))) ; Emacs
-
-(defun ps-face-foreground-name (face)
- (if (featurep 'xemacs)
- (ps-xemacs-color-name (face-foreground face))
- (face-foreground face nil t)))
+;; Load XEmacs/Emacs definitions
+(eval-and-compile (require 'ps-def))
-(defun ps-face-background-name (face)
- (if (featurep 'xemacs)
- (ps-xemacs-color-name (face-background face))
- (face-background face nil t)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; User Variables:
(format-time-string "%T"))
-(and (featurep 'xemacs)
- ;; XEmacs change: Need to check for emacs-major-version too.
- (or (< emacs-major-version 19)
- (and (= emacs-major-version 19) (< emacs-minor-version 12)))
- (setq ps-print-color-p nil))
-
-
-;; Return t if the device (which can be changed during an emacs session)
-;; can handle colors.
-;; This function is not yet implemented for GNU emacs.
-(defalias 'ps-color-device
- (cond ((and (featurep 'xemacs)
- ;; XEmacs change: Need to check for emacs-major-version too.
- (or (> emacs-major-version 19)
- (and (= emacs-major-version 19)
- (>= emacs-minor-version 12)))) ; XEmacs >= 19.12
- (lambda ()
- (eq (device-class) 'color)))
-
- (t ; Emacs
- (lambda ()
- (if (fboundp 'color-values)
- (color-values "Green")
- t)))))
-
-
-(defun ps-xemacs-mapper (extent list)
- (when (featurep 'xemacs)
- (nconc list
- (list (list (extent-start-position extent) 'push extent)
- (list (extent-end-position extent) 'pull extent))))
- nil)
-
-(defun ps-xemacs-extent-sorter (a b)
- (when (featurep 'xemacs)
- (< (extent-priority a) (extent-priority b))))
-
-(defun ps-xemacs-face-kind-p (face kind kind-regex)
- (when (featurep 'xemacs)
- (let* ((frame-font (or (face-font-instance face)
- (face-font-instance 'default)))
- (kind-cons
- (and frame-font
- (assq kind
- (font-instance-properties frame-font))))
- (kind-spec (cdr-safe kind-cons))
- (case-fold-search t))
- (and kind-spec (string-match kind-regex kind-spec)))))
-
-(when (featurep 'xemacs)
- ;; to avoid XEmacs compilation gripes
- (defvar coding-system-for-write)
- (defvar coding-system-for-read)
- (defvar buffer-file-coding-system)
-
- (and (fboundp 'find-coding-system)
- (or (find-coding-system 'raw-text-unix)
- (copy-coding-system 'no-conversion-unix 'raw-text-unix))))
-
-(defun ps-color-values (x-color)
- (if (featurep 'xemacs)
- (let ((color (ps-xemacs-color-name x-color)))
- (cond
- ((fboundp 'x-color-values)
- (x-color-values color))
- ((and (fboundp 'color-instance-rgb-components)
- (ps-color-device))
- (color-instance-rgb-components
- (if (color-instance-p x-color)
- x-color
- (make-color-instance color))))
- (t
- (error "No available function to determine X color values"))))
- (cond
- ((fboundp 'color-values)
- (color-values x-color))
- ((fboundp 'x-color-values)
- (x-color-values x-color))
- (t
- (error "No available function to determine X color values")))))
-
-(defun ps-face-bold-p (face)
- (if (featurep 'xemacs)
- (or (ps-xemacs-face-kind-p face 'WEIGHT_NAME "bold\\|demibold")
- (memq face ps-bold-faces)) ; Kludge-compatible
- (or (face-bold-p face)
- (memq face ps-bold-faces))))
-
-(defun ps-face-italic-p (face)
- (if (featurep 'xemacs)
- (or (ps-xemacs-face-kind-p face 'ANGLE_NAME "i\\|o")
- (ps-xemacs-face-kind-p face 'SLANT "i\\|o")
- (memq face ps-italic-faces)) ; Kludge-compatible
- (or (face-italic-p face)
- (memq face ps-italic-faces))))
-
(defvar ps-print-color-scale 1.0)
(defun ps-color-scale (color)
(defvar ps-razchunk 0)
(defvar ps-color-p nil)
-(defvar ps-color-format
- (if (featurep 'xemacs)
- ;; XEmacs will have to make do with %s (princ) for floats.
- "%s %s %s"
-
- ;; Emacs understands the %f format; we'll use it to limit color RGB
- ;; values to three decimals to cut down some on the size of the
- ;; PostScript output.
- "%0.3f %0.3f %0.3f"))
;; These values determine how much print-height to deduct when headers/footers
;; are turned on. This is a pretty clumsy way of handling it, but it'll do for
(goto-char (point-max))
(insert-file-contents fname)))
-;; These functions are used in `ps-mule' to get charset of header and footer.
-;; To avoid unnecessary calls to functions in `ps-left-header',
-;; `ps-right-header', `ps-left-footer' and `ps-right-footer'.
-
-(defun ps-generate-string-list (content)
- (let (str)
- (while content
- (setq str (cons (cond
- ;; string
- ((stringp (car content))
- (car content))
- ;; function symbol
- ((functionp (car content))
- (concat "(" (funcall (car content)) ")"))
- ;; variable symbol
- ((and (symbolp (car content)) (boundp (car content)))
- (concat "(" (symbol-value (car content)) ")"))
- ;; otherwise, empty string
- (t
- ""))
- str)
- content (cdr content)))
- (nreverse str)))
-
-(defvar ps-lh-cache nil)
-(defvar ps-rh-cache nil)
-(defvar ps-lf-cache nil)
-(defvar ps-rf-cache nil)
-
-(defun ps-header-footer-string ()
- (and ps-print-header
- (setq ps-lh-cache (ps-generate-string-list ps-left-header)
- ps-rh-cache (ps-generate-string-list ps-right-header)))
- (and ps-print-footer
- (setq ps-lf-cache (ps-generate-string-list ps-left-footer)
- ps-rf-cache (ps-generate-string-list ps-right-footer)))
- (append ps-lh-cache ps-rh-cache ps-lf-cache ps-rf-cache))
-
-;; All autoloads.
-(declare-function ps-mule-encode-header-string "ps-mule")
-(declare-function ps-mule-begin-page "ps-mule")
-(declare-function ps-mule-prepare-ascii-font "ps-mule")
-(declare-function ps-mule-set-ascii-font "ps-mule")
-(declare-function ps-mule-initialize "ps-mule")
-(declare-function ps-mule-begin-job "ps-mule")
-
;; These functions insert the arrays that define the contents of the headers.
+(defvar ps-encode-header-string-function nil)
+
(defun ps-generate-header-line (fonttag &optional content)
(ps-output " [" fonttag " ")
(cond
;; Literal strings should be output as is -- the string must contain its own
;; PS string delimiters, '(' and ')', if necessary.
((stringp content)
- (ps-output (ps-mule-encode-header-string content fonttag)))
+ (ps-output content))
;; Functions are called -- they should return strings; they will be inserted
;; as strings and the PS string delimiters added.
((functionp content)
- (ps-output-string (ps-mule-encode-header-string (funcall content)
- fonttag)))
+ (if (functionp ps-encode-header-string-function)
+ (dolist (l (funcall ps-encode-header-string-function
+ (funcall content) fonttag))
+ (ps-output-string l))
+ (ps-output-string (funcall content))))
;; Variables will have their contents inserted. They should contain
;; strings, and will be inserted as strings.
((and (symbolp content) (boundp content))
- (ps-output-string (ps-mule-encode-header-string (symbol-value content)
- fonttag)))
+ (if (fboundp ps-encode-header-string-function)
+ (dolist (l (funcall ps-encode-header-string-function
+ (symbol-value content) fonttag))
+ (ps-output-string l))
+ (ps-output-string (symbol-value content))))
;; Anything else will get turned into an empty string.
(t
(vector 0 0 0 0)))))
-;; Emacs understands the %f format; we'll use it to limit color RGB values
-;; to three decimals to cut down some on the size of the PostScript output.
-;; XEmacs will have to make do with %s (princ) for floats.
-
-(defvar ps-float-format (if (featurep 'xemacs)
- "%s " ; XEmacs
- "%0.3f ")) ; Emacs
-
-
(defun ps-float-format (value &optional default)
(let ((literal (or value default)))
(cond ((null literal)
(t
(list default default default))))
+(defvar ps-basic-plot-string-function 'ps-basic-plot-string)
(defun ps-begin-job (genfunc)
;; prologue files
ps-default-color (and (not (member ps-print-color-p
'(nil back-white)))
ps-default-foreground)
- ps-current-color ps-default-color)
+ ps-current-color ps-default-color
+ ;; Set up default functions.
+ ;; They may be overridden by ps-mule-begin-job.
+ ps-basic-plot-string-function 'ps-basic-plot-string
+ ps-encode-header-string-function nil)
;; initialize page dimensions
(ps-get-page-dimensions)
;; final check
(format "/PageNumber %d def\n" (ps-page-number)))
(when ps-print-header
- (ps-generate-header "HeaderLinesLeft" "/h0" "/h1"
- (or ps-lh-cache ps-left-header))
- (ps-generate-header "HeaderLinesRight" "/h0" "/h1"
- (or ps-rh-cache ps-right-header))
- (ps-output (format "%d SetHeaderLines\n" ps-header-lines))
- (setq ps-lh-cache nil
- ps-rh-cache nil))
+ (ps-generate-header "HeaderLinesLeft" "/h0" "/h1" ps-left-header)
+ (ps-generate-header "HeaderLinesRight" "/h0" "/h1" ps-right-header)
+ (ps-output (format "%d SetHeaderLines\n" ps-header-lines)))
(when ps-print-footer
- (ps-generate-header "FooterLinesLeft" "/H0" "/H0"
- (or ps-lf-cache ps-left-footer))
- (ps-generate-header "FooterLinesRight" "/H0" "/H0"
- (or ps-rf-cache ps-right-footer))
- (ps-output (format "%d SetFooterLines\n" ps-footer-lines))
- (setq ps-lf-cache nil
- ps-rf-cache nil))
+ (ps-generate-header "FooterLinesLeft" "/H0" "/H0" ps-left-footer)
+ (ps-generate-header "FooterLinesRight" "/H0" "/H0" ps-right-footer)
+ (ps-output (format "%d SetFooterLines\n" ps-footer-lines)))
(ps-output (number-to-string ps-lines-printed) " BeginPage\n")
(ps-set-font ps-current-font)
(ps-set-bg ps-current-bg)
- (ps-set-color ps-current-color)
- (ps-mule-begin-page))
+ (ps-set-color ps-current-color))
(defsubst ps-skip-newline (limit)
(setq ps-showline-count (1+ ps-showline-count)
(ps-avg-char-width 'ps-font-for-text)))
(to (car wrappoint))
(str (substring string from to)))
- (ps-mule-prepare-ascii-font str)
(ps-output-string str)
(ps-output " S\n")
wrappoint))
(ps-avg-char-width 'ps-font-for-text)))
(to (car wrappoint))
(string (buffer-substring-no-properties from to)))
- (ps-mule-prepare-ascii-font string)
(ps-output-string string)
(ps-output " S\n")
wrappoint))
(if (re-search-forward ps-control-or-escape-regexp to t)
;; region with some control characters or some multi-byte characters
(let* ((match-point (match-beginning 0))
- (match (char-after match-point))
- (composition (ps-e-find-composition from (1+ match-point))))
- (if composition
- (if (and (nth 2 composition)
- (<= (car composition) match-point))
- (progn
- (setq match-point (car composition)
- match 0)
- (goto-char (nth 1 composition)))
- (setq composition nil)))
+ (match (char-after match-point)))
(when (< from match-point)
- (ps-mule-set-ascii-font)
- (ps-plot 'ps-basic-plot-string from match-point bg-color))
+ (ps-plot ps-basic-plot-string-function
+ from match-point bg-color))
(cond
((= match ?\t) ; tab
(let ((linestart (line-beginning-position)))
(forward-char -1)
(setq from (+ linestart (current-column)))
(when (re-search-forward "[ \t]+" to t)
- (ps-mule-set-ascii-font)
(ps-plot 'ps-basic-plot-whitespace
from (+ linestart (current-column))
bg-color))))
(ps-skip-newline to))
(ps-next-page)))
- (composition ; a composite sequence
- (ps-plot 'ps-mule-plot-composition match-point (point) bg-color))
-
- ((> match 255) ; a multi-byte character
- (setq match (or (aref ps-print-translation-table match) match))
- (let* ((charset (char-charset match))
- (composition (ps-e-find-composition match-point to))
- (stop (if (nth 2 composition) (car composition) to)))
- (or (eq charset 'composition)
- (while (and (< (point) stop)
- (let ((ch (following-char)))
- (setq ch
- (or (aref ps-print-translation-table ch)
- ch))
- (eq (char-charset ch) charset)))
- (forward-char 1)))
- (ps-plot 'ps-mule-plot-string match-point (point) bg-color)))
- ; characters from ^@ to ^_ and
(t ; characters from 127 to 255
(ps-control-character match)))
(setq from (point)))
- ;; region without control characters nor multi-byte characters
- (ps-mule-set-ascii-font)
- (ps-plot 'ps-basic-plot-string from to bg-color)
+ ;; region without control characters
+ (ps-plot ps-basic-plot-string-function from to bg-color)
(setq from to)))))
(defvar ps-string-control-codes
(if (< (car wrappoint) to)
(ps-continue-line))
(setq ps-width-remaining (- ps-width-remaining (* len char-width)))
- (ps-mule-prepare-ascii-font str)
(ps-output-string str)
(ps-output " S\n")))
(save-restriction
(narrow-to-region from to)
(ps-print-ensure-fontified from to)
- (let ((face 'default)
- (position to))
- (cond
- ((featurep 'xemacs) ; XEmacs
- ;; Build the list of extents...
- (let ((a (cons 'dummy nil))
- record type extent extent-list)
- (map-extents 'ps-xemacs-mapper nil from to a)
- (setq a (sort (cdr a) 'car-less-than-car)
- extent-list nil)
-
- ;; Loop through the extents...
- (while a
- (setq record (car a)
- position (car record)
-
- record (cdr record)
- type (car record)
-
- record (cdr record)
- extent (car record))
-
- ;; Plot up to this record.
- ;; XEmacs 19.12: for some reason, we're getting into a
- ;; situation in which some of the records have
- ;; positions less than 'from'. Since we've narrowed
- ;; the buffer, this'll generate errors. This is a hack,
- ;; but don't call ps-plot-with-face unless from > point-min.
- (and (>= from (point-min))
- (ps-plot-with-face from (min position (point-max)) face))
-
- (cond
- ((eq type 'push)
- (and (extent-face extent)
- (setq extent-list (sort (cons extent extent-list)
- 'ps-xemacs-extent-sorter))))
-
- ((eq type 'pull)
- (setq extent-list (sort (delq extent extent-list)
- 'ps-xemacs-extent-sorter))))
-
- (setq face (if extent-list
- (extent-face (car extent-list))
- 'default)
- from position
- a (cdr a)))))
-
- (t ; Emacs
- (let ((property-change from)
- (overlay-change from)
- (save-buffer-invisibility-spec buffer-invisibility-spec)
- (buffer-invisibility-spec nil)
- before-string after-string)
- (while (< from to)
- (and (< property-change to) ; Don't search for property change
- ; unless previous search succeeded.
- (setq property-change (next-property-change from nil to)))
- (and (< overlay-change to) ; Don't search for overlay change
- ; unless previous search succeeded.
- (setq overlay-change (min (next-overlay-change from)
- to)))
- (setq position (min property-change overlay-change)
- before-string nil
- after-string nil)
- ;; The code below is not quite correct,
- ;; because a non-nil overlay invisible property
- ;; which is inactive according to the current value
- ;; of buffer-invisibility-spec nonetheless overrides
- ;; a face text property.
- (setq face
- (cond ((let ((prop (get-text-property from 'invisible)))
- ;; Decide whether this invisible property
- ;; really makes the text invisible.
- (if (eq save-buffer-invisibility-spec t)
- (not (null prop))
- (or (memq prop save-buffer-invisibility-spec)
- (assq prop save-buffer-invisibility-spec))))
- 'emacs--invisible--face)
- ((get-text-property from 'face))
- (t 'default)))
- (let ((overlays (overlays-at from))
- (face-priority -1)) ; text-property
- (while (and overlays
- (not (eq face 'emacs--invisible--face)))
- (let* ((overlay (car overlays))
- (overlay-invisible
- (overlay-get overlay 'invisible))
- (overlay-priority
- (or (overlay-get overlay 'priority) 0)))
- (and (> overlay-priority face-priority)
- (setq before-string
- (or (overlay-get overlay 'before-string)
- before-string)
- after-string
- (or (and (<= (overlay-end overlay) position)
- (overlay-get overlay 'after-string))
- after-string)
- face-priority overlay-priority
- face
- (cond
- ((if (eq save-buffer-invisibility-spec t)
- (not (null overlay-invisible))
- (or (memq overlay-invisible
- save-buffer-invisibility-spec)
- (assq overlay-invisible
- save-buffer-invisibility-spec)))
- 'emacs--invisible--face)
- ((overlay-get overlay 'face))
- (t face)
- ))))
- (setq overlays (cdr overlays))))
- ;; Plot up to this record.
- (and before-string
- (ps-plot-string before-string))
- (ps-plot-with-face from position face)
- (and after-string
- (ps-plot-string after-string))
- (setq from position)))))
- (ps-plot-with-face from to face))))
+ (ps-generate-postscript-with-faces1 from to)))
(defun ps-generate-postscript (from to)
(ps-plot-region from to 0))
(ps-begin-page)
(funcall genfunc from to)
(ps-end-page)
+ (ps-mule-end-job)
(ps-end-job needs-begin-file)
;; Setting this variable tells the unwind form that the
(t
(setq kill-emacs-hook 'ps-kill-emacs-check)))
-\f
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Sample Setup Code:
-
-
-;; This stuff is for anybody that's brave enough to look this far,
-;; and able to figure out how to use it. It isn't really part of
-;; ps-print, but I'll leave it here in hopes it might be useful:
-
-;; WARNING!!! The following code is *sample* code only.
-;; Don't use it unless you understand what it does!
-
-;; The key `f22' should probably be replaced by `print'. --Stef
-
-;; A hook to bind to `rmail-mode-hook' to locally bind prsc and set the
-;; `ps-left-headers' specially for mail messages.
-(defun ps-rmail-mode-hook ()
- (local-set-key [(f22)] 'ps-rmail-print-message-from-summary)
- (setq ps-header-lines 3
- ps-left-header
- ;; The left headers will display the message's subject, its
- ;; author, and the name of the folder it was in.
- '(ps-article-subject ps-article-author buffer-name)))
-
-;; See `ps-gnus-print-article-from-summary'. This function does the
-;; same thing for rmail.
-(defun ps-rmail-print-message-from-summary ()
- (interactive)
- (ps-print-message-from-summary 'rmail-summary-buffer "RMAIL"))
-
-;; Used in `ps-rmail-print-article-from-summary',
-;; `ps-gnus-print-article-from-summary' and `ps-vm-print-message-from-summary'.
-(defun ps-print-message-from-summary (summary-buffer summary-default)
- (let ((ps-buf (or (and (boundp summary-buffer)
- (symbol-value summary-buffer))
- summary-default)))
- (and (get-buffer ps-buf)
- (save-excursion
- (set-buffer ps-buf)
- (ps-spool-buffer-with-faces)))))
-
-;; Look in an article or mail message for the Subject: line. To be
-;; placed in `ps-left-headers'.
-(defun ps-article-subject ()
- (save-excursion
- (goto-char (point-min))
- (if (re-search-forward "^Subject:[ \t]+\\(.*\\)$" nil t)
- (buffer-substring (match-beginning 1) (match-end 1))
- "Subject ???")))
-
-;; Look in an article or mail message for the From: line. Sorta-kinda
-;; understands RFC-822 addresses and can pull the real name out where
-;; it's provided. To be placed in `ps-left-headers'.
-(defun ps-article-author ()
- (save-excursion
- (goto-char (point-min))
- (if (re-search-forward "^From:[ \t]+\\(.*\\)$" nil t)
- (let ((fromstring (buffer-substring (match-beginning 1) (match-end 1))))
- (cond
-
- ;; Try first to match addresses that look like
- ;; thompson@wg2.waii.com (Jim Thompson)
- ((string-match ".*[ \t]+(\\(.*\\))" fromstring)
- (substring fromstring (match-beginning 1) (match-end 1)))
-
- ;; Next try to match addresses that look like
- ;; Jim Thompson <thompson@wg2.waii.com> or
- ;; "Jim Thompson" <thompson@wg2.waii.com>
- ((string-match "\\(\"?\\)\\(.*\\)\\1[ \t]+<.*>" fromstring)
- (substring fromstring (match-beginning 2) (match-end 2)))
-
- ;; Couldn't find a real name -- show the address instead.
- (t fromstring)))
- "From ???")))
-
-;; A hook to bind to `gnus-article-prepare-hook'. This will set the
-;; `ps-left-headers' specially for gnus articles. Unfortunately,
-;; `gnus-article-mode-hook' is called only once, the first time the *Article*
-;; buffer enters that mode, so it would only work for the first time
-;; we ran gnus. The second time, this hook wouldn't get set up. The
-;; only alternative is `gnus-article-prepare-hook'.
-(defun ps-gnus-article-prepare-hook ()
- (setq ps-header-lines 3
- ps-left-header
- ;; The left headers will display the article's subject, its
- ;; author, and the newsgroup it was in.
- '(ps-article-subject ps-article-author gnus-newsgroup-name)))
-
-;; A hook to bind to `vm-mode-hook' to locally bind prsc and set the
-;; `ps-left-headers' specially for mail messages.
-(defun ps-vm-mode-hook ()
- (local-set-key [(f22)] 'ps-vm-print-message-from-summary)
- (setq ps-header-lines 3
- ps-left-header
- ;; The left headers will display the message's subject, its
- ;; author, and the name of the folder it was in.
- '(ps-article-subject ps-article-author buffer-name)))
-
-;; Every now and then I forget to switch from the *Summary* buffer to
-;; the *Article* before hitting prsc, and a nicely formatted list of
-;; article subjects shows up at the printer. This function, bound to
-;; prsc for the gnus *Summary* buffer means I don't have to switch
-;; buffers first.
-;; sb: Updated for Gnus 5.
-(defun ps-gnus-print-article-from-summary ()
- (interactive)
- (ps-print-message-from-summary 'gnus-article-buffer "*Article*"))
-
-;; See `ps-gnus-print-article-from-summary'. This function does the
-;; same thing for vm.
-(defun ps-vm-print-message-from-summary ()
- (interactive)
- (ps-print-message-from-summary 'vm-mail-buffer ""))
-
-;; A hook to bind to bind to `gnus-summary-setup-buffer' to locally bind
-;; prsc.
-(defun ps-gnus-summary-setup ()
- (local-set-key [(f22)] 'ps-gnus-print-article-from-summary))
-
-;; Look in an article or mail message for the Subject: line. To be
-;; placed in `ps-left-headers'.
-(defun ps-info-file ()
- (save-excursion
- (goto-char (point-min))
- (if (re-search-forward "File:[ \t]+\\([^, \t\n]*\\)" nil t)
- (buffer-substring (match-beginning 1) (match-end 1))
- "File ???")))
-
-;; Look in an article or mail message for the Subject: line. To be
-;; placed in `ps-left-headers'.
-(defun ps-info-node ()
- (save-excursion
- (goto-char (point-min))
- (if (re-search-forward "Node:[ \t]+\\([^,\t\n]*\\)" nil t)
- (buffer-substring (match-beginning 1) (match-end 1))
- "Node ???")))
-
-(defun ps-info-mode-hook ()
- (setq ps-left-header
- ;; The left headers will display the node name and file name.
- '(ps-info-node ps-info-file)))
-
-;; WARNING! The following function is a *sample* only, and is *not*
-;; meant to be used as a whole unless you understand what the effects
-;; will be! (In fact, this is a copy of Jim's setup for ps-print --
-;; I'd be very surprised if it was useful to *anybody*, without
-;; modification.)
-
-(defun ps-jts-ps-setup ()
- (global-set-key [(f22)] 'ps-spool-buffer-with-faces) ;f22 is prsc
- (global-set-key [(shift f22)] 'ps-spool-region-with-faces)
- (global-set-key [(control f22)] 'ps-despool)
- (add-hook 'gnus-article-prepare-hook 'ps-gnus-article-prepare-hook)
- (add-hook 'gnus-summary-mode-hook 'ps-gnus-summary-setup)
- (add-hook 'vm-mode-hook 'ps-vm-mode-hook)
- (add-hook 'vm-mode-hooks 'ps-vm-mode-hook)
- (add-hook 'Info-mode-hook 'ps-info-mode-hook)
- (setq ps-spool-duplex t
- ps-print-color-p nil
- ps-lpr-command "lpr"
- ps-lpr-switches '("-Jjct,duplex_long"))
- 'ps-jts-ps-setup)
-
-;; WARNING! The following function is a *sample* only, and is *not*
-;; meant to be used as a whole unless it corresponds to your needs.
-;; (In fact, this is a copy of Jack's setup for ps-print --
-;; I would not be that surprised if it was useful to *anybody*,
-;; without modification.)
-
-(defun ps-jack-setup ()
- (setq ps-print-color-p nil
- ps-lpr-command "lpr"
- ps-lpr-switches nil
-
- ps-paper-type 'a4
- ps-landscape-mode t
- ps-number-of-columns 2
-
- ps-left-margin (/ (* 72 1.0) 2.54) ; 1.0 cm
- ps-right-margin (/ (* 72 1.0) 2.54) ; 1.0 cm
- ps-inter-column (/ (* 72 1.0) 2.54) ; 1.0 cm
- ps-bottom-margin (/ (* 72 1.5) 2.54) ; 1.5 cm
- ps-top-margin (/ (* 72 1.5) 2.54) ; 1.5 cm
- ps-header-offset (/ (* 72 1.0) 2.54) ; 1.0 cm
- ps-header-line-pad .15
- ps-print-header t
- ps-print-header-frame t
- ps-header-lines 2
- ps-show-n-of-n t
- ps-spool-duplex nil
-
- ps-font-family 'Courier
- ps-font-size 5.5
- ps-header-font-family 'Helvetica
- ps-header-font-size 6
- ps-header-title-font-size 8)
- 'ps-jack-setup)
-
\f
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; To make this file smaller, some commands go in a separate file.
;; But autoload them here to make the separation invisible.
\f
-;;;### (autoloads (ps-mule-begin-page ps-mule-begin-job ps-mule-encode-header-string
-;;;;;; ps-mule-initialize ps-mule-plot-composition ps-mule-plot-string
-;;;;;; ps-mule-set-ascii-font ps-mule-prepare-ascii-font ps-multibyte-buffer)
-;;;;;; "ps-mule" "ps-mule.el" "586d0a4deeb89be9b80cc01def34481c")
+;;;### (autoloads (ps-mule-end-job ps-mule-begin-job ps-mule-initialize
+;;;;;; ps-multibyte-buffer) "ps-mule" "ps-mule.el" "ba0ba38bf1f9831ca12701290fd4b211")
;;; Generated autoloads from ps-mule.el
(defvar ps-multibyte-buffer nil "\
(custom-autoload 'ps-multibyte-buffer "ps-mule" t)
-(autoload 'ps-mule-prepare-ascii-font "ps-mule" "\
-Setup special ASCII font for STRING.
-STRING should contain only ASCII characters.
-
-\(fn STRING)" nil nil)
-
-(autoload 'ps-mule-set-ascii-font "ps-mule" "\
-Not documented
-
-\(fn)" nil nil)
-
-(autoload 'ps-mule-plot-string "ps-mule" "\
-Generate PostScript code for plotting characters in the region FROM and TO.
-
-It is assumed that all characters in this region belong to the same charset.
-
-Optional argument BG-COLOR specifies background color.
-
-Returns the value:
-
- (ENDPOS . RUN-WIDTH)
-
-Where ENDPOS is the end position of the sequence and RUN-WIDTH is the width of
-the sequence.
-
-\(fn FROM TO &optional BG-COLOR)" nil nil)
-
-(autoload 'ps-mule-plot-composition "ps-mule" "\
-Generate PostScript code for plotting composition in the region FROM and TO.
-
-It is assumed that all characters in this region belong to the same
-composition.
-
-Optional argument BG-COLOR specifies background color.
-
-Returns the value:
-
- (ENDPOS . RUN-WIDTH)
-
-Where ENDPOS is the end position of the sequence and RUN-WIDTH is the width of
-the sequence.
-
-\(fn FROM TO &optional BG-COLOR)" nil nil)
-
(autoload 'ps-mule-initialize "ps-mule" "\
Initialize global data for printing multi-byte characters.
\(fn)" nil nil)
-(autoload 'ps-mule-encode-header-string "ps-mule" "\
-Generate PostScript code for ploting STRING by font FONTTAG.
-FONTTAG should be a string \"/h0\" or \"/h1\".
-
-\(fn STRING FONTTAG)" nil nil)
-
(autoload 'ps-mule-begin-job "ps-mule" "\
Start printing job for multi-byte chars between FROM and TO.
It checks if all multi-byte characters in the region are printable or not.
\(fn FROM TO)" nil nil)
-(autoload 'ps-mule-begin-page "ps-mule" "\
-Not documented
+(autoload 'ps-mule-end-job "ps-mule" "\
+Finish printing job for multi-byte chars.
\(fn)" nil nil)
;;; ruler-mode.el --- display a ruler in the header line
;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006,
- ;; 2007 Free Software Foundation, Inc.
+ ;; 2007, 2008 Free Software Foundation, Inc.
;; Author: David Ponce <david@dponce.com>
;; Maintainer: David Ponce <david@dponce.com>
"Ensure WIDGET value is a valid character value."
(save-excursion
(let ((value (widget-value widget)))
- (if (char-valid-p value)
- nil
+ (unless (characterp value)
(widget-put widget :error
(format "Invalid character value: %S" value))
widget))))
;; Create an "clean" ruler.
(ruler
(propertize
- (make-string w ruler-mode-basic-graduation-char)
+ (string-to-multibyte
+ (make-string w ruler-mode-basic-graduation-char))
'face 'ruler-mode-default
'local-map ruler-mode-map
'help-echo (cond
;; Keywords: internal
;; Copyright (C) 1993, 1994, 2001, 2002, 2003, 2004,
- ;; 2005, 2006, 2007 Free Software Foundation, Inc.
+ ;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Based partially on earlier release by Lucid.
;; This file is part of GNU Emacs.
;;; Code:
+(defvar selection-coding-system nil
+ "Coding system for communicating with other X clients.
+
+When sending text via selection and clipboard, if the target
+data-type matches with the type of this coding system, it is used
+for encoding the text. Otherwise (including the case that this
+variable is nil), a proper coding system is used as below:
+
+data-type coding system
+--------- -------------
+UTF8_STRING utf-8
+COMPOUND_TEXT compound-text-with-extensions
+STRING iso-latin-1
+C_STRING no-conversion
+
+When receiving text, if this coding system is non-nil, it is used
+for decoding regardless of the data-type. If this is nil, a
+proper coding system is used according to the data-type as above.
+
+See also the documentation of the variable `x-select-request-type' how
+to control which data-type to request for receiving text.
+
+The default value is nil.")
+
+(defvar next-selection-coding-system nil
+ "Coding system for the next communication with other X clients.
+Usually, `selection-coding-system' is used for communicating with
+other X clients. But, if this variable is set, it is used for
+the next communication only. After the communication, this
+variable is set to nil.")
+
;; This is for temporary compatibility with pre-release Emacs 19.
(defalias 'x-selection 'x-get-selection)
(defun x-get-selection (&optional type data-type)
coding)
(when (and (stringp data)
(setq data-type (get-text-property 0 'foreign-selection data)))
- (setq coding (if (eq data-type 'UTF8_STRING)
- 'utf-8
- (or next-selection-coding-system
- selection-coding-system))
- data (decode-coding-string data coding))
+ (setq coding (or next-selection-coding-system
+ selection-coding-system
+ (cond ((eq data-type 'UTF8_STRING)
+ 'utf-8)
+ ((eq data-type 'COMPOUND-TEXT)
+ 'compound-text-with-extensions)
+ ((eq data-type 'C_STRING)
+ nil)
+ ((eq data-type 'STRING)
+ 'iso-8859-1)
+ (t
+ (error "Unknow selection data type: %S" type))))
+ data (if coding (decode-coding-string data coding)
+ (string-to-multibyte data)))
+ (setq next-selection-coding-system nil)
(put-text-property 0 (length data) 'foreign-selection data-type data))
data))
;;; Every selection type that Emacs handles is implemented this way, except
;;; for TIMESTAMP, which is a special case.
-(eval-when-compile (require 'ccl))
-
-(define-ccl-program ccl-check-utf-8
- '(0
- ((r0 = 1)
- (loop
- (read-if (r1 < #x80) (repeat)
- ((r0 = 0)
- (if (r1 < #xC2) (end))
- (read r2)
- (if ((r2 & #xC0) != #x80) (end))
- (if (r1 < #xE0) ((r0 = 1) (repeat)))
- (read r2)
- (if ((r2 & #xC0) != #x80) (end))
- (if (r1 < #xF0) ((r0 = 1) (repeat)))
- (read r2)
- (if ((r2 & #xC0) != #x80) (end))
- (if (r1 < #xF8) ((r0 = 1) (repeat)))
- (read r2)
- (if ((r2 & #xC0) != #x80) (end))
- (if (r1 == #xF8) ((r0 = 1) (repeat)))
- (end))))))
- "Check if the input unibyte string is a valid UTF-8 sequence or not.
-If it is valid, set the register `r0' to 1, else set it to 0.")
-
-(defun string-utf-8-p (string)
- "Return non-nil if STRING is a unibyte string of valid UTF-8 sequence."
- (if (or (not (stringp string))
- (multibyte-string-p string))
- (error "Not a unibyte string: %s" string))
- (let ((status (make-vector 9 0)))
- (ccl-execute-on-string ccl-check-utf-8 status string)
- (= (aref status 0) 1)))
-
-
(defun xselect-convert-to-string (selection type value)
(let (str coding)
;; Get the actual string from VALUE.
str
(setq coding (or next-selection-coding-system selection-coding-system))
(if coding
- (setq coding (coding-system-base coding))
- (setq coding 'raw-text))
+ (setq coding (coding-system-base coding)))
(let ((inhibit-read-only t))
;; Suppress producing escape sequences for compositions.
(remove-text-properties 0 (length str) '(composition nil) str)
- (cond
- ((eq type 'TEXT)
- (if (not (multibyte-string-p str))
- ;; Don't have to encode unibyte string.
- (setq type 'STRING)
- ;; If STR contains only ASCII, Latin-1, and raw bytes,
- ;; encode STR by iso-latin-1, and return it as type
- ;; `STRING'. Otherwise, encode STR by CODING. In that
- ;; case, the returing type depends on CODING.
- (let ((charsets (find-charset-string str)))
- (setq charsets
- (delq 'ascii
- (delq 'latin-iso8859-1
- (delq 'eight-bit-control
- (delq 'eight-bit-graphic charsets)))))
- (if charsets
- (setq str (encode-coding-string str coding)
- type (if (memq coding '(compound-text
- compound-text-with-extensions))
- 'COMPOUND_TEXT
- 'STRING))
- (setq type 'STRING
- str (encode-coding-string str 'iso-latin-1))))))
-
- ((eq type 'COMPOUND_TEXT)
- (setq str (encode-coding-string str coding)))
-
- ((eq type 'STRING)
- (if (memq coding '(compound-text
- compound-text-with-extensions))
- (setq str (string-make-unibyte str))
- (setq str (encode-coding-string str coding))))
-
- ((eq type 'UTF8_STRING)
- (if (multibyte-string-p str)
- (setq str (encode-coding-string str 'utf-8)))
- (if (not (string-utf-8-p str))
- (setq str nil))) ;; Decline request as we don't have UTF-8 data.
- (t
- (error "Unknow selection type: %S" type))
- )))
+ (if (not (multibyte-string-p str))
+ ;; Don't have to encode unibyte string.
+ (setq type 'C_STRING)
+ (if (eq type 'TEXT)
+ ;; TEXT is a polimorphic target. We must select the
+ ;; actual type from `UTF8_STRING', `COMPOUND_TEXT',
+ ;; `STRING', and `C_STRING'.
+ (let (non-latin-1 non-unicode eight-bit)
+ (mapc #'(lambda (x)
+ (if (>= x #x100)
+ (if (< x #x110000)
+ (setq non-latin-1 t)
+ (if (< x #x3FFF80)
+ (setq non-unicode t)
+ (setq eight-bit t)))))
+ str)
+ (setq type (if non-unicode 'COMPOUND_TEXT
+ (if non-latin-1 'UTF8_STRING
+ (if eight-bit 'C_STRING 'STRING))))))
+ (cond
+ ((eq type 'UTF8_STRING)
+ (if (or (not coding)
+ (not (eq (coding-system-type coding) 'utf-8)))
+ (setq coding 'utf-8))
+ (setq str (encode-coding-string str coding)))
+
+ ((eq type 'STRING)
+ (if (or (not coding)
+ (not (eq (coding-system-type coding) 'charset)))
+ (setq coding 'iso-8859-1))
+ (setq str (encode-coding-string str coding)))
+
+ ((eq type 'COMPOUND_TEXT)
+ (if (or (not coding)
+ (not (eq (coding-system-type coding) 'iso-2022)))
+ (setq coding 'compound-text-with-extensions))
+ (setq str (encode-coding-string str coding)))
+
+ ((eq type 'C_STRING)
+ (setq str (string-make-unibyte str)))
+
+ (t
+ (error "Unknow selection type: %S" type))
+ ))))
(setq next-selection-coding-system nil)
(cons type str))))
;;; simple.el --- basic editing commands for Emacs
;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- ;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ ;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
;; Free Software Foundation, Inc.
;; Maintainer: FSF
(if (or (not coding)
(eq (coding-system-type coding) t))
(setq coding default-buffer-file-coding-system))
- (if (not (char-valid-p char))
+ (if (eq (char-charset char) 'eight-bit)
(setq encoding-msg
- (format "(%d, #o%o, #x%x, invalid)" char char char))
+ (format "(%d, #o%o, #x%x, raw-byte)" char char char))
;; Check if the character is displayed with some `display'
;; text property. In that case, set under-display to the
;; buffer substring covered by that property.
;;; skeleton.el --- Lisp language extension for writing statement skeletons
;; Copyright (C) 1993, 1994, 1995, 1996, 2001, 2002, 2003,
- ;; 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ ;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Daniel Pfeiffer <occitan@esperanto.org>
;; Maintainer: FSF
(defun skeleton-internal-1 (element &optional literal recursive)
(cond
- ((char-or-string-p element)
+ ((or (integerp element) (stringp element))
(if (and (integerp element) ; -num
(< element 0))
(if skeleton-untabify
;;; startup.el --- process Emacs shell arguments
;; Copyright (C) 1985, 1986, 1992, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
- ;; 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ ;; 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
+ ;; Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: internal
(custom-reevaluate-setting 'file-name-shadow-mode)
(custom-reevaluate-setting 'send-mail-function)
(custom-reevaluate-setting 'focus-follows-mouse)
+ (custom-reevaluate-setting 'global-auto-composition-mode)
(normal-erase-is-backspace-setup-frame)
(dolist (text fancy-about-text)
(apply #'fancy-splash-insert text)
(insert "\n"))
- (unless (current-message)
- (message "%s" (or fancy-splash-help-echo "")))
(set-buffer-modified-p nil)
(goto-char (point-min))
(force-mode-line-update))
;;; subr.el --- basic lisp subroutines for Emacs
;; Copyright (C) 1985, 1986, 1992, 1994, 1995, 1999, 2000, 2001, 2002, 2003,
- ;; 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ ;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: internal
;; Filter out integers too large to be events.
;; M is the biggest modifier.
(zerop (logand obj (lognot (1- (lsh ?\M-\^@ 1)))))
- (char-valid-p (event-basic-type obj)))
+ (characterp (event-basic-type obj)))
(and (symbolp obj)
(get obj 'event-symbol-elements))
(and (consp obj)
;;; tar-mode.el --- simple editing of tar files from GNU emacs
;; Copyright (C) 1990, 1991, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- ;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ ;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Jamie Zawinski <jwz@lucid.com>
;; Maintainer: FSF
:group 'tar)
(defvar tar-parse-info nil)
-;; Be sure that this variable holds byte position, not char position.
(defvar tar-header-offset nil)
(defvar tar-superior-buffer nil)
(defvar tar-superior-descriptor nil)
(defvar tar-subfile-mode nil)
+(defvar tar-file-name-coding-system nil)
(put 'tar-parse-info 'permanent-local t)
(put 'tar-header-offset 'permanent-local t)
(put 'tar-superior-buffer 'permanent-local t)
(put 'tar-superior-descriptor 'permanent-local t)
+(put 'tar-file-name-coding-system 'permanent-local t)
\f
(defmacro tar-setf (form val)
"A mind-numbingly simple implementation of setf."
"Return a `tar-header' structure.
This is a list of name, mode, uid, gid, size,
write-date, checksum, link-type, and link-name."
+ (setq string (string-as-unibyte string))
(cond ((< (length string) 512) nil)
(;(some 'plusp string) ; <-- oops, massive cycle hog!
(or (not (= 0 (aref string 0))) ; This will do.
(setq linkname (substring string tar-link-offset link-end))
(if default-enable-multibyte-characters
(setq name
- (decode-coding-string name
- (or file-name-coding-system
- default-file-name-coding-system
- 'undecided))
+ (decode-coding-string name tar-file-name-coding-system)
linkname
(decode-coding-string linkname
- (or file-name-coding-system
- default-file-name-coding-system
- 'undecided))))
+ tar-file-name-coding-system)))
(if (and (null link-p) (string-match "/\\'" name)) (setq link-p 5)) ; directory
(make-tar-header
name
(defun tar-header-block-checksum (string)
"Compute and return a tar-acceptable checksum for this block."
+ (setq string (string-as-unibyte string))
(let* ((chk-field-start tar-chk-offset)
(chk-field-end (+ chk-field-start 8))
(sum 0)
(unless (file-directory-p name)
(write-region start end name))
(set-file-modes name (tar-header-mode tokens))))))
- (set-buffer-multibyte multibyte))))
+ (if multibyte
+ (set-buffer-multibyte 'to)))))
(defun tar-summarize-buffer ()
"Parse the contents of the tar file in the current buffer.
(if (< size 0)
(error "%s has size %s - corrupted"
(tar-header-name tokens) size))
- ;
- ; This is just too slow. Don't really need it anyway....
- ;(tar-header-block-check-checksum
- ; hblock (tar-header-block-checksum hblock)
- ; (tar-header-name tokens))
+ ;;
+ ;; This is just too slow. Don't really need it anyway....
+ ;;(tar-header-block-check-checksum
+ ;; hblock (tar-header-block-checksum hblock)
+ ;; (tar-header-name tokens))
(push (make-tar-desc pos tokens) result)
(> size 0)
(setq pos
(+ pos 512 (ash (ash (1- size) -9) 9)) ; this works
- ;(+ pos (+ size (- 512 (rem (1- size) 512)))) ; this doesn't
+ ;;(+ pos (+ size (- 512 (rem (1- size) 512)))) ; this doesn't
))))
(make-local-variable 'tar-parse-info)
(setq tar-parse-info (nreverse result))
(if (eq tokens 'empty-tar-block)
(progress-reporter-done progress-reporter)
(message "Warning: premature EOF parsing tar file")))
- (set-buffer-multibyte default-enable-multibyte-characters)
+ ;; Obey the user's preference for the use of uni/multibytes.
+ (if default-enable-multibyte-characters
+ (set-buffer-multibyte 'to))
(goto-char (point-min))
- (let ((inhibit-read-only t))
- ;; Collect summary lines and insert them all at once since tar files
- ;; can be pretty big.
- (let ((total-summaries
- (mapconcat
- (lambda (tar-desc)
- (tar-header-block-summarize (tar-desc-tokens tar-desc)))
- tar-parse-info
- "\n")))
- (insert total-summaries "\n"))
- (narrow-to-region (point-min) (point))
- (set (make-local-variable 'tar-header-offset) (position-bytes (point)))
- (goto-char (point-min))
- (restore-buffer-modified-p modified))))
+ (let ((inhibit-read-only t)
+ ;; Collect summary lines and insert them all at once since tar files
+ ;; can be pretty big.
+ (total-summaries
+ (mapconcat
+ (lambda (tar-desc)
+ (tar-header-block-summarize (tar-desc-tokens tar-desc)))
+ tar-parse-info
+ "\n")))
+ (insert total-summaries "\n"))
+ (narrow-to-region (point-min) (point))
+ (set (make-local-variable 'tar-header-offset) (position-bytes (point)))
+ (goto-char (point-min))
+ (restore-buffer-modified-p modified)))
\f
(defvar tar-mode-map
(let ((map (make-keymap)))
(define-key map "M" 'tar-chmod-entry)
(define-key map "G" 'tar-chgrp-entry)
(define-key map "O" 'tar-chown-entry)
-
+\f
;; Make menu bar items.
;; Get rid of the Edit menu bar item to save space.
(define-key map [menu-bar edit] 'undefined)
(define-key map [menu-bar immediate]
- (cons "Immediate" (make-sparse-keymap "Immediate")))
+ (cons "Immediate" (make-sparse-keymap "Immediate")))
(define-key map [menu-bar immediate view]
- '("View This File" . tar-view))
+ '("View This File" . tar-view))
(define-key map [menu-bar immediate display]
- '("Display in Other Window" . tar-display-other-window))
+ '("Display in Other Window" . tar-display-other-window))
(define-key map [menu-bar immediate find-file-other-window]
- '("Find in Other Window" . tar-extract-other-window))
+ '("Find in Other Window" . tar-extract-other-window))
(define-key map [menu-bar immediate find-file]
- '("Find This File" . tar-extract))
+ '("Find This File" . tar-extract))
(define-key map [menu-bar mark]
- (cons "Mark" (make-sparse-keymap "Mark")))
+ (cons "Mark" (make-sparse-keymap "Mark")))
(define-key map [menu-bar mark unmark-all]
- '("Unmark All" . tar-clear-modification-flags))
+ '("Unmark All" . tar-clear-modification-flags))
(define-key map [menu-bar mark deletion]
- '("Flag" . tar-flag-deleted))
+ '("Flag" . tar-flag-deleted))
(define-key map [menu-bar mark unmark]
- '("Unflag" . tar-unflag))
+ '("Unflag" . tar-unflag))
(define-key map [menu-bar operate]
- (cons "Operate" (make-sparse-keymap "Operate")))
+ (cons "Operate" (make-sparse-keymap "Operate")))
(define-key map [menu-bar operate chown]
- '("Change Owner..." . tar-chown-entry))
+ '("Change Owner..." . tar-chown-entry))
(define-key map [menu-bar operate chgrp]
- '("Change Group..." . tar-chgrp-entry))
+ '("Change Group..." . tar-chgrp-entry))
(define-key map [menu-bar operate chmod]
- '("Change Mode..." . tar-chmod-entry))
+ '("Change Mode..." . tar-chmod-entry))
(define-key map [menu-bar operate rename]
- '("Rename to..." . tar-rename-entry))
+ '("Rename to..." . tar-rename-entry))
(define-key map [menu-bar operate copy]
- '("Copy to..." . tar-copy))
+ '("Copy to..." . tar-copy))
(define-key map [menu-bar operate expunge]
- '("Expunge Marked Files" . tar-expunge))
-
+ '("Expunge Marked Files" . tar-expunge))
+\f
map)
"Local keymap for Tar mode listings.")
(set (make-local-variable 'revert-buffer-function) 'tar-mode-revert)
(set (make-local-variable 'local-enable-local-variables) nil)
(set (make-local-variable 'next-line-add-newlines) nil)
+ (set (make-local-variable 'tar-file-name-coding-system)
+ (or file-name-coding-system
+ default-file-name-coding-system
+ locale-coding-system))
;; Prevent loss of data when saving the file.
(set (make-local-variable 'file-precious-flag) t)
(auto-save-mode 0)
(buffer-disable-undo)
(widen)
(if (and (boundp 'tar-header-offset) tar-header-offset)
- (narrow-to-region (point-min) (byte-to-position tar-header-offset))
+ (narrow-to-region (point-min) tar-header-offset)
(tar-summarize-buffer)
(tar-next-line 0)))
(- tar-header-offset (point-min))))
(end (+ start size)))
(let* ((tar-buffer (current-buffer))
- (tar-buffer-multibyte enable-multibyte-characters)
(tarname (buffer-name))
(bufname (concat (file-name-nondirectory name)
" ("
;; `:' is not allowed on Windows
(concat tarname "!" name)))
(buffer (get-file-buffer new-buffer-file-name))
- (just-created nil))
+ (just-created nil)
+ (pos (point))
+ undo-list)
(unless buffer
(setq buffer (generate-new-buffer bufname))
+ (save-excursion
+ (set-buffer buffer)
+ (setq undo-list buffer-undo-list
+ buffer-undo-list t))
(setq bufname (buffer-name buffer))
(setq just-created t)
(unwind-protect
- (progn
+ (let (coding)
+ (narrow-to-region start end)
+ (goto-char start)
+ (setq coding (or coding-system-for-read
+ (and set-auto-coding-function
+ (funcall set-auto-coding-function
+ name (- end start)))
+ ;; The following binding causes
+ ;; find-buffer-file-type-coding-system
+ ;; (defined on dos-w32.el) to act as if
+ ;; the file being extracted existed, so
+ ;; that the file's contents' encoding and
+ ;; EOL format are auto-detected.
+ (let ((file-name-handler-alist
+ '(("" . tar-file-name-handler))))
+ (car (find-operation-coding-system
+ 'insert-file-contents
+ (cons name (current-buffer)) t)))))
+ (if (or (not coding)
+ (eq (coding-system-type coding) 'undecided))
+ (setq coding (detect-coding-region start end t)))
+ (if (and default-enable-multibyte-characters
+ (coding-system-get coding :for-unibyte))
+ (save-excursion
+ (set-buffer buffer)
+ (set-buffer-multibyte nil)))
(widen)
- (set-buffer-multibyte nil)
+ (decode-coding-region start end coding buffer)
(save-excursion
(set-buffer buffer)
- (let ((buffer-undo-list t))
- (if enable-multibyte-characters
- (progn
- ;; We must avoid unibyte->multibyte conversion.
- (set-buffer-multibyte nil)
- (insert-buffer-substring tar-buffer start end)
- (set-buffer-multibyte t))
- (insert-buffer-substring tar-buffer start end))
- (goto-char (point-min))
- (setq buffer-file-name new-buffer-file-name)
- (setq buffer-file-truename
- (abbreviate-file-name buffer-file-name))
- ;; We need to mimic the parts of insert-file-contents
- ;; which determine the coding-system and decode the text.
- (let ((coding
- (or coding-system-for-read
- (and set-auto-coding-function
- (save-excursion
- (funcall set-auto-coding-function
- name (- (point-max) (point)))))
- ;; The following binding causes
- ;; find-buffer-file-type-coding-system
- ;; (defined on dos-w32.el) to act as if
- ;; the file being extracted existed, so
- ;; that the file's contents' encoding and
- ;; EOL format are auto-detected.
- (let ((file-name-handler-alist
- '(("" . tar-file-name-handler))))
- (car (find-operation-coding-system
- 'insert-file-contents
- (cons name (current-buffer)) t)))))
- (multibyte enable-multibyte-characters)
- (detected (detect-coding-region
- (point-min)
- (min (+ (point-min) 16384) (point-max)) t)))
- (if coding
- (or (numberp (coding-system-eol-type coding))
- (vectorp (coding-system-eol-type detected))
- (setq coding (coding-system-change-eol-conversion
- coding
- (coding-system-eol-type detected))))
- (setq coding
- (find-new-buffer-file-coding-system detected)))
- (if (or (eq coding 'no-conversion)
- (eq (coding-system-type coding) 5))
- (setq multibyte (set-buffer-multibyte nil)))
- (or multibyte
- (setq coding
- (coding-system-change-text-conversion
- coding 'raw-text)))
- (decode-coding-region (point-min) (point-max) coding)
- ;; Force buffer-file-coding-system to what
- ;; decode-coding-region actually used.
- (set-buffer-file-coding-system last-coding-system-used t))
- ;; Set the default-directory to the dir of the
- ;; superior buffer.
- (setq default-directory
- (save-excursion
- (set-buffer tar-buffer)
- default-directory))
- (normal-mode) ; pick a mode.
- (rename-buffer bufname)
- (make-local-variable 'tar-superior-buffer)
- (make-local-variable 'tar-superior-descriptor)
- (setq tar-superior-buffer tar-buffer)
- (setq tar-superior-descriptor descriptor)
- (setq buffer-read-only read-only-p)
- (set-buffer-modified-p nil))
+ (goto-char (point-min))
+ (setq buffer-file-name new-buffer-file-name)
+ (setq buffer-file-truename
+ (abbreviate-file-name buffer-file-name))
+ ;; Force buffer-file-coding-system to what
+ ;; decode-coding-region actually used.
+ (set-buffer-file-coding-system last-coding-system-used t)
+ ;; Set the default-directory to the dir of the
+ ;; superior buffer.
+ (setq default-directory
+ (save-excursion
+ (set-buffer tar-buffer)
+ default-directory))
+ (normal-mode) ; pick a mode.
+ (rename-buffer bufname)
+ (make-local-variable 'tar-superior-buffer)
+ (make-local-variable 'tar-superior-descriptor)
+ (setq tar-superior-buffer tar-buffer)
+ (setq tar-superior-descriptor descriptor)
+ (setq buffer-read-only read-only-p)
+ (set-buffer-modified-p nil)
+ (setq buffer-undo-list undo-list)
(tar-subfile-mode 1))
(set-buffer tar-buffer))
(narrow-to-region (point-min) tar-header-offset)
- (set-buffer-multibyte tar-buffer-multibyte)))
+ (goto-char pos)))
(if view-p
(view-buffer buffer (and just-created 'kill-buffer))
(if (eq other-window-p 'display)
(start (+ (tar-desc-data-start descriptor)
(- tar-header-offset (point-min))))
(end (+ start size))
- (multibyte enable-multibyte-characters)
(inhibit-file-name-handlers inhibit-file-name-handlers)
(inhibit-file-name-operation inhibit-file-name-operation))
(save-restriction
(and (eq inhibit-file-name-operation 'write-region)
inhibit-file-name-handlers))
inhibit-file-name-operation 'write-region))
- (unwind-protect
- (let ((coding-system-for-write 'no-conversion))
- (set-buffer-multibyte nil)
- (write-region start end to-file nil nil nil t))
- (set-buffer-multibyte multibyte)))
+ (let ((coding-system-for-write 'no-conversion))
+ (write-region start end to-file nil nil nil t)))
(message "Copied tar entry %s to %s" name to-file)))
(defun tar-flag-deleted (p &optional unflag)
(tar-flag-deleted (- p) t))
-;; When this function is called, it is sure that the buffer is unibyte.
(defun tar-expunge-internal ()
"Expunge the tar-entry specified by the current line."
(let* ((descriptor (tar-current-descriptor))
(interactive)
(if (or noconfirm
(y-or-n-p "Expunge files marked for deletion? "))
- (let ((n 0)
- (multibyte enable-multibyte-characters))
+ (let ((n 0))
(save-excursion
- (widen)
- (set-buffer-multibyte nil)
(goto-char (point-min))
(while (not (eobp))
(if (looking-at "D")
(forward-line 1)))
;; after doing the deletions, add any padding that may be necessary.
(tar-pad-to-blocksize)
- (widen)
- (set-buffer-multibyte multibyte)
(narrow-to-region (point-min) tar-header-offset))
(if (zerop n)
(message "Nothing to expunge.")
(interactive)
(save-excursion
(goto-char (point-min))
- (while (< (position-bytes (point)) tar-header-offset)
+ (while (< (point) tar-header-offset)
(if (not (eq (following-char) ?\s))
(progn (delete-char 1) (insert " ")))
(forward-line 1))))
(list (read-string "New name: "
(tar-header-name (tar-desc-tokens (tar-current-descriptor))))))
(if (string= "" new-name) (error "zero length name"))
- (if (> (length new-name) 98) (error "name too long"))
- (tar-setf (tar-header-name (tar-desc-tokens (tar-current-descriptor)))
- new-name)
- (if (multibyte-string-p new-name)
- (setq new-name (encode-coding-string new-name
- (or file-name-coding-system
- default-file-name-coding-system))))
- (tar-alter-one-field 0
- (substring (concat new-name (make-string 99 0)) 0 99)))
+ (let ((encoded-new-name (encode-coding-string new-name
+ tar-file-name-coding-system)))
+ (if (> (length encoded-new-name) 98) (error "name too long"))
+ (tar-setf (tar-header-name (tar-desc-tokens (tar-current-descriptor)))
+ new-name)
+ (tar-alter-one-field 0
+ (substring (concat encoded-new-name (make-string 99 0)) 0 99))))
(defun tar-chmod-entry (new-mode)
(defun tar-alter-one-field (data-position new-data-string)
(let* ((descriptor (tar-current-descriptor))
- (tokens (tar-desc-tokens descriptor))
- (multibyte enable-multibyte-characters))
+ (tokens (tar-desc-tokens descriptor)))
(unwind-protect
(save-excursion
;;
(forward-line 1)
(delete-region p (point))
(insert (tar-header-block-summarize tokens) "\n")
- (setq tar-header-offset (position-bytes (point-max))))
+ (setq tar-header-offset (point-max)))
(widen)
- (set-buffer-multibyte nil)
(let* ((start (+ (tar-desc-data-start descriptor)
(- tar-header-offset (point-min))
-512)))
;; delete the old field and insert a new one.
(goto-char (+ start data-position))
(delete-region (point) (+ (point) (length new-data-string))) ; <--
- (insert new-data-string) ; <--
+
+ ;; As new-data-string is unibyte, just inserting it will
+ ;; make eight-bit chars to the corresponding multibyte
+ ;; chars. This avoid that conversion, i.e., eight-bit
+ ;; chars are converted to multibyte form of eight-bit
+ ;; chars.
+ (insert (string-to-multibyte new-data-string))
;;
;; compute a new checksum and insert it.
(let ((chk (tar-header-block-checksum
chk (tar-header-name tokens))
)))
(narrow-to-region (point-min) tar-header-offset)
- (set-buffer-multibyte multibyte)
(tar-next-line 0))))
(error "This buffer doesn't have an index into its superior tar file!"))
(save-excursion
(let ((subfile (current-buffer))
- (subfile-multibyte enable-multibyte-characters)
(coding buffer-file-coding-system)
(descriptor tar-superior-descriptor)
subfile-size)
- ;; We must make the current buffer unibyte temporarily to avoid
- ;; multibyte->unibyte conversion in `insert-buffer-substring'.
- (set-buffer-multibyte nil)
- (setq subfile-size (buffer-size))
(set-buffer tar-superior-buffer)
(let* ((tokens (tar-desc-tokens descriptor))
(start (tar-desc-data-start descriptor))
(size (tar-header-size tokens))
(size-pad (ash (ash (+ size 511) -9) 9))
(head (memq descriptor tar-parse-info))
- (following-descs (cdr head))
- (tar-buffer-multibyte enable-multibyte-characters))
+ (following-descs (cdr head)))
(if (not head)
(error "Can't find this tar file entry in its parent tar file!"))
(unwind-protect
(save-excursion
- (widen)
- (set-buffer-multibyte nil)
;; delete the old data...
(let* ((data-start (+ start (- tar-header-offset (point-min))))
(data-end (+ data-start (ash (ash (+ size 511) -9) 9))))
- (delete-region data-start data-end)
+ (narrow-to-region data-start data-end)
+ (delete-region (point-min) (point-max))
;; insert the new data...
(goto-char data-start)
- (insert-buffer-substring subfile)
- (setq subfile-size
- (encode-coding-region
- data-start (+ data-start subfile-size) coding))
+ (save-excursion
+ (set-buffer subfile)
+ (save-restriction
+ (widen)
+ (encode-coding-region 1 (point-max) coding tar-superior-buffer)))
+ (setq subfile-size (- (point-max) (point-min)))
;;
;; pad the new data out to a multiple of 512...
(let ((subfile-size-pad (ash (ash (+ subfile-size 511) -9) 9)))
- (goto-char (+ data-start subfile-size))
+ (goto-char (point-max))
(insert (make-string (- subfile-size-pad subfile-size) 0))
;;
;; update the data pointer of this and all following files...
(+ (tar-desc-data-start desc) difference))))
;;
;; Update the size field in the header block.
+ (widen)
(let ((header-start (- data-start 512)))
(goto-char (+ header-start tar-size-offset))
(delete-region (point) (+ (point) 12))
;; Insert the new text after the old, before deleting,
;; to preserve the window start.
(let ((line (tar-header-block-summarize tokens t)))
- (insert-before-markers (string-as-unibyte line) "\n"))
+ (insert-before-markers line "\n"))
(delete-region p after)
(setq tar-header-offset (marker-position m)))
)))
;; after doing the insertion, add any final padding that may be necessary.
(tar-pad-to-blocksize))
- (narrow-to-region (point-min) tar-header-offset)
- (set-buffer-multibyte tar-buffer-multibyte)))
+ (narrow-to-region (point-min) tar-header-offset)))
(set-buffer-modified-p t) ; mark the tar file as modified
(tar-next-line 0)
(set-buffer subfile)
- ;; Restore the buffer multibyteness.
- (set-buffer-multibyte subfile-multibyte)
(set-buffer-modified-p nil) ; mark the tar subfile as unmodified
(message "Saved into tar-buffer `%s'. Be sure to save that buffer!"
(buffer-name tar-superior-buffer))
;; tar-header-offset turns out to be null for files fetched with W3,
;; at least.
(let ((coding-system-for-write 'no-conversion))
- (write-region (if tar-header-offset
- (byte-to-position tar-header-offset)
- (point-min))
+ (write-region (or tar-header-offset
+ (point-min))
(point-max)
buffer-file-name nil t))
(tar-clear-modification-flags)
(set-buffer-modified-p nil))
- (narrow-to-region (point-min) (byte-to-position tar-header-offset)))
+ (narrow-to-region (point-min) tar-header-offset))
;; Return t because we've written the file.
t)
\f
;;; term.el --- general command interpreter in a window stuff
;; Copyright (C) 1988, 1990, 1992, 1994, 1995, 2001, 2002, 2003,
- ;; 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ ;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Per Bothner <per@bothner.com>
;; Maintainer: Dan Nicolaescu <dann@ics.uci.edu>, Per Bothner <per@bothner.com>
(unless (or (eq i ?O) (eq i 91))
(define-key esc-map (make-string 1 i) 'term-send-raw-meta))
(setq i (1+ i)))
- (dolist (elm (generic-character-list))
- (define-key map (vector elm) 'term-send-raw))
(define-key map "\e" esc-map)
(setq term-raw-map map)
(setq term-raw-escape-map
-;;; mac-win.el --- parse switches controlling interface with Mac window system -*-coding: iso-2022-7bit;-*-
+;;; mac-win.el --- parse switches controlling interface with Mac window system -*-coding: utf-8
;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004,
- ;; 2005, 2006, 2007 Free Software Foundation, Inc.
+ ;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Andrew Choi <akochoi@mac.com>
;; Keywords: terminals
(mac-add-charset-info "mac-dingbats" 34)
(mac-add-charset-info "iso10646-1" 126) ; for ATSUI
-(cp-make-coding-system
- mac-centraleurroman
- [?\\e,AD\e(B ?\\e$,1 \e(B ?\\e$,1 !\e(B ?\\e,AI\e(B ?\\e$,1 $\e(B ?\\e,AV\e(B ?\\e,A\\e(B ?\\e,Aa\e(B ?\\e$,1 %\e(B ?\\e$,1 ,\e(B ?\\e,Ad\e(B ?\\e$,1 -\e(B ?\\e$,1 &\e(B ?\\e$,1 '\e(B ?\\e,Ai\e(B ?\\e$,1!9\e(B
- ?\\e$,1!:\e(B ?\\e$,1 .\e(B ?\\e,Am\e(B ?\\e$,1 /\e(B ?\\e$,1 2\e(B ?\\e$,1 3\e(B ?\\e$,1 6\e(B ?\\e,As\e(B ?\\e$,1 7\e(B ?\\e,At\e(B ?\\e,Av\e(B ?\\e,Au\e(B ?\\e,Az\e(B ?\\e$,1 :\e(B ?\\e$,1 ;\e(B ?\\e,A|\e(B
- ?\\e$,1s \e(B ?\\e,A0\e(B ?\\e$,1 8\e(B ?\\e,A#\e(B ?\\e,A'\e(B ?\\e$,1s"\e(B ?\\e,A6\e(B ?\\e,A_\e(B ?\\e,A.\e(B ?\\e,A)\e(B ?\\e$,1ub\e(B ?\\e$,1 9\e(B ?\\e,A(\e(B ?\\e$,1y \e(B ?\\e$,1 C\e(B ?\\e$,1 N\e(B
- ?\\e$,1 O\e(B ?\\e$,1 J\e(B ?\\e$,1y$\e(B ?\\e$,1y%\e(B ?\\e$,1 K\e(B ?\\e$,1 V\e(B ?\\e$,1x"\e(B ?\\e$,1x1\e(B ?\\e$,1 b\e(B ?\\e$,1 [\e(B ?\\e$,1 \\e(B ?\\e$,1 ]\e(B ?\\e$,1 ^\e(B ?\\e$,1 Y\e(B ?\\e$,1 Z\e(B ?\\e$,1 e\e(B
- ?\\e$,1 f\e(B ?\\e$,1 c\e(B ?\\e,A,\e(B ?\\e$,1x:\e(B ?\\e$,1 d\e(B ?\\e$,1 g\e(B ?\\e$,1x&\e(B ?\\e,A+\e(B ?\\e,A;\e(B ?\\e$,1s&\e(B ?\\e,A \e(B ?\\e$,1 h\e(B ?\\e$,1 p\e(B ?\\e,AU\e(B ?\\e$,1 q\e(B ?\\e$,1 l\e(B
- ?\\e$,1rs\e(B ?\\e$,1rt\e(B ?\\e$,1r|\e(B ?\\e$,1r}\e(B ?\\e$,1rx\e(B ?\\e$,1ry\e(B ?\\e,Aw\e(B ?\\e$,2"*\e(B ?\\e$,1 m\e(B ?\\e$,1 t\e(B ?\\e$,1 u\e(B ?\\e$,1 x\e(B ?\\e$,1s9\e(B ?\\e$,1s:\e(B ?\\e$,1 y\e(B ?\\e$,1 v\e(B
- ?\\e$,1 w\e(B ?\\e$,1! \e(B ?\\e$,1rz\e(B ?\\e$,1r~\e(B ?\\e$,1!!\e(B ?\\e$,1 z\e(B ?\\e$,1 {\e(B ?\\e,AA\e(B ?\\e$,1!$\e(B ?\\e$,1!%\e(B ?\\e,AM\e(B ?\\e$,1!=\e(B ?\\e$,1!>\e(B ?\\e$,1!*\e(B ?\\e,AS\e(B ?\\e,AT\e(B
- ?\\e$,1!+\e(B ?\\e$,1!.\e(B ?\\e,AZ\e(B ?\\e$,1!/\e(B ?\\e$,1!0\e(B ?\\e$,1!1\e(B ?\\e$,1!2\e(B ?\\e$,1!3\e(B ?\\e,A]\e(B ?\\e,A}\e(B ?\\e$,1 W\e(B ?\\e$,1!;\e(B ?\\e$,1 a\e(B ?\\e$,1!<\e(B ?\\e$,1 B\e(B ?\\e$,1$g\e(B]
- "Mac Central European Roman Encoding (MIME:x-mac-centraleurroman).")
-(coding-system-put 'mac-centraleurroman 'mime-charset 'x-mac-centraleurroman)
-
-(cp-make-coding-system
- mac-cyrillic
- [?\\e$,1(0\e(B ?\\e$,1(1\e(B ?\\e$,1(2\e(B ?\\e$,1(3\e(B ?\\e$,1(4\e(B ?\\e$,1(5\e(B ?\\e$,1(6\e(B ?\\e$,1(7\e(B ?\\e$,1(8\e(B ?\\e$,1(9\e(B ?\\e$,1(:\e(B ?\\e$,1(;\e(B ?\\e$,1(<\e(B ?\\e$,1(=\e(B ?\\e$,1(>\e(B ?\\e$,1(?\e(B
- ?\\e$,1(@\e(B ?\\e$,1(A\e(B ?\\e$,1(B\e(B ?\\e$,1(C\e(B ?\\e$,1(D\e(B ?\\e$,1(E\e(B ?\\e$,1(F\e(B ?\\e$,1(G\e(B ?\\e$,1(H\e(B ?\\e$,1(I\e(B ?\\e$,1(J\e(B ?\\e$,1(K\e(B ?\\e$,1(L\e(B ?\\e$,1(M\e(B ?\\e$,1(N\e(B ?\\e$,1(O\e(B
- ?\\e$,1s \e(B ?\\e,A0\e(B ?\\e$,1)P\e(B ?\\e,A#\e(B ?\\e,A'\e(B ?\\e$,1s"\e(B ?\\e,A6\e(B ?\\e$,1(&\e(B ?\\e,A.\e(B ?\\e,A)\e(B ?\\e$,1ub\e(B ?\\e$,1("\e(B ?\\e$,1(r\e(B ?\\e$,1y \e(B ?\\e$,1(#\e(B ?\\e$,1(s\e(B
- ?\\e$,1x>\e(B ?\\e,A1\e(B ?\\e$,1y$\e(B ?\\e$,1y%\e(B ?\\e$,1(v\e(B ?\\e,A5\e(B ?\\e$,1)Q\e(B ?\\e$,1((\e(B ?\\e$,1($\e(B ?\\e$,1(t\e(B ?\\e$,1('\e(B ?\\e$,1(w\e(B ?\\e$,1()\e(B ?\\e$,1(y\e(B ?\\e$,1(*\e(B ?\\e$,1(z\e(B
- ?\\e$,1(x\e(B ?\\e$,1(%\e(B ?\\e,A,\e(B ?\\e$,1x:\e(B ?\\e$,1!R\e(B ?\\e$,1xh\e(B ?\\e$,1x&\e(B ?\\e,A+\e(B ?\\e,A;\e(B ?\\e$,1s&\e(B ?\\e,A \e(B ?\\e$,1(+\e(B ?\\e$,1({\e(B ?\\e$,1(,\e(B ?\\e$,1(|\e(B ?\\e$,1(u\e(B
- ?\\e$,1rs\e(B ?\\e$,1rt\e(B ?\\e$,1r|\e(B ?\\e$,1r}\e(B ?\\e$,1rx\e(B ?\\e$,1ry\e(B ?\\e,Aw\e(B ?\\e$,1r~\e(B ?\\e$,1(.\e(B ?\\e$,1(~\e(B ?\\e$,1(/\e(B ?\\e$,1(\7f\e(B ?\\e$,1uV\e(B ?\\e$,1(!\e(B ?\\e$,1(q\e(B ?\\e$,1(o\e(B
- ?\\e$,1(P\e(B ?\\e$,1(Q\e(B ?\\e$,1(R\e(B ?\\e$,1(S\e(B ?\\e$,1(T\e(B ?\\e$,1(U\e(B ?\\e$,1(V\e(B ?\\e$,1(W\e(B ?\\e$,1(X\e(B ?\\e$,1(Y\e(B ?\\e$,1(Z\e(B ?\\e$,1([\e(B ?\\e$,1(\\e(B ?\\e$,1(]\e(B ?\\e$,1(^\e(B ?\\e$,1(_\e(B
- ?\\e$,1(`\e(B ?\\e$,1(a\e(B ?\\e$,1(b\e(B ?\\e$,1(c\e(B ?\\e$,1(d\e(B ?\\e$,1(e\e(B ?\\e$,1(f\e(B ?\\e$,1(g\e(B ?\\e$,1(h\e(B ?\\e$,1(i\e(B ?\\e$,1(j\e(B ?\\e$,1(k\e(B ?\\e$,1(l\e(B ?\\e$,1(m\e(B ?\\e$,1(n\e(B ?\\e$,1tL\e(B]
- "Mac Cyrillic Encoding (MIME:x-mac-cyrillic).")
-(coding-system-put 'mac-cyrillic 'mime-charset 'x-mac-cyrillic)
-
-(let
- ((encoding-vector
- (vconcat
- (make-vector 32 nil)
- ;; mac-symbol (32..126) -> emacs-mule mapping
- [?\ ?\! ?\\e$,1x \e(B ?\# ?\\e$,1x#\e(B ?\% ?\& ?\\e$,1x-\e(B ?\( ?\) ?\\e$,1x7\e(B ?\+ ?\, ?\\e$,1x2\e(B ?\. ?\/
- ?\0 ?\1 ?\2 ?\3 ?\4 ?\5 ?\6 ?\7 ?\8 ?\9 ?\: ?\; ?\< ?\= ?\> ?\?
- ?\\e$,1xe\e(B ?\\e$,1&q\e(B ?\\e$,1&r\e(B ?\\e$,1''\e(B ?\\e$,1&t\e(B ?\\e$,1&u\e(B ?\\e$,1'&\e(B ?\\e$,1&s\e(B ?\\e$,1&w\e(B ?\\e$,1&y\e(B ?\\e$,1'Q\e(B ?\\e$,1&z\e(B ?\\e$,1&{\e(B ?\\e$,1&|\e(B ?\\e$,1&}\e(B ?\\e$,1&\7f\e(B
- ?\\e$,1' \e(B ?\\e$,1&x\e(B ?\\e$,1'!\e(B ?\\e$,1'#\e(B ?\\e$,1'$\e(B ?\\e$,1'%\e(B ?\\e$,1'B\e(B ?\\e$,1')\e(B ?\\e$,1&~\e(B ?\\e$,1'(\e(B ?\\e$,1&v\e(B ?\[ ?\\e$,1xT\e(B ?\] ?\\e$,1ye\e(B ?\_
- ?\\e$,3bE\e(B ?\\e$,1'1\e(B ?\\e$,1'2\e(B ?\\e$,1'G\e(B ?\\e$,1'4\e(B ?\\e$,1'5\e(B ?\\e$,1'F\e(B ?\\e$,1'3\e(B ?\\e$,1'7\e(B ?\\e$,1'9\e(B ?\\e$,1'U\e(B ?\\e$,1':\e(B ?\\e$,1';\e(B ?\\e$,1'<\e(B ?\\e$,1'=\e(B ?\\e$,1'?\e(B
- ?\\e$,1'@\e(B ?\\e$,1'8\e(B ?\\e$,1'A\e(B ?\\e$,1'C\e(B ?\\e$,1'D\e(B ?\\e$,1'E\e(B ?\\e$,1'V\e(B ?\\e$,1'I\e(B ?\\e$,1'>\e(B ?\\e$,1'H\e(B ?\\e$,1'6\e(B ?\{ ?\| ?\} ?\\e$,1x\\e(B]
- (make-vector (- 160 127) nil)
- ;; mac-symbol (160..254) -> emacs-mule mapping
- ;; Mapping of the following characters are changed from the
- ;; original one:
- ;; 0xE2 0x00AE+0xF87F -> 0x00AE # REGISTERED SIGN, alternate: sans serif
- ;; 0xE3 0x00A9+0xF87F -> 0x00A9 # COPYRIGHT SIGN, alternate: sans serif
- ;; 0xE4 0x2122+0xF87F -> 0x2122 # TRADE MARK SIGN, alternate: sans serif
- [?\\e$,1tL\e(B ?\\e$,1'R\e(B ?\\e$,1s2\e(B ?\\e$,1y$\e(B ?\\e$,1sD\e(B ?\\e$,1x>\e(B ?\\e$,1!R\e(B ?\\e$,2#c\e(B ?\\e$,2#f\e(B ?\\e$,2#e\e(B ?\\e$,2#`\e(B ?\\e$,1vt\e(B ?\\e$,1vp\e(B ?\\e$,1vq\e(B ?\\e$,1vr\e(B ?\\e$,1vs\e(B
- ?\\e,A0\e(B ?\\e,A1\e(B ?\\e$,1s3\e(B ?\\e$,1y%\e(B ?\\e,AW\e(B ?\\e$,1x=\e(B ?\\e$,1x"\e(B ?\\e$,1s"\e(B ?\\e,Aw\e(B ?\\e$,1y \e(B ?\\e$,1y!\e(B ?\\e$,1xh\e(B ?\\e$,1s&\e(B ?\\e$,1|p\e(B ?\\e$,1|O\e(B ?\\e$,1w5\e(B
- ?\\e$,1uu\e(B ?\\e$,1uQ\e(B ?\\e$,1u\\e(B ?\\e$,1uX\e(B ?\\e$,1yW\e(B ?\\e$,1yU\e(B ?\\e$,1x%\e(B ?\\e$,1xI\e(B ?\\e$,1xJ\e(B ?\\e$,1yC\e(B ?\\e$,1yG\e(B ?\\e$,1yD\e(B ?\\e$,1yB\e(B ?\\e$,1yF\e(B ?\\e$,1x(\e(B ?\\e$,1x)\e(B
- ?\\e$,1x@\e(B ?\\e$,1x'\e(B ?\\e,A.\e(B ?\\e,A)\e(B ?\\e$,1ub\e(B ?\\e$,1x/\e(B ?\\e$,1x:\e(B ?\\e$,1z%\e(B ?\\e,A,\e(B ?\\e$,1xG\e(B ?\\e$,1xH\e(B ?\\e$,1wT\e(B ?\\e$,1wP\e(B ?\\e$,1wQ\e(B ?\\e$,1wR\e(B ?\\e$,1wS\e(B
- ?\\e$,2"*\e(B ?\\e$,2=H\e(B ?\\e,A.\e(B ?\\e,A)\e(B ?\\e$,1ub\e(B ?\\e$,1x1\e(B ?\\e$,1|;\e(B ?\\e$,1|<\e(B ?\\e$,1|=\e(B ?\\e$,1|A\e(B ?\\e$,1|B\e(B ?\\e$,1|C\e(B ?\\e$,1|G\e(B ?\\e$,1|H\e(B ?\\e$,1|I\e(B ?\\e$,1|J\e(B
- ?\\e$,3b_\e(B ?\\e$,2=I\e(B ?\\e$,1xK\e(B ?\\e$,1{ \e(B ?\\e$,1|N\e(B ?\\e$,1{!\e(B ?\\e$,1|>\e(B ?\\e$,1|?\e(B ?\\e$,1|@\e(B ?\\e$,1|D\e(B ?\\e$,1|E\e(B ?\\e$,1|F\e(B ?\\e$,1|K\e(B ?\\e$,1|L\e(B ?\\e$,1|M\e(B
- nil]))
- translation-table)
- (setq translation-table
- (make-translation-table-from-vector encoding-vector))
-;; (define-translation-table 'mac-symbol-decoder translation-table)
- (define-translation-table 'mac-symbol-encoder
- (char-table-extra-slot translation-table 0)))
-
-(let
- ((encoding-vector
- (vconcat
- (make-vector 32 nil)
- ;; mac-dingbats (32..126) -> emacs-mule mapping
- [?\ ?\\e$,2%A\e(B ?\\e$,2%B\e(B ?\\e$,2%C\e(B ?\\e$,2%D\e(B ?\\e$,2"n\e(B ?\\e$,2%F\e(B ?\\e$,2%G\e(B ?\\e$,2%H\e(B ?\\e$,2%I\e(B ?\\e$,2"{\e(B ?\\e$,2"~\e(B ?\\e$,2%L\e(B ?\\e$,2%M\e(B ?\\e$,2%N\e(B ?\\e$,2%O\e(B
- ?\\e$,2%P\e(B ?\\e$,2%Q\e(B ?\\e$,2%R\e(B ?\\e$,2%S\e(B ?\\e$,2%T\e(B ?\\e$,2%U\e(B ?\\e$,2%V\e(B ?\\e$,2%W\e(B ?\\e$,2%X\e(B ?\\e$,2%Y\e(B ?\\e$,2%Z\e(B ?\\e$,2%[\e(B ?\\e$,2%\\e(B ?\\e$,2%]\e(B ?\\e$,2%^\e(B ?\\e$,2%_\e(B
- ?\\e$,2%`\e(B ?\\e$,2%a\e(B ?\\e$,2%b\e(B ?\\e$,2%c\e(B ?\\e$,2%d\e(B ?\\e$,2%e\e(B ?\\e$,2%f\e(B ?\\e$,2%g\e(B ?\\e$,2"e\e(B ?\\e$,2%i\e(B ?\\e$,2%j\e(B ?\\e$,2%k\e(B ?\\e$,2%l\e(B ?\\e$,2%m\e(B ?\\e$,2%n\e(B ?\\e$,2%o\e(B
- ?\\e$,2%p\e(B ?\\e$,2%q\e(B ?\\e$,2%r\e(B ?\\e$,2%s\e(B ?\\e$,2%t\e(B ?\\e$,2%u\e(B ?\\e$,2%v\e(B ?\\e$,2%w\e(B ?\\e$,2%x\e(B ?\\e$,2%y\e(B ?\\e$,2%z\e(B ?\\e$,2%{\e(B ?\\e$,2%|\e(B ?\\e$,2%}\e(B ?\\e$,2%~\e(B ?\\e$,2%\7f\e(B
- ?\\e$,2& \e(B ?\\e$,2&!\e(B ?\\e$,2&"\e(B ?\\e$,2&#\e(B ?\\e$,2&$\e(B ?\\e$,2&%\e(B ?\\e$,2&&\e(B ?\\e$,2&'\e(B ?\\e$,2&(\e(B ?\\e$,2&)\e(B ?\\e$,2&*\e(B ?\\e$,2&+\e(B ?\\e$,2"/\e(B ?\\e$,2&-\e(B ?\\e$,2!`\e(B ?\\e$,2&/\e(B
- ?\\e$,2&0\e(B ?\\e$,2&1\e(B ?\\e$,2&2\e(B ?\\e$,2!r\e(B ?\\e$,2!|\e(B ?\\e$,2"&\e(B ?\\e$,2&6\e(B ?\\e$,2"7\e(B ?\\e$,2&8\e(B ?\\e$,2&9\e(B ?\\e$,2&:\e(B ?\\e$,2&;\e(B ?\\e$,2&<\e(B ?\\e$,2&=\e(B ?\\e$,2&>\e(B
- nil
- ;; mac-dingbats (128..141) -> emacs-mule mapping
- ?\\e$,2&H\e(B ?\\e$,2&I\e(B ?\\e$,2&J\e(B ?\\e$,2&K\e(B ?\\e$,2&L\e(B ?\\e$,2&M\e(B ?\\e$,2&N\e(B ?\\e$,2&O\e(B ?\\e$,2&P\e(B ?\\e$,2&Q\e(B ?\\e$,2&R\e(B ?\\e$,2&S\e(B ?\\e$,2&T\e(B ?\\e$,2&U\e(B]
- (make-vector (- 161 142) nil)
- ;; mac-dingbats (161..239) -> emacs-mule mapping
- [?\\e$,2&A\e(B ?\\e$,2&B\e(B ?\\e$,2&C\e(B ?\\e$,2&D\e(B ?\\e$,2&E\e(B ?\\e$,2&F\e(B ?\\e$,2&G\e(B ?\\e$,2#c\e(B ?\\e$,2#f\e(B ?\\e$,2#e\e(B ?\\e$,2#`\e(B ?\\e$,1~@\e(B ?\\e$,1~A\e(B ?\\e$,1~B\e(B ?\\e$,1~C\e(B
- ?\\e$,1~D\e(B ?\\e$,1~E\e(B ?\\e$,1~F\e(B ?\\e$,1~G\e(B ?\\e$,1~H\e(B ?\\e$,1~I\e(B ?\\e$,2&V\e(B ?\\e$,2&W\e(B ?\\e$,2&X\e(B ?\\e$,2&Y\e(B ?\\e$,2&Z\e(B ?\\e$,2&[\e(B ?\\e$,2&\\e(B ?\\e$,2&]\e(B ?\\e$,2&^\e(B ?\\e$,2&_\e(B
- ?\\e$,2&`\e(B ?\\e$,2&a\e(B ?\\e$,2&b\e(B ?\\e$,2&c\e(B ?\\e$,2&d\e(B ?\\e$,2&e\e(B ?\\e$,2&f\e(B ?\\e$,2&g\e(B ?\\e$,2&h\e(B ?\\e$,2&i\e(B ?\\e$,2&j\e(B ?\\e$,2&k\e(B ?\\e$,2&l\e(B ?\\e$,2&m\e(B ?\\e$,2&n\e(B ?\\e$,2&o\e(B
- ?\\e$,2&p\e(B ?\\e$,2&q\e(B ?\\e$,2&r\e(B ?\\e$,2&s\e(B ?\\e$,2&t\e(B ?\\e$,1vr\e(B ?\\e$,1vt\e(B ?\\e$,1vu\e(B ?\\e$,2&x\e(B ?\\e$,2&y\e(B ?\\e$,2&z\e(B ?\\e$,2&{\e(B ?\\e$,2&|\e(B ?\\e$,2&}\e(B ?\\e$,2&~\e(B ?\\e$,2&\7f\e(B
- ?\\e$,2' \e(B ?\\e$,2'!\e(B ?\\e$,2'"\e(B ?\\e$,2'#\e(B ?\\e$,2'$\e(B ?\\e$,2'%\e(B ?\\e$,2'&\e(B ?\\e$,2''\e(B ?\\e$,2'(\e(B ?\\e$,2')\e(B ?\\e$,2'*\e(B ?\\e$,2'+\e(B ?\\e$,2',\e(B ?\\e$,2'-\e(B ?\\e$,2'.\e(B ?\\e$,2'/\e(B
- nil
- ;; mac-dingbats (241..254) -> emacs-mule mapping
- ?\\e$,2'1\e(B ?\\e$,2'2\e(B ?\\e$,2'3\e(B ?\\e$,2'4\e(B ?\\e$,2'5\e(B ?\\e$,2'6\e(B ?\\e$,2'7\e(B ?\\e$,2'8\e(B ?\\e$,2'9\e(B ?\\e$,2':\e(B ?\\e$,2';\e(B ?\\e$,2'<\e(B ?\\e$,2'=\e(B ?\\e$,2'>\e(B
- nil]))
- translation-table)
- (setq translation-table
- (make-translation-table-from-vector encoding-vector))
-;; (define-translation-table 'mac-dingbats-decoder translation-table)
- (define-translation-table 'mac-dingbats-encoder
- (char-table-extra-slot translation-table 0)))
+(define-charset 'mac-centraleurroman
+ "Mac Central European Roman"
+ :short-name "Mac CE"
+ :ascii-compatible-p t
+ :code-space [0 255]
+ :map
+ (let ((tbl
+ [?\Ä ?\Ä€ ?\Ä ?\É ?\Ä„ ?\Ö ?\Ãœ ?\á ?\Ä… ?\ÄŒ ?\ä ?\Ä ?\Ć ?\ć ?\é ?\Ź
+ ?\ź ?\ÄŽ ?\à ?\Ä ?\Ä’ ?\Ä“ ?\Ä– ?\ó ?\Ä— ?\ô ?\ö ?\õ ?\ú ?\Äš ?\Ä› ?\ü
+ ?\†?\° ?\Ę ?\£ ?\§ ?\• ?\¶ ?\ß ?\® ?\© ?\™ ?\ę ?\¨ ?\≠?\ģ ?\Į
+ ?\į ?\Ī ?\≤ ?\≥ ?\ī ?\Ķ ?\∂ ?\∑ ?\ł ?\Ļ ?\ļ ?\Ľ ?\ľ ?\Ĺ ?\ĺ ?\Ņ
+ ?\ņ ?\Ń ?\¬ ?\√ ?\ń ?\Ň ?\∆ ?\« ?\» ?\… ?\ ?\ň ?\Š?\Õ ?\ő ?\Ō
+ ?\– ?\— ?\“ ?\†?\‘ ?\’ ?\÷ ?\◊ ?\Š?\Ŕ ?\ŕ ?\Ř ?\‹ ?\› ?\ř ?\Ŗ
+ ?\ŗ ?\Š?\‚ ?\„ ?\š ?\Ś ?\ś ?\à ?\Ť ?\ť ?\à ?\Ž ?\ž ?\Ū ?\Ó ?\Ô
+ ?\ū ?\Ů ?\Ú ?\ů ?\Ű ?\ű ?\Ų ?\ų ?\à ?\ý ?\ķ ?\Ż ?\Š?\ż ?\Ģ ?\ˇ])
+ (map (make-vector 512 nil)))
+ (or (= (length tbl) 128)
+ (error "Invalid vector length: %d" (length tbl)))
+ (dotimes (i 128)
+ (aset map (* i 2) i)
+ (aset map (1+ (* i 2)) i))
+ (dotimes (i 128)
+ (aset map (+ 256 (* i 2)) (+ 128 i))
+ (aset map (+ 256 (1+ (* i 2))) (aref tbl i)))
+ map))
+
+(define-coding-system 'mac-centraleurroman
+ "Mac Central European Roman Encoding (MIME:x-mac-centraleurroman)."
+ :coding-type 'charset
+ :mnemonic ?*
+ :charset-list '(mac-centraleurroman)
+ :mime-charset 'x-mac-centraleurroman)
+
+(define-charset 'mac-cyrillic
+ "Mac Cyrillic"
+ :short-name "Mac CYRILLIC"
+ :ascii-compatible-p t
+ :code-space [0 255]
+ :map
+ (let ((tbl
+ [?\Р?\Б ?\В ?\Г ?\Д ?\Е ?\Ж ?\З ?\И ?\Й ?\К ?\Л ?\М ?\Р?\О ?\П
+ ?\Р?\С ?\Т ?\У ?\Ф ?\Х ?\Ц ?\Ч ?\Ш ?\Щ ?\Ъ ?\Ы ?\Ь ?\Р?\Ю ?\Я
+ ?\†?\° ?\Ò ?\£ ?\§ ?\• ?\¶ ?\І ?\® ?\© ?\â„¢ ?\Ђ ?\Ñ’ ?\≠?\Ѓ ?\Ñ“
+ ?\∞ ?\± ?\≤ ?\≥ ?\і ?\µ ?\ґ ?\Ј ?\Є ?\є ?\Ї ?\ї ?\Љ ?\љ ?\Њ ?\њ
+ ?\ј ?\Ѕ ?\¬ ?\√ ?\ƒ ?\≈ ?\∆ ?\« ?\» ?\… ?\ ?\Ћ ?\ћ ?\Ќ ?\ќ ?\ѕ
+ ?\– ?\— ?\“ ?\†?\‘ ?\’ ?\÷ ?\„ ?\ÐŽ ?\Ñž ?\Ð ?\ÑŸ ?\â„– ?\Ð ?\Ñ‘ ?\Ñ
+ ?\а ?\б ?\в ?\г ?\д ?\е ?\ж ?\з ?\и ?\й ?\к ?\л ?\м ?\н ?\о ?\п
+ ?\Ñ€ ?\Ñ ?\Ñ‚ ?\у ?\Ñ„ ?\Ñ… ?\ц ?\ч ?\ш ?\щ ?\ÑŠ ?\Ñ‹ ?\ÑŒ ?\Ñ ?\ÑŽ ?\€])
+ (map (make-vector 512 nil)))
+ (or (= (length tbl) 128)
+ (error "Invalid vector length: %d" (length tbl)))
+ (dotimes (i 128)
+ (aset map (* i 2) i)
+ (aset map (1+ (* i 2)) i))
+ (dotimes (i 128)
+ (aset map (+ 256 (* i 2)) (+ 128 i))
+ (aset map (+ 256 (1+ (* i 2))) (aref tbl i)))
+ map))
+
+(define-coding-system 'mac-cyrillic
+ "Mac Cyrillic Encoding (MIME:x-mac-cyrillic)."
+ :coding-type 'charset
+ :mnemonic ?*
+ :charset-list '(mac-cyrillic)
+ :mime-charset 'x-mac-cyrillic)
+
+(define-charset 'mac-symbol
+ "Mac Symbol"
+ :short-name "Mac SYMBOL"
+ :code-space [32 254]
+ :map
+ (let ((tbl-32-126
+ [?\ ?\! ?\∀ ?\# ?\∃ ?\% ?\& ?\∠?\( ?\) ?\∗ ?\+ ?\, ?\− ?\. ?\/
+ ?\0 ?\1 ?\2 ?\3 ?\4 ?\5 ?\6 ?\7 ?\8 ?\9 ?\: ?\; ?\< ?\= ?\> ?\?
+ ?\≅ ?\Α ?\Β ?\Χ ?\Δ ?\Ε ?\Φ ?\Γ ?\Η ?\Ι ?\ϑ ?\Κ ?\Λ ?\Μ ?\Π?\Ο
+ ?\Π?\Θ ?\Ρ ?\Σ ?\Τ ?\Υ ?\ς ?\Ω ?\Ξ ?\Ψ ?\Ζ ?\[ ?\∴ ?\] ?\⊥ ?\_
+ ?\ ?\α ?\β ?\χ ?\δ ?\ε ?\φ ?\γ ?\η ?\ι ?\ϕ ?\κ ?\λ ?\μ ?\ν ?\ο
+ ?\Ï€ ?\θ ?\Ï ?\σ ?\Ï„ ?\Ï… ?\Ï– ?\ω ?\ξ ?\ψ ?\ζ ?\{ ?\| ?\} ?\∼])
+ (map-32-126 (make-vector (* (1+ (- 126 32)) 2) nil))
+ (tbl-160-254
+ ;; Mapping of the following characters are changed from the
+ ;; original one:
+ ;; 0xE2 0x00AE+0xF87F->0x00AE # REGISTERED SIGN, alternate: sans serif
+ ;; 0xE3 0x00A9+0xF87F->0x00A9 # COPYRIGHT SIGN, alternate: sans serif
+ ;; 0xE4 0x2122+0xF87F->0x2122 # TRADE MARK SIGN, alternate: sans serif
+ [?\€ ?\ϒ ?\′ ?\≤ ?\℠?\∞ ?\ƒ ?\♣ ?\♦ ?\♥ ?\♠?\↔ ?\↠?\↑ ?\→ ?\↓
+ ?\° ?\± ?\″ ?\≥ ?\× ?\∠?\∂ ?\• ?\÷ ?\≠?\≡ ?\≈ ?\… ?\â ?\⎯ ?\↵
+ ?\ℵ ?\ℑ ?\ℜ ?\℘ ?\⊗ ?\⊕ ?\∅ ?\∩ ?\∪ ?\⊃ ?\⊇ ?\⊄ ?\⊂ ?\⊆ ?\∈ ?\∉
+ ?\∠?\∇ ?\® ?\© ?\™ ?\∠?\√ ?\⋅ ?\¬ ?\∧ ?\∨ ?\⇔ ?\⇠?\⇑ ?\⇒ ?\⇓
+ ?\◊ ?\〈 ?\® ?\© ?\™ ?\∑ ?\⎛ ?\⎜ ?\⎠?\⎡ ?\⎢ ?\⎣ ?\⎧ ?\⎨ ?\⎩ ?\⎪
+ ?\ ?\〉 ?\∫ ?\⌠?\⎮ ?\⌡ ?\⎞ ?\⎟ ?\⎠?\⎤ ?\⎥ ?\⎦ ?\⎫ ?\⎬ ?\âŽ])
+ (map-160-254 (make-vector (* (1+ (- 254 160)) 2) nil)))
+ (dotimes (i (1+ (- 126 32)))
+ (aset map-32-126 (* i 2) (+ 32 i))
+ (aset map-32-126 (1+ (* i 2)) (aref tbl-32-126 i)))
+ (dotimes (i (1+ (- 254 160)))
+ (aset map-160-254 (* i 2) (+ 160 i))
+ (aset map-160-254 (1+ (* i 2)) (aref tbl-160-254 i)))
+ (vconcat map-32-126 map-160-254)))
+
+(define-charset 'mac-dingbats
+ "Mac Dingbats"
+ :short-name "Mac Dingbats"
+ :code-space [32 254]
+ :map
+ (let ((tbl-32-126
+ [?\ ?\✠?\✂ ?\✃ ?\✄ ?\☎ ?\✆ ?\✇ ?\✈ ?\✉ ?\☛ ?\☞ ?\✌ ?\✠?\✎ ?\âœ
+ ?\✠?\✑ ?\✒ ?\✓ ?\✔ ?\✕ ?\✖ ?\✗ ?\✘ ?\✙ ?\✚ ?\✛ ?\✜ ?\✠?\✞ ?\✟
+ ?\✠?\✡ ?\✢ ?\✣ ?\✤ ?\✥ ?\✦ ?\✧ ?\★ ?\✩ ?\✪ ?\✫ ?\✬ ?\✠?\✮ ?\✯
+ ?\✰ ?\✱ ?\✲ ?\✳ ?\✴ ?\✵ ?\✶ ?\✷ ?\✸ ?\✹ ?\✺ ?\✻ ?\✼ ?\✽ ?\✾ ?\✿
+ ?\†?\â ?\â‚ ?\⃠?\â„ ?\â… ?\↠?\⇠?\∠?\≠?\⊠?\â‹ ?\â— ?\â ?\â– ?\â
+ ?\â ?\â‘ ?\â’ ?\â–² ?\â–¼ ?\â—† ?\â– ?\â—— ?\☠?\â™ ?\âš ?\â› ?\✠?\â ?\âž])
+ (map-32-126 (make-vector (* (1+ (- 126 32)) 2) nil))
+ (tbl-128-141
+ [?\⨠?\â© ?\⪠?\â« ?\⬠?\â ?\â® ?\⯠?\â° ?\â± ?\â² ?\â³ ?\â´ ?\âµ])
+ (map-128-141 (make-vector (* (1+ (- 141 128)) 2) nil))
+ (tbl-161-239
+ [?\⡠?\⢠?\⣠?\⤠?\⥠?\⦠?\⧠?\♣ ?\♦ ?\♥ ?\♠?\①?\② ?\③ ?\④
+ ?\⑤ ?\â‘¥ ?\⑦ ?\⑧ ?\⑨ ?\â‘© ?\ⶠ?\â· ?\⸠?\â¹ ?\⺠?\â» ?\â¼ ?\â½ ?\â¾ ?\â¿
+ ?\➀ ?\âž ?\âž‚ ?\➃ ?\âž„ ?\âž… ?\➆ ?\➇ ?\➈ ?\➉ ?\➊ ?\âž‹ ?\➌ ?\âž ?\➎ ?\âž
+ ?\➠?\➑ ?\➒ ?\➓ ?\➔ ?\→ ?\↔ ?\↕ ?\➘ ?\➙ ?\➚ ?\➛ ?\➜ ?\➠?\➞ ?\➟
+ ?\➠?\➡ ?\➢ ?\➣ ?\➤ ?\➥ ?\➦ ?\➧ ?\➨ ?\➩ ?\➪ ?\➫ ?\➬ ?\➠?\➮ ?\➯])
+ (map-161-239 (make-vector (* (1+ (- 239 161)) 2) nil))
+ (tbl-241-254
+ [?\➱ ?\➲ ?\➳ ?\➴ ?\➵ ?\➶ ?\➷ ?\➸ ?\➹ ?\➺ ?\➻ ?\➼ ?\➽ ?\➾])
+ (map-241-254 (make-vector (* (1+ (- 254 241)) 2) nil)))
+ (dotimes (i (1+ (- 126 32)))
+ (aset map-32-126 (* i 2) (+ 32 i))
+ (aset map-32-126 (1+ (* i 2)) (aref tbl-32-126 i)))
+ (dotimes (i (1+ (- 141 128)))
+ (aset map-128-141 (* i 2) (+ 128 i))
+ (aset map-128-141 (1+ (* i 2)) (aref tbl-128-141 i)))
+ (dotimes (i (1+ (- 239 161)))
+ (aset map-161-239 (* i 2) (+ 161 i))
+ (aset map-161-239 (1+ (* i 2)) (aref tbl-161-239 i)))
+ (dotimes (i (1+ (- 254 241)))
+ (aset map-241-254 (* i 2) (+ 241 i))
+ (aset map-241-254 (1+ (* i 2)) (aref tbl-241-254 i)))
+ (vconcat map-32-126 map-128-141 map-161-239 map-241-254)))
(defconst mac-system-coding-system
(let ((base (or (cdr (assq mac-system-script-code
(setq str nil)
;; ASCII-only?
(unless (mac-code-convert-string data nil mac-text-encoding-ascii)
- (subst-char-in-string ?\x5c ?\\e(J\\e(B str t)
+ (subst-char-in-string ?\x5c ?\Â¥ str t)
(subst-char-in-string ?\x80 ?\\ str t)))))
(or str
(decode-coding-string data
(eq coding-system 'japanese-shift-jis-mac))
(setq encoding mac-text-encoding-mac-japanese-basic-variant)
(setq str (subst-char-in-string ?\\ ?\x80 str))
- (subst-char-in-string ?\\e(J\\e(B ?\x5c str t)
+ (subst-char-in-string ?\Â¥ ?\x5c str t)
;; ASCII-only?
(if (string-match "\\`[\x00-\x7f]*\\'" str)
(setq str nil)))
(or coding-system (setq coding-system mac-system-coding-system))
(prog1 (setq data (decode-coding-string data coding-system))
(when (eq (coding-system-base coding-system) 'japanese-shift-jis)
- ;; (subst-char-in-string ?\x5c ?\\e(J\\e(B data t)
+ ;; (subst-char-in-string ?\x5c ?\Â¥ data t)
(subst-char-in-string ?\x80 ?\\ data t))))
(defun mac-string-to-TEXT (string &optional coding-system)
(coding-system-change-eol-conversion coding-system 'mac))
(when (eq coding-system 'japanese-shift-jis-mac)
;; (setq string (subst-char-in-string ?\\ ?\x80 string))
- (setq string (subst-char-in-string ?\\e(J\\e(B ?\x5c string)))
+ (setq string (subst-char-in-string ?\Â¥ ?\x5c string)))
(encode-coding-string string coding-system))
(defun mac-furl-to-string (data)
(mac-dnd-drop-data event (selected-frame) window
(cdr item) (car item) action)))))
\f
-(defvar mac-font-encoder-list
- '(("mac-roman" mac-roman-encoder
- ccl-encode-mac-roman-font "%s")
- ("mac-centraleurroman" encode-mac-centraleurroman
- ccl-encode-mac-centraleurroman-font "%s ce")
- ("mac-cyrillic" encode-mac-cyrillic
- ccl-encode-mac-cyrillic-font "%s cy")
- ("mac-symbol" mac-symbol-encoder
- ccl-encode-mac-symbol-font "symbol")
- ("mac-dingbats" mac-dingbats-encoder
- ccl-encode-mac-dingbats-font "zapf dingbats")))
-
-(let ((encoder-list
- (mapcar (lambda (lst) (nth 1 lst)) mac-font-encoder-list))
- (charset-list
- '(latin-iso8859-2
- latin-iso8859-3 latin-iso8859-4
- cyrillic-iso8859-5 greek-iso8859-7 hebrew-iso8859-8
- latin-iso8859-9 latin-iso8859-14 latin-iso8859-15)))
- (dolist (encoder encoder-list)
- (let ((table (get encoder 'translation-table)))
- (dolist (charset charset-list)
- (dotimes (i 96)
- (let* ((c (make-char charset (+ i 32)))
- (mu (aref ucs-mule-to-mule-unicode c))
- (mac-encoded (and mu (aref table mu))))
- (if mac-encoded
- (aset table c mac-encoded))))))))
-
-;; We assume none of official dim2 charsets (0x90..0x99) are encoded
-;; to these fonts.
-
-(define-ccl-program ccl-encode-mac-roman-font
- `(0
- (if (r0 <= ?\xef)
- (translate-character mac-roman-encoder r0 r1)
- ((r1 <<= 7)
- (r1 |= r2)
- (translate-character mac-roman-encoder r0 r1))))
- "CCL program for Mac Roman font")
-
-(define-ccl-program ccl-encode-mac-centraleurroman-font
- `(0
- (if (r0 <= ?\xef)
- (translate-character encode-mac-centraleurroman r0 r1)
- ((r1 <<= 7)
- (r1 |= r2)
- (translate-character encode-mac-centraleurroman r0 r1))))
- "CCL program for Mac Central European Roman font")
-
-(define-ccl-program ccl-encode-mac-cyrillic-font
- `(0
- (if (r0 <= ?\xef)
- (translate-character encode-mac-cyrillic r0 r1)
- ((r1 <<= 7)
- (r1 |= r2)
- (translate-character encode-mac-cyrillic r0 r1))))
- "CCL program for Mac Cyrillic font")
-
-(define-ccl-program ccl-encode-mac-symbol-font
- `(0
- (if (r0 <= ?\xef)
- (translate-character mac-symbol-encoder r0 r1)
- ((r1 <<= 7)
- (r1 |= r2)
- (translate-character mac-symbol-encoder r0 r1))))
- "CCL program for Mac Symbol font")
-
-(define-ccl-program ccl-encode-mac-dingbats-font
- `(0
- (if (r0 <= ?\xef)
- (translate-character mac-dingbats-encoder r0 r1)
- ((r1 <<= 7)
- (r1 |= r2)
- (translate-character mac-dingbats-encoder r0 r1))))
- "CCL program for Mac Dingbats font")
-
-
-(setq font-ccl-encoder-alist
- (nconc
- (mapcar (lambda (lst) (cons (nth 0 lst) (nth 2 lst)))
- mac-font-encoder-list)
- font-ccl-encoder-alist))
-
-(defconst mac-char-fontspec-list
- ;; Directly operate on a char-table instead of a fontset so that it
- ;; may not create a dummy fontset.
- (let ((template (make-char-table 'fontset)))
- (dolist
- (font-encoder
- (nreverse
- (mapcar (lambda (lst)
- (cons (cons (nth 3 lst) (nth 0 lst)) (nth 1 lst)))
- mac-font-encoder-list)))
- (let ((font (car font-encoder))
- (encoder (cdr font-encoder)))
- (map-char-table
- (lambda (key val)
- (or (null val)
- (generic-char-p key)
- (memq (char-charset key)
- '(ascii eight-bit-control eight-bit-graphic))
- (aset template key font)))
- (get encoder 'translation-table))))
-
- ;; Like fontset-info, but extend a range only if its "to" part is
- ;; the predecessor of the current char.
- (let* ((last '((0 nil)))
- (accumulator last)
- last-char-or-range last-char last-elt)
- (map-char-table
- (lambda (char elt)
- (when elt
- (setq last-char-or-range (car (car last))
- last-char (if (consp last-char-or-range)
- (cdr last-char-or-range)
- last-char-or-range)
- last-elt (cdr (car last)))
- (if (and (eq elt last-elt)
- (= char (1+ last-char))
- (eq (char-charset char) (char-charset last-char)))
- (if (consp last-char-or-range)
- (setcdr last-char-or-range char)
- (setcar (car last) (cons last-char char)))
- (setcdr last (list (cons char elt)))
- (setq last (cdr last)))))
- template)
- (cdr accumulator))))
+(setq font-encoding-alist
+ (append
+ '(("mac-roman" . mac-roman)
+ ("mac-centraleurroman" . mac-centraleurroman)
+ ("mac-cyrillic" . mac-cyrillic)
+ ("mac-symbol" . mac-symbol)
+ ("mac-dingbats" . mac-dingbats))
+ font-encoding-alist))
(defun fontset-add-mac-fonts (fontset &optional base-family)
- "Add font-specs for Mac fonts to FONTSET.
-The added font-specs are determined by BASE-FAMILY and the value
-of `mac-char-fontspec-list', which is a list
-of (CHARACTER-OR-RANGE . (FAMILY-FORMAT . REGISTRY)). If
-BASE-FAMILY is nil, the font family in the added font-specs is
-also nil. If BASE-FAMILY is a string, `%s' in FAMILY-FORMAT is
-replaced with the string. Otherwise, `%s' in FAMILY-FORMAT is
-replaced with the ASCII font family name in FONTSET."
- (if base-family
- (if (stringp base-family)
- (setq base-family (downcase base-family))
- (let ((ascii-font (fontset-font fontset (charset-id 'ascii))))
- (if ascii-font
- (setq base-family
- (aref (x-decompose-font-name
- (downcase (x-resolve-font-name ascii-font)))
- xlfd-regexp-family-subnum))))))
- (let (fontspec-cache fontspec)
- (dolist (char-fontspec mac-char-fontspec-list)
- (setq fontspec (cdr (assq (cdr char-fontspec) fontspec-cache)))
- (when (null fontspec)
- (setq fontspec
- (cons (and base-family
- (format (car (cdr char-fontspec)) base-family))
- (cdr (cdr char-fontspec))))
- (setq fontspec-cache (cons (cons (cdr char-fontspec) fontspec)
- fontspec-cache)))
- (set-fontset-font fontset (car char-fontspec) fontspec))))
+ (dolist (elt `((latin . (,(or base-family "Monaco") . "mac-roman"))
+ (mac-roman . (,base-family . "mac-roman"))
+ (mac-centraleurroman . (,base-family . "mac-centraleurroman"))
+ (mac-cyrillic . (,base-family . "mac-cyrillic"))
+ (mac-symbol . (,base-family . "mac-symbol"))
+ (mac-dingbats . (,base-family . "mac-dingbats"))))
+ (set-fontset-font fontset (car elt) (cdr elt))))
(defun create-fontset-from-mac-roman-font (font &optional resolved-font
fontset-name)
an appropriate name is generated automatically.
It returns a name of the created fontset."
- (let ((fontset
- (create-fontset-from-ascii-font font resolved-font fontset-name)))
- (fontset-add-mac-fonts fontset t)
- fontset))
+ (or resolved-font
+ (setq resolved-font (x-resolve-font-name font)))
+ (let ((base-family (aref (x-decompose-font-name resolved-font)
+ xlfd-regexp-family-subnum)))
+ (if (string= base-family "*")
+ (setq base-family nil))
+ (new-fontset fontset-name (list (cons 'ascii resolved-font)))
+ (fontset-add-mac-fonts fontset-name base-family)))
(defun x-win-suspend-error ()
(error "Suspending an Emacs running under Mac makes no sense"))
;; Setup the default fontset.
(setup-default-fontset)
-(cond ((x-list-fonts "*-iso10646-1" nil nil 1)
- ;; Use ATSUI (if available) for the following charsets.
- (dolist
- (charset '(latin-iso8859-1
- latin-iso8859-2 latin-iso8859-3 latin-iso8859-4
- thai-tis620 greek-iso8859-7 arabic-iso8859-6
- hebrew-iso8859-8 cyrillic-iso8859-5
- latin-iso8859-9 latin-iso8859-15 latin-iso8859-14
- japanese-jisx0212 chinese-sisheng ipa
- vietnamese-viscii-lower vietnamese-viscii-upper
- lao ethiopic tibetan))
- (set-fontset-font nil charset '(nil . "iso10646-1"))))
- ((null (x-list-fonts "*-iso8859-1" nil nil 1))
- ;; Add Mac-encoding fonts unless ETL fonts are installed.
- (fontset-add-mac-fonts "fontset-default")))
;; Create a fontset that uses mac-roman font. With this fontset,
-;; characters decoded from mac-roman encoding (ascii, latin-iso8859-1,
-;; and mule-unicode-xxxx-yyyy) are displayed by a mac-roman font.
-(create-fontset-from-fontset-spec
- "-etl-fixed-medium-r-normal-*-16-*-*-*-*-*-fontset-standard,
-ascii:-*-Monaco-*-*-*-*-12-*-*-*-*-*-mac-roman")
-(fontset-add-mac-fonts "fontset-standard" t)
+;; characters belonging to mac-roman charset (that contains ASCII and
+;; more Latin characters) are displayed by a mac-roman font.
+(create-fontset-from-mac-roman-font
+ "-*-Monaco-*-*-*-*-12-*-*-*-*-*-mac-roman" nil
+ "-apple-Monaco-normal-r-*-*-12-*-*-*-*-*-fontset-standard")
;; Create fontset specified in X resources "Fontset-N" (N is 0, 1, ...).
(create-fontset-from-x-resource)
-;; Try to create a fontset from a font specification which comes
-;; from initial-frame-alist, default-frame-alist, or X resource.
-;; A font specification in command line argument (i.e. -fn XXXX)
-;; should be already in default-frame-alist as a `font'
-;; parameter. However, any font specifications in site-start
-;; library, user's init file (.emacs), and default.el are not
-;; yet handled here.
-
-(let ((font (or (cdr (assq 'font initial-frame-alist))
- (cdr (assq 'font default-frame-alist))
- (x-get-resource "font" "Font")))
- xlfd-fields resolved-name)
- (if (and font
- (not (query-fontset font))
- (setq resolved-name (x-resolve-font-name font))
- (setq xlfd-fields (x-decompose-font-name font)))
- (if (string= "fontset" (aref xlfd-fields xlfd-regexp-registry-subnum))
- (new-fontset font (x-complement-fontset-spec xlfd-fields nil))
- ;; Create a fontset from FONT. The fontset name is
- ;; generated from FONT.
- (if (and (string= "mac" (aref xlfd-fields xlfd-regexp-registry-subnum))
- (string= "roman" (aref xlfd-fields xlfd-regexp-encoding-subnum)))
- (create-fontset-from-mac-roman-font font resolved-name "startup")
- (create-fontset-from-ascii-font font resolved-name "startup")))))
-
;; Apply a geometry resource to the initial frame. Put it at the end
;; of the alist, so that anything specified on the command line takes
;; precedence.
;;; w32-win.el --- parse switches controlling interface with W32 window system
;; Copyright (C) 1993, 1994, 2001, 2002, 2003, 2004,
- ;; 2005, 2006, 2007 Free Software Foundation, Inc.
+ ;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Kevin Gallo
;; Keywords: terminals
(require 'select)
(require 'menu-bar)
(require 'dnd)
-(require 'code-pages)
(require 'w32-vars)
;; Keep an obsolete alias for w32-focus-frame in case it is used by code
;; Append list of fontsets currently defined.
;; Conditional on new-fontset so bootstrapping works on non-GUI compiles
(if (fboundp 'new-fontset)
- (append w32-fixed-font-alist (list (generate-fontset-menu)))))))
+ (append w32-fixed-font-alist (list (generate-fontset-menu)))))))
(if fonts
(let (font)
(while fonts
(setup-default-fontset)
;; Enable Japanese fonts on Windows to be used by default.
- (set-fontset-font nil (make-char 'katakana-jisx0201)
+ (set-fontset-font t (make-char 'katakana-jisx0201)
'("*" . "JISX0208-SJIS"))
- (set-fontset-font nil (make-char 'latin-jisx0201)
+ (set-fontset-font t (make-char 'latin-jisx0201)
'("*" . "JISX0208-SJIS"))
- (set-fontset-font nil (make-char 'japanese-jisx0208)
+ (set-fontset-font t (make-char 'japanese-jisx0208)
'("*" . "JISX0208-SJIS"))
- (set-fontset-font nil (make-char 'japanese-jisx0208-1978)
+ (set-fontset-font t (make-char 'japanese-jisx0208-1978)
'("*" . "JISX0208-SJIS"))
;; Create the standard fontset.
(create-fontset-from-fontset-spec w32-standard-fontset-spec t)
;; Create fontset specified in X resources "Fontset-N" (N is 0, 1,...).
(create-fontset-from-x-resource)
- ;; Try to create a fontset from a font specification which comes
- ;; from initial-frame-alist, default-frame-alist, or X resource.
- ;; A font specification in command line argument (i.e. -fn XXXX)
- ;; should be already in default-frame-alist as a `font'
- ;; parameter. However, any font specifications in site-start
- ;; library, user's init file (.emacs), and default.el are not
- ;; yet handled here.
-
- (let ((font (or (cdr (assq 'font initial-frame-alist))
- (cdr (assq 'font default-frame-alist))
- (x-get-resource "font" "Font")))
- xlfd-fields resolved-name)
- (if (and font
- (not (query-fontset font))
- (setq resolved-name (x-resolve-font-name font))
- (setq xlfd-fields (x-decompose-font-name font)))
- (if (string= "fontset"
- (aref xlfd-fields xlfd-regexp-registry-subnum))
- (new-fontset font
- (x-complement-fontset-spec xlfd-fields nil))
- ;; Create a fontset from FONT. The fontset name is
- ;; generated from FONT.
- (create-fontset-from-ascii-font font
- resolved-name "startup"))))
;; Apply a geometry resource to the initial frame. Put it at the end
;; of the alist, so that anything specified on the command line takes
;;; x-win.el --- parse relevant switches and set up for X -*-coding: iso-2022-7bit;-*-
;; Copyright (C) 1993, 1994, 2001, 2002, 2003, 2004,
- ;; 2005, 2006, 2007 Free Software Foundation, Inc.
+ ;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: FSF
;; Keywords: terminals, i18n
"Return the appropriate value of `system-key-alist' for VENDOR.
VENDOR is a string containing the name of the X Server's vendor,
as returned by `x-server-vendor'."
- ;; Fixme: Drop Apollo now?
- (cond ((string-equal vendor "Apollo Computer Inc.")
- '((65280 . linedel)
- (65281 . chardel)
- (65282 . copy)
- (65283 . cut)
- (65284 . paste)
- (65285 . move)
- (65286 . grow)
- (65287 . cmd)
- (65288 . shell)
- (65289 . leftbar)
- (65290 . rightbar)
- (65291 . leftbox)
- (65292 . rightbox)
- (65293 . upbox)
- (65294 . downbox)
- (65295 . pop)
- (65296 . read)
- (65297 . edit)
- (65298 . save)
- (65299 . exit)
- (65300 . repeat)))
- ((or (string-equal vendor "Hewlett-Packard Incorporated")
+ (cond ((or (string-equal vendor "Hewlett-Packard Incorporated")
(string-equal vendor "Hewlett-Packard Company"))
'(( 168 . mute-acute)
( 169 . mute-grave)
;; This is used by DEC's X server.
'((65280 . remove)))))
+;; Latin-1
(let ((i 160))
(while (< i 256)
- (puthash i (make-char 'latin-iso8859-1 i) x-keysym-table)
+ (puthash i i x-keysym-table)
(setq i (1+ i))))
;; Table from Kuhn's proposed additions to the `KEYSYM Encoding'
;; Kana: Fixme: needs conversion to Japanese charset -- seems
;; to require jisx0213, for which the Unicode translation
;; isn't clear.
- (#x47e . ?\e$,1s>\e(B)
- (#x4a1 . ?\e$,2=B\e(B)
- (#x4a2 . ?\\e$,2=L\e(B)
- (#x4a3 . ?\\e$,2=M\e(B)
- (#x4a4 . ?\e$,2=A\e(B)
- (#x4a5 . ?\e$,2?{\e(B)
- (#x4a6 . ?\e$,2?r\e(B)
- (#x4a7 . ?\e$,2?!\e(B)
- (#x4a8 . ?\e$,2?#\e(B)
- (#x4a9 . ?\e$,2?%\e(B)
- (#x4aa . ?\e$,2?'\e(B)
- (#x4ab . ?\e$,2?)\e(B)
- (#x4ac . ?\e$,2?c\e(B)
- (#x4ad . ?\e$,2?e\e(B)
- (#x4ae . ?\e$,2?g\e(B)
- (#x4af . ?\e$,2?C\e(B)
- (#x4b0 . ?\e$,2?|\e(B)
- (#x4b1 . ?\e$,2?"\e(B)
- (#x4b2 . ?\e$,2?$\e(B)
- (#x4b3 . ?\e$,2?&\e(B)
- (#x4b4 . ?\e$,2?(\e(B)
- (#x4b5 . ?\e$,2?*\e(B)
- (#x4b6 . ?\e$,2?+\e(B)
- (#x4b7 . ?\e$,2?-\e(B)
- (#x4b8 . ?\e$,2?/\e(B)
- (#x4b9 . ?\e$,2?1\e(B)
- (#x4ba . ?\e$,2?3\e(B)
- (#x4bb . ?\e$,2?5\e(B)
- (#x4bc . ?\e$,2?7\e(B)
- (#x4bd . ?\e$,2?9\e(B)
- (#x4be . ?\e$,2?;\e(B)
- (#x4bf . ?\e$,2?=\e(B)
- (#x4c0 . ?\e$,2??\e(B)
- (#x4c1 . ?\e$,2?A\e(B)
- (#x4c2 . ?\e$,2?D\e(B)
- (#x4c3 . ?\e$,2?F\e(B)
- (#x4c4 . ?\e$,2?H\e(B)
- (#x4c5 . ?\e$,2?J\e(B)
- (#x4c6 . ?\e$,2?K\e(B)
- (#x4c7 . ?\e$,2?L\e(B)
- (#x4c8 . ?\e$,2?M\e(B)
- (#x4c9 . ?\e$,2?N\e(B)
- (#x4ca . ?\e$,2?O\e(B)
- (#x4cb . ?\e$,2?R\e(B)
- (#x4cc . ?\e$,2?U\e(B)
- (#x4cd . ?\e$,2?X\e(B)
- (#x4ce . ?\e$,2?[\e(B)
- (#x4cf . ?\e$,2?^\e(B)
- (#x4d0 . ?\e$,2?_\e(B)
- (#x4d1 . ?\e$,2?`\e(B)
- (#x4d2 . ?\e$,2?a\e(B)
- (#x4d3 . ?\e$,2?b\e(B)
- (#x4d4 . ?\e$,2?d\e(B)
- (#x4d5 . ?\e$,2?f\e(B)
- (#x4d6 . ?\e$,2?h\e(B)
- (#x4d7 . ?\e$,2?i\e(B)
- (#x4d8 . ?\e$,2?j\e(B)
- (#x4d9 . ?\e$,2?k\e(B)
- (#x4da . ?\e$,2?l\e(B)
- (#x4db . ?\e$,2?m\e(B)
- (#x4dc . ?\e$,2?o\e(B)
- (#x4dd . ?\e$,2?s\e(B)
- (#x4de . ?\e$,2>{\e(B)
- (#x4df . ?\e$,2>|\e(B)
+ (#x47e . ?\e(J~\e(B)
+ (#x4a1 . ?\e$A!#\e(B)
+ (#x4a2 . ?\\e$A!8\e(B)
+ (#x4a3 . ?\\e$A!9\e(B)
+ (#x4a4 . ?\e$A!"\e(B)
+ (#x4a5 . ?\e$A!$\e(B)
+ (#x4a6 . ?\e$A%r\e(B)
+ (#x4a7 . ?\e$A%!\e(B)
+ (#x4a8 . ?\e$A%#\e(B)
+ (#x4a9 . ?\e$A%%\e(B)
+ (#x4aa . ?\e$A%'\e(B)
+ (#x4ab . ?\e$A%)\e(B)
+ (#x4ac . ?\e$A%c\e(B)
+ (#x4ad . ?\e$A%e\e(B)
+ (#x4ae . ?\e$A%g\e(B)
+ (#x4af . ?\e$A%C\e(B)
+ (#x4b0 . ?\e$B!<\e(B)
+ (#x4b1 . ?\e$A%"\e(B)
+ (#x4b2 . ?\e$A%$\e(B)
+ (#x4b3 . ?\e$A%&\e(B)
+ (#x4b4 . ?\e$A%(\e(B)
+ (#x4b5 . ?\e$A%*\e(B)
+ (#x4b6 . ?\e$A%+\e(B)
+ (#x4b7 . ?\e$A%-\e(B)
+ (#x4b8 . ?\e$A%/\e(B)
+ (#x4b9 . ?\e$A%1\e(B)
+ (#x4ba . ?\e$A%3\e(B)
+ (#x4bb . ?\e$A%5\e(B)
+ (#x4bc . ?\e$A%7\e(B)
+ (#x4bd . ?\e$A%9\e(B)
+ (#x4be . ?\e$A%;\e(B)
+ (#x4bf . ?\e$A%=\e(B)
+ (#x4c0 . ?\e$A%?\e(B)
+ (#x4c1 . ?\e$A%A\e(B)
+ (#x4c2 . ?\e$A%D\e(B)
+ (#x4c3 . ?\e$A%F\e(B)
+ (#x4c4 . ?\e$A%H\e(B)
+ (#x4c5 . ?\e$A%J\e(B)
+ (#x4c6 . ?\e$A%K\e(B)
+ (#x4c7 . ?\e$A%L\e(B)
+ (#x4c8 . ?\e$A%M\e(B)
+ (#x4c9 . ?\e$A%N\e(B)
+ (#x4ca . ?\e$A%O\e(B)
+ (#x4cb . ?\e$A%R\e(B)
+ (#x4cc . ?\e$A%U\e(B)
+ (#x4cd . ?\e$A%X\e(B)
+ (#x4ce . ?\e$A%[\e(B)
+ (#x4cf . ?\e$A%^\e(B)
+ (#x4d0 . ?\e$A%_\e(B)
+ (#x4d1 . ?\e$A%`\e(B)
+ (#x4d2 . ?\e$A%a\e(B)
+ (#x4d3 . ?\e$A%b\e(B)
+ (#x4d4 . ?\e$A%d\e(B)
+ (#x4d5 . ?\e$A%f\e(B)
+ (#x4d6 . ?\e$A%h\e(B)
+ (#x4d7 . ?\e$A%i\e(B)
+ (#x4d8 . ?\e$A%j\e(B)
+ (#x4d9 . ?\e$A%k\e(B)
+ (#x4da . ?\e$A%l\e(B)
+ (#x4db . ?\e$A%m\e(B)
+ (#x4dc . ?\e$A%o\e(B)
+ (#x4dd . ?\e$A%s\e(B)
+ (#x4de . ?\e$B!+\e(B)
+ (#x4df . ?\e$B!,\e(B)
;; Arabic
(#x5ac . ?\e,G,\e(B)
(#x5bb . ?\e,G;\e(B)
(#x7f9 . ?\e,Fy\e(B)
;; Technical
(#x8a1 . ?\e$,1|W\e(B)
- (#x8a2 . ?\e$,2 ,\e(B)
- (#x8a3 . ?\e$,2 \e(B)
+ (#x8a2 . ?\e$A)0\e(B)
+ (#x8a3 . ?\e$A)$\e(B)
(#x8a4 . ?\e$,1{ \e(B)
(#x8a5 . ?\e$,1{!\e(B)
- (#x8a6 . ?\e$,2 "\e(B)
+ (#x8a6 . ?\e$A)&\e(B)
(#x8a7 . ?\e$,1|A\e(B)
(#x8a8 . ?\e$,1|C\e(B)
(#x8a9 . ?\e$,1|D\e(B)
(#x8ae . ?\e$,1|@\e(B)
(#x8af . ?\e$,1|H\e(B)
(#x8b0 . ?\e$,1|L\e(B)
- (#x8bc . ?\e$,1y$\e(B)
- (#x8bd . ?\e$,1y \e(B)
- (#x8be . ?\e$,1y%\e(B)
- (#x8bf . ?\e$,1xK\e(B)
- (#x8c0 . ?\e$,1xT\e(B)
- (#x8c1 . ?\e$,1x=\e(B)
- (#x8c2 . ?\e$,1x>\e(B)
- (#x8c5 . ?\e$,1x'\e(B)
- (#x8c8 . ?\e$,1x\\e(B)
- (#x8c9 . ?\e$,1xc\e(B)
- (#x8cd . ?\e$,1wT\e(B)
- (#x8ce . ?\e$,1wR\e(B)
- (#x8cf . ?\e$,1y!\e(B)
- (#x8d6 . ?\e$,1x:\e(B)
- (#x8da . ?\e$,1yB\e(B)
- (#x8db . ?\e$,1yC\e(B)
- (#x8dc . ?\e$,1xI\e(B)
- (#x8dd . ?\e$,1xJ\e(B)
- (#x8de . ?\e$,1xG\e(B)
- (#x8df . ?\e$,1xH\e(B)
- (#x8ef . ?\e$,1x"\e(B)
+ (#x8bc . ?\e$A!\\e(B)
+ (#x8bd . ?\e$A!Y\e(B)
+ (#x8be . ?\e$A!]\e(B)
+ (#x8bf . ?\e$A!R\e(B)
+ (#x8c0 . ?\e$A!`\e(B)
+ (#x8c1 . ?\e$A!X\e(B)
+ (#x8c2 . ?\e$A!^\e(B)
+ (#x8c5 . ?\e$B"`\e(B)
+ (#x8c8 . ?\e$(G"D\e(B)
+ (#x8c9 . ?\e$(O"l\e(B)
+ (#x8cd . ?\e$B"N\e(B)
+ (#x8ce . ?\e$B"M\e(B)
+ (#x8cf . ?\e$A!T\e(B)
+ (#x8d6 . ?\e$A!L\e(B)
+ (#x8da . ?\e$B">\e(B)
+ (#x8db . ?\e$B"?\e(B)
+ (#x8dc . ?\e$A!I\e(B)
+ (#x8dd . ?\e$A!H\e(B)
+ (#x8de . ?\e$A!D\e(B)
+ (#x8df . ?\e$A!E\e(B)
+ (#x8ef . ?\e$B"_\e(B)
(#x8f6 . ?\e$,1!R\e(B)
- (#x8fb . ?\e$,1vp\e(B)
- (#x8fc . ?\e$,1vq\e(B)
- (#x8fd . ?\e$,1vr\e(B)
- (#x8fe . ?\e$,1vs\e(B)
+ (#x8fb . ?\e$A!{\e(B)
+ (#x8fc . ?\e$A!|\e(B)
+ (#x8fd . ?\e$A!z\e(B)
+ (#x8fe . ?\e$A!}\e(B)
;; Special
- (#x9e0 . ?\e$,2"&\e(B)
- (#x9e1 . ?\e$,2!R\e(B)
- (#x9e2 . ?\e$,1}I\e(B)
- (#x9e3 . ?\e$,1}L\e(B)
- (#x9e4 . ?\e$,1}M\e(B)
- (#x9e5 . ?\e$,1}J\e(B)
+ (#x9e0 . ?\e$A!t\e(B)
+ (#x9e1 . ?\e$(C"F\e(B)
+ (#x9e2 . ?\e$(GB*\e(B)
+ (#x9e3 . ?\e$(GB-\e(B)
+ (#x9e4 . ?\e$(GB.\e(B)
+ (#x9e5 . ?\e$(GB+\e(B)
(#x9e8 . ?\e$,1}d\e(B)
- (#x9e9 . ?\e$,1}K\e(B)
- (#x9ea . ?\e$,2 8\e(B)
- (#x9eb . ?\e$,2 0\e(B)
- (#x9ec . ?\e$,2 ,\e(B)
- (#x9ed . ?\e$,2 4\e(B)
- (#x9ee . ?\e$,2 \\e(B)
+ (#x9e9 . ?\e$(GB,\e(B)
+ (#x9ea . ?\e$A)<\e(B)
+ (#x9eb . ?\e$A)4\e(B)
+ (#x9ec . ?\e$A)0\e(B)
+ (#x9ed . ?\e$A)8\e(B)
+ (#x9ee . ?\e$A)`\e(B)
(#x9ef . ?\e$,1|Z\e(B)
(#x9f0 . ?\e$,1|[\e(B)
- (#x9f1 . ?\e$,2 \e(B)
+ (#x9f1 . ?\e$A)$\e(B)
(#x9f2 . ?\e$,1|\\e(B)
(#x9f3 . ?\e$,1|]\e(B)
- (#x9f4 . ?\e$,2 <\e(B)
- (#x9f5 . ?\e$,2 D\e(B)
- (#x9f6 . ?\e$,2 T\e(B)
- (#x9f7 . ?\e$,2 L\e(B)
- (#x9f8 . ?\e$,2 "\e(B)
+ (#x9f4 . ?\e$A)@\e(B)
+ (#x9f5 . ?\e$A)H\e(B)
+ (#x9f6 . ?\e$A)X\e(B)
+ (#x9f7 . ?\e$A)P\e(B)
+ (#x9f8 . ?\e$A)&\e(B)
;; Publishing
(#xaa1 . ?\e$,1rc\e(B)
(#xaa2 . ?\e$,1rb\e(B)
(#xaa6 . ?\e$,1rh\e(B)
(#xaa7 . ?\e$,1ri\e(B)
(#xaa8 . ?\e$,1rj\e(B)
- (#xaa9 . ?\e$,1rt\e(B)
- (#xaaa . ?\e$,1rs\e(B)
- (#xaae . ?\e$,1s&\e(B)
- (#xaaf . ?\e$,1s%\e(B)
- (#xab0 . ?\e$,1v3\e(B)
- (#xab1 . ?\e$,1v4\e(B)
- (#xab2 . ?\e$,1v5\e(B)
+ (#xaa9 . ?\e$(G!7\e(B)
+ (#xaaa . ?\e$(G!9\e(B)
+ (#xaae . ?\e$A!-\e(B)
+ (#xaaf . ?\e$(G!-\e(B)
+ (#xab0 . ?\e$(O'x\e(B)
+ (#xab1 . ?\e$(O'y\e(B)
+ (#xab2 . ?\e$(O'z\e(B)
(#xab3 . ?\e$,1v6\e(B)
(#xab4 . ?\e$,1v7\e(B)
(#xab5 . ?\e$,1v8\e(B)
(#xab6 . ?\e$,1v9\e(B)
(#xab7 . ?\e$,1v:\e(B)
- (#xab8 . ?\e$,1uE\e(B)
+ (#xab8 . ?\e$(G""\e(B)
(#xabb . ?\e$,1rr\e(B)
(#xabc . ?\e$,1{)\e(B)
(#xabe . ?\e$,1{*\e(B)
- (#xac3 . ?\e$,1v;\e(B)
- (#xac4 . ?\e$,1v<\e(B)
- (#xac5 . ?\e$,1v=\e(B)
- (#xac6 . ?\e$,1v>\e(B)
- (#xac9 . ?\e$,1ub\e(B)
+ (#xac3 . ?\e$(C({\e(B)
+ (#xac4 . ?\e$(C(|\e(B)
+ (#xac5 . ?\e$(C(}\e(B)
+ (#xac6 . ?\e$(C(~\e(B)
+ (#xac9 . ?\e$(D"o\e(B)
(#xaca . ?\e$,2"s\e(B)
- (#xacc . ?\e$,2"!\e(B)
- (#xacd . ?\e$,2!w\e(B)
- (#xace . ?\e$,2"+\e(B)
+ (#xacc . ?\e$(O##\e(B)
+ (#xacd . ?\e$(O#!\e(B)
+ (#xace . ?\e$A!p\e(B)
(#xacf . ?\e$,2!o\e(B)
- (#xad0 . ?\e$,1rx\e(B)
- (#xad1 . ?\e$,1ry\e(B)
- (#xad2 . ?\e$,1r|\e(B)
- (#xad3 . ?\e$,1r}\e(B)
+ (#xad0 . ?\e,F!\e(B)
+ (#xad1 . ?\e,F"\e(B)
+ (#xad2 . ?\e,Y4\e(B)
+ (#xad3 . ?\e,Y!\e(B)
(#xad4 . ?\e$,1u^\e(B)
- (#xad6 . ?\e$,1s2\e(B)
- (#xad7 . ?\e$,1s3\e(B)
+ (#xad6 . ?\e$A!d\e(B)
+ (#xad7 . ?\e$A!e\e(B)
(#xad9 . ?\e$,2%]\e(B)
(#xadb . ?\e$,2!l\e(B)
- (#xadc . ?\e$,2" \e(B)
- (#xadd . ?\e$,2!v\e(B)
- (#xade . ?\e$,2"/\e(B)
+ (#xadc . ?\e$(O#$\e(B)
+ (#xadd . ?\e$(O#"\e(B)
+ (#xade . ?\e$A!q\e(B)
(#xadf . ?\e$,2!n\e(B)
- (#xae0 . ?\e$,2"F\e(B)
+ (#xae0 . ?\e$(O#?\e(B)
(#xae1 . ?\e$,2!k\e(B)
(#xae2 . ?\e$,2!m\e(B)
- (#xae3 . ?\e$,2!s\e(B)
- (#xae4 . ?\e$,2!}\e(B)
- (#xae5 . ?\e$,2"f\e(B)
- (#xae6 . ?\e$,1s"\e(B)
+ (#xae3 . ?\e$A!w\e(B)
+ (#xae4 . ?\e$(G!}\e(B)
+ (#xae5 . ?\e$A!n\e(B)
+ (#xae6 . ?\e$(O#@\e(B)
(#xae7 . ?\e$,2!j\e(B)
- (#xae8 . ?\e$,2!r\e(B)
- (#xae9 . ?\e$,2!|\e(B)
- (#xaea . ?\e$,2"|\e(B)
- (#xaeb . ?\e$,2"~\e(B)
- (#xaec . ?\e$,2#c\e(B)
- (#xaed . ?\e$,2#f\e(B)
- (#xaee . ?\e$,2#e\e(B)
+ (#xae8 . ?\e$A!x\e(B)
+ (#xae9 . ?\e$(G!~\e(B)
+ (#xaea . ?\e$(C"P\e(B)
+ (#xaeb . ?\e$(O-~\e(B)
+ (#xaec . ?\e$(O&@\e(B)
+ (#xaed . ?\e$(O&<\e(B)
+ (#xaee . ?\e$(O&>\e(B)
(#xaf0 . ?\e$,2%`\e(B)
- (#xaf1 . ?\e$,1s \e(B)
- (#xaf2 . ?\e$,1s!\e(B)
- (#xaf3 . ?\e$,2%S\e(B)
+ (#xaf1 . ?\e$B"w\e(B)
+ (#xaf2 . ?\e$B"x\e(B)
+ (#xaf3 . ?\e$(O'{\e(B)
(#xaf4 . ?\e$,2%W\e(B)
- (#xaf5 . ?\e$,2#o\e(B)
- (#xaf6 . ?\e$,2#m\e(B)
- (#xaf7 . ?\e$,2#B\e(B)
- (#xaf8 . ?\e$,2#@\e(B)
- (#xaf9 . ?\e$,2"n\e(B)
+ (#xaf5 . ?\e$B"t\e(B)
+ (#xaf6 . ?\e$B"u\e(B)
+ (#xaf7 . ?\e$A!a\e(B)
+ (#xaf8 . ?\e$A!b\e(B)
+ (#xaf9 . ?\e$(O&g\e(B)
(#xafa . ?\e$,1zu\e(B)
(#xafb . ?\e$,1uW\e(B)
(#xafc . ?\e$,1s8\e(B)
(#xafd . ?\e$,1rz\e(B)
- (#xafe . ?\e$,1r~\e(B)
+ (#xafe . ?\e,Y%\e(B)
;; APL
(#xba3 . ?<)
(#xba6 . ?>)
- (#xba8 . ?\e$,1xH\e(B)
- (#xba9 . ?\e$,1xG\e(B)
+ (#xba8 . ?\e$A!E\e(B)
+ (#xba9 . ?\e$A!D\e(B)
(#xbc0 . ?\e,A/\e(B)
- (#xbc2 . ?\e$,1ye\e(B)
- (#xbc3 . ?\e$,1xI\e(B)
+ (#xbc2 . ?\e$A!M\e(B)
+ (#xbc3 . ?\e$A!I\e(B)
(#xbc4 . ?\e$,1zj\e(B)
(#xbc6 . ?_)
(#xbca . ?\e$,1x8\e(B)
(#xbcc . ?\e$,1|5\e(B)
(#xbce . ?\e$,1yd\e(B)
- (#xbcf . ?\e$,2"+\e(B)
+ (#xbcf . ?\e$A!p\e(B)
(#xbd3 . ?\e$,1zh\e(B)
- (#xbd6 . ?\e$,1xJ\e(B)
- (#xbd8 . ?\e$,1yC\e(B)
- (#xbda . ?\e$,1yB\e(B)
+ (#xbd6 . ?\e$A!H\e(B)
+ (#xbd8 . ?\e$B"?\e(B)
+ (#xbda . ?\e$B">\e(B)
(#xbdc . ?\e$,1yb\e(B)
(#xbfc . ?\e$,1yc\e(B)
;; Hebrew
;; Latin-9
(#x13bc . ?\e,b<\e(B)
(#x13bd . ?\e,b=\e(B)
- (#x13be . ?\e,b>\e(B)
+ (#x13be . ?\e,_/\e(B)
;; Currency
(#x20a0 . ?\e$,1t@\e(B)
(#x20a1 . ?\e$,1tA\e(B)
(defvar x-select-request-type nil
"*Data type request for X selection.
-The value is nil, one of the following data types, or a list of them:
+The value is one of the following data types, a list of them, or nil:
`COMPOUND_TEXT', `UTF8_STRING', `STRING', `TEXT'
-If the value is nil, try `COMPOUND_TEXT' and `UTF8_STRING', and
-use the more appropriate result. If both fail, try `STRING', and
-then `TEXT'.
-
If the value is one of the above symbols, try only the specified
type.
If the value is a list of them, try each of them in the specified
-order until succeed.")
+order until succeed.
-;; Helper function for x-selection-value. Select UTF8 or CTEXT
-;; whichever is more appropriate. Here, we use this heurisitcs.
-;;
-;; (1) If their lengthes are different, select the longer one. This
-;; is because an X client may just cut off unsupported characters.
-;;
-;; (2) Otherwise, if they are different at Nth character, and that
-;; of UTF8 is a Latin character and that of CTEXT belongs to a CJK
-;; character set, select UTF8. Also select UTF8 if the Nth
-;; character of UTF8 is non-ASCII where as that of CTEXT is ASCII.
-;; This is because an X client may replace unsupported characters
-;; with some ASCII character (typically ` ' or `?') in CTEXT.
-;;
-;; (3) Otherwise, select CTEXT. This is because legacy charsets are
-;; better for the current Emacs, especially when the selection owner
-;; is also Emacs.
-
-(defun x-select-utf8-or-ctext (utf8 ctext)
- (let ((len-utf8 (length utf8))
- (len-ctext (length ctext))
- (selected ctext)
- (i 0)
- char)
- (if (/= len-utf8 len-ctext)
- (if (> len-utf8 len-ctext) utf8 ctext)
- (let ((result (compare-strings utf8 0 len-utf8 ctext 0 len-ctext)))
- (if (eq result t)
- ctext
- (let ((utf8-char (aref utf8 (1- (abs result))))
- (ctext-char (aref ctext (1- (abs result)))))
- (if (or (and (aref (char-category-set utf8-char) ?l)
- (aref (char-category-set ctext-char) ?C))
- (and (>= utf8-char 128)
- (< ctext-char 128)))
- utf8
- ctext)))))))
+The value nil is the same as this list:
+ \(UTF8_STRING COMPOUND_TEXT STRING)
+")
;; Get a selection value of type TYPE by calling x-get-selection with
-;; an appropiate DATA-TYPE argument decidd by `x-select-request-type'.
+;; an appropiate DATA-TYPE argument decided by `x-select-request-type'.
;; The return value is already decoded. If x-get-selection causes an
;; error, this function return nil.
(defun x-selection-value (type)
- (let (text)
- (cond ((null x-select-request-type)
- (let (utf8 ctext utf8-coding)
- ;; We try both UTF8_STRING and COMPOUND_TEXT, and choose
- ;; the more appropriate one. If both fail, try STRING.
-
- ;; At first try UTF8_STRING.
- (setq utf8 (condition-case nil
- (x-get-selection type 'UTF8_STRING)
- (error nil))
- utf8-coding last-coding-system-used)
- (if utf8
- ;; If it is a local selection, or it contains only
- ;; ASCII characers, choose it.
- (if (or (not (get-text-property 0 'foreign-selection utf8))
- (= (length utf8) (string-bytes utf8)))
- (setq text utf8)))
- ;; If not yet decided, try COMPOUND_TEXT.
- (if (not text)
- (if (setq ctext (condition-case nil
- (x-get-selection type 'COMPOUND_TEXT)
- (error nil)))
- ;; If UTF8_STRING was also successful, choose the
- ;; more appropriate one from UTF8 and CTEXT.
- (if utf8
- (setq text (x-select-utf8-or-ctext utf8 ctext))
- ;; Othewise, choose CTEXT.
- (setq text ctext))
- (setq text utf8)))
- ;; If not yet decided, try STRING.
- (or text
- (setq text (condition-case nil
- (x-get-selection type 'STRING)
- (error nil))))
- (if (eq text utf8)
- (setq last-coding-system-used utf8-coding))))
-
- ((consp x-select-request-type)
- (let ((tail x-select-request-type))
- (while (and tail (not text))
- (condition-case nil
- (setq text (x-get-selection type (car tail)))
- (error nil))
- (setq tail (cdr tail)))))
-
- (t
- (condition-case nil
- (setq text (x-get-selection type x-select-request-type))
- (error nil))))
-
+ (let ((request-type (or x-select-request-type
+ '(UTF8_STRING COMPOUND_TEXT STRING)))
+ text)
+ (if (consp request-type)
+ (while (and request-type (not text))
+ (condition-case nil
+ (setq text (x-get-selection type (car request-type)))
+ (error nil))
+ (setq request-type (cdr request-type)))
+ (condition-case nil
+ (setq text (x-get-selection type request-type))
+ (error nil)))
(if text
(remove-text-properties 0 (length text) '(foreign-selection nil) text))
text))
;; Create fontset specified in X resources "Fontset-N" (N is 0, 1, ...).
(create-fontset-from-x-resource)
- ;; Try to create a fontset from a font specification which comes
- ;; from initial-frame-alist, default-frame-alist, or X resource.
- ;; A font specification in command line argument (i.e. -fn XXXX)
- ;; should be already in default-frame-alist as a `font'
- ;; parameter. However, any font specifications in site-start
- ;; library, user's init file (.emacs), and default.el are not
- ;; yet handled here.
-
- (let ((font (or (cdr (assq 'font initial-frame-alist))
- (cdr (assq 'font default-frame-alist))
- (x-get-resource "font" "Font")))
- xlfd-fields resolved-name)
- (if (and font
- (not (query-fontset font))
- (setq resolved-name (x-resolve-font-name font))
- (setq xlfd-fields (x-decompose-font-name font)))
- (if (string= "fontset" (aref xlfd-fields xlfd-regexp-registry-subnum))
- (new-fontset font (x-complement-fontset-spec xlfd-fields nil))
- ;; Create a fontset from FONT. The fontset name is
- ;; generated from FONT.
- (create-fontset-from-ascii-font font resolved-name "startup"))))
-
;; Set scroll bar mode to right if set by X resources. Default is left.
(if (equal (x-get-resource "verticalScrollBars" "ScrollBars") "right")
(customize-set-variable 'scroll-bar-mode 'right))
;;; fill.el --- fill commands for Emacs -*- coding: iso-2022-7bit -*-
;; Copyright (C) 1985, 1986, 1992, 1994, 1995, 1996, 1997, 1999, 2001, 2002,
- ;; 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ ;; 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: wp
(looking-at paragraph-start))))
(run-hook-with-args-until-success 'fill-nobreak-predicate)))))
-;; Put `fill-find-break-point-function' property to charsets which
-;; require special functions to find line breaking point.
-(dolist (pair '((katakana-jisx0201 . kinsoku)
- (chinese-gb2312 . kinsoku)
- (japanese-jisx0208 . kinsoku)
- (japanese-jisx0212 . kinsoku)
- (chinese-big5-1 . kinsoku)
- (chinese-big5-2 . kinsoku)))
- (put-charset-property (car pair) 'fill-find-break-point-function (cdr pair)))
+(defvar fill-find-break-point-function-table (make-char-table nil)
+ "Char-table of special functions to find line breaking point.")
+
+(defvar fill-nospace-between-words-table (make-char-table nil)
+ "Char-table of characters that don't use space between words.")
+
+(progn
+ ;; Register `kinsoku' for scripts HAN, KANA, BOPOMPFO, and CJK-MISS.
+ ;; Also tell that they don't use space between words.
+ (map-char-table
+ #'(lambda (key val)
+ (when (memq val '(han kana bopomofo cjk-misc))
+ (set-char-table-range fill-find-break-point-function-table
+ key 'kinsoku)
+ (set-char-table-range fill-nospace-between-words-table
+ key t)))
+ char-script-table)
+ ;; Do the same thing also for full width characters and half
+ ;; width kana variants.
+ (set-char-table-range fill-find-break-point-function-table
+ '(#xFF01 . #xFFE6) 'kinsoku)
+ (set-char-table-range fill-nospace-between-words-table
+ '(#xFF01 . #xFFE6) 'kinsoku))
(defun fill-find-break-point (limit)
"Move point to a proper line breaking position of the current line.
character has the property `fill-find-break-point-function', this
function calls the property value as a function with one arg LIMIT.
If the charset has no such property, do nothing."
- (let* ((ch (following-char))
- (charset (char-charset ch))
- func)
- (if (eq charset 'ascii)
- (setq ch (preceding-char)
- charset (char-charset ch)))
- (if (charsetp charset)
- (setq func
- (get-charset-property charset 'fill-find-break-point-function)))
+ (let ((func (or
+ (aref fill-find-break-point-function-table (following-char))
+ (aref fill-find-break-point-function-table (preceding-char)))))
(if (and func (fboundp func))
(funcall func limit))))
(goto-char from)
(if enable-multibyte-characters
;; Delete unnecessay newlines surrounded by words. The
- ;; character category `|' means that we can break a line
- ;; at the character. And, charset property
- ;; `nospace-between-words' tells how to concatenate
- ;; words. If the value is non-nil, never put spaces
- ;; between words, thus delete a newline between them.
- ;; If the value is nil, delete a newline only when a
- ;; character preceding a newline has text property
- ;; `nospace-between-words'.
+ ;; character category `|' means that we can break a line at the
+ ;; character. And, char-table
+ ;; `fill-nospace-between-words-table' tells how to concatenate
+ ;; words. If a character has non-nil value in the table, never
+ ;; put spaces between words, thus delete a newline between them.
+ ;; Otherwise, delete a newline only when a character preceding a
+ ;; newline has non-nil value in that table.
(while (search-forward "\n" to t)
(if (get-text-property (match-beginning 0) 'fill-space)
(replace-match (get-text-property (match-beginning 0) 'fill-space))
(next (following-char)))
(if (and (or (aref (char-category-set next) ?|)
(aref (char-category-set prev) ?|))
- (or (get-charset-property (char-charset prev)
- 'nospace-between-words)
- (get-text-property (1- (match-beginning 0))
- 'nospace-between-words)))
+ (or (aref fill-nospace-between-words-table next)
+ (aref fill-nospace-between-words-table prev)))
(delete-char -1))))))
(goto-char from)
;;; ispell.el --- interface to International Ispell Versions 3.1 and 3.2
;; Copyright (C) 1994, 1995, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
- ;; 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ ;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Ken Stevens <k.stevens@ieee.org>
;; Maintainer: Ken Stevens <k.stevens@ieee.org>
(decode-coding-string str (ispell-get-coding-system))
str))
-(put 'ispell-unified-chars-table 'char-table-extra-slots 0)
-
-;; Char-table that maps an Unicode character (charset:
-;; latin-iso8859-1, mule-unicode-0100-24ff, mule-unicode-2500-34ff) to
-;; a string in which all equivalent characters are listed.
-
-(defconst ispell-unified-chars-table
- (let ((table (make-char-table 'ispell-unified-chars-table)))
- (map-char-table
- #'(lambda (c v)
- (if (and v (/= c v))
- (let ((unified (or (aref table v) (string v))))
- (aset table v (concat unified (string c))))))
- ucs-mule-8859-to-mule-unicode)
- table))
-
-;; Return a string decoded from Nth element of the current dictionary
-;; while splicing equivalent characters into the string. This splicing
-;; is done only if the string is a regular expression of the form
-;; "[...]" because, otherwise, splicing will result in incorrect
-;; regular expression matching.
-
+;; Return a string decoded from Nth element of the current dictionary.
(defun ispell-get-decoded-string (n)
(let* ((slot (or
(assoc ispell-current-dictionary ispell-local-dictionary-alist)
(when (and (> (length str) 0)
(not (multibyte-string-p str)))
(setq str (ispell-decode-string str))
- (if (and (= (aref str 0) ?\[)
- (eq (string-match "\\]" str) (1- (length str))))
- (setq str
- (string-as-multibyte
- (mapconcat
- #'(lambda (c)
- (let ((unichar (aref ucs-mule-8859-to-mule-unicode c)))
- (if unichar
- (aref ispell-unified-chars-table unichar)
- (string c))))
- str ""))))
+ (or (multibyte-string-p str)
+ (setq str (string-to-multibyte str)))
(setcar (nthcdr n slot) str))
str))
local variable syntax.")
(make-variable-buffer-local 'ispell-local-pdict)
+ ;;;###autoload(put 'ispell-local-pdict 'safe-local-variable 'stringp)
(defvar ispell-buffer-local-name nil
"Contains the buffer name if local word definitions were used.
;;; sgml-mode.el --- SGML- and HTML-editing modes -*- coding: iso-2022-7bit -*-
;; Copyright (C) 1992, 1995, 1996, 1998, 2001, 2002, 2003, 2004,
- ;; 2005, 2006, 2007 Free Software Foundation, Inc.
+ ;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: James Clark <jjc@jclark.com>
;; Maintainer: FSF
(define-key map "\"" 'sgml-name-self))
(when (memq ?' sgml-specials)
(define-key map "'" 'sgml-name-self)))
- (define-key map (vector (make-char 'latin-iso8859-1))
- 'sgml-maybe-name-self)
(let ((c 127)
(map (nth 1 map)))
(while (< (setq c (1+ c)) 256)
(let ((table (make-char-table 'sgml-table))
(i 32)
elt)
- (while (< i 256)
+ (while (< i 128)
(setq elt (aref sgml-char-names i))
(if elt (aset table (make-char 'latin-iso8859-1 i) elt))
(setq i (1+ i)))
(setq face (funcall skeleton-transformation-function face))
(setq facemenu-end-add-face (concat "</" face ">"))
(concat "<" face ">"))
- (error "Face not configured for %s mode" mode-name)))
+ (error "Face not configured for %s mode" (format-mode-line mode-name))))
(defun sgml-fill-nobreak ()
;; Don't break between a tag name and its first argument.
;;; time-stamp.el --- Maintain last change time stamps in files edited by Emacs
;; Copyright (C) 1989, 1993, 1994, 1995, 1997, 2000, 2001, 2002, 2003,
- ;; 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ ;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
:type '(choice (const nil) string)
:group 'time-stamp
:version "20.1")
-
+ ;;;###autoload(put 'time-stamp-time-zone 'safe-local-variable 'string-or-null-p)
;;; Do not change time-stamp-line-limit, time-stamp-start,
;;; time-stamp-end, time-stamp-pattern, time-stamp-inserts-lines,
;;; Some functions used in time-stamp-format
;;; These functions have been obsolete since 1995
-;;; and will be removed in a future Emacs release.
+;;; and will be removed in Emacs 23.
;;; Meanwhile, discourage other packages from using them.
(dolist (function '(time-stamp-month-dd-yyyy time-stamp-dd/mm/yyyy
time-stamp-mon-dd-yyyy time-stamp-dd-mon-yy
;;; version.el --- record version number of Emacs -*- no-byte-compile: t -*-
;; Copyright (C) 1985, 1992, 1994, 1995, 1999, 2000, 2001, 2002,
- ;; 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ ;; 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: internal
;;; Code:
- (defconst emacs-copyright "Copyright (C) 2007 Free Software Foundation, Inc."
+ (defconst emacs-copyright "Copyright (C) 2008 Free Software Foundation, Inc."
"Short copyright string for this version of Emacs.")
-(defconst emacs-version "23.0.50" "\
+(defconst emacs-version "23.0.60" "\
Version numbers of this version of Emacs.")
(defconst emacs-major-version
;;; w32-fns.el --- Lisp routines for Windows NT
;; Copyright (C) 1994, 2001, 2002, 2003, 2004,
- ;; 2005, 2006, 2007 Free Software Foundation, Inc.
+ ;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Geoff Voelker <voelker@cs.washington.edu>
;; Keywords: internal
(x-server-version))
(defun w32-using-nt ()
- "Return non-nil if running on a 32-bit Windows system.
+ "Return non-nil if running on a Windows NT descendant.
That includes all Windows systems except for 9X/Me."
(and (eq system-type 'windows-nt) (getenv "SystemRoot")))
;; value from w32-select-font etc, so list the most important charsets last.
(w32-add-charset-info "iso8859-14" 'w32-charset-ansi 28604)
(w32-add-charset-info "iso8859-15" 'w32-charset-ansi 28605)
+;; The following two are included for pattern matching.
+(w32-add-charset-info "jisx0201" 'w32-charset-shiftjis 932)
+(w32-add-charset-info "jisx0208" 'w32-charset-shiftjis 932)
(w32-add-charset-info "jisx0201-latin" 'w32-charset-shiftjis 932)
(w32-add-charset-info "jisx0201-katakana" 'w32-charset-shiftjis 932)
-(w32-add-charset-info "jisx0208-sjis" 'w32-charset-shiftjis 932)
(w32-add-charset-info "ksc5601.1989-1" 'w32-charset-hangeul 949)
(w32-add-charset-info "big5-1" 'w32-charset-chinesebig5 950)
(w32-add-charset-info "gb2312.1980-1" 'w32-charset-gb2312 936)
(w32-add-charset-info "iso8859-5" 'w32-charset-russian 28595)
(w32-add-charset-info "tis620-1" 'w32-charset-thai 874)
(w32-add-charset-info "ksc5601.1992-1" 'w32-charset-johab 1361)
- (w32-add-charset-info "mac-latin" 'w32-charset-mac nil)))
+ (w32-add-charset-info "mac-roman" 'w32-charset-mac 10000)))
(if (boundp 'w32-unicode-charset-defined)
(progn
(w32-add-charset-info "iso10646-1" 'w32-charset-unicode t))
- ;; If unicode windows charset is not defined, use ansi fonts.
- (w32-add-charset-info "iso10646-1" 'w32-charset-ansi t))
+ (w32-add-charset-info "iso10646-1" 'w32-charset-default t))
+;; ;; If unicode windows charset is not defined, use ansi fonts.
+;; (w32-add-charset-info "iso10646-1" 'w32-charset-ansi t))
+
+;; Prefered names
+(w32-add-charset-info "big5-0" 'w32-charset-chinesebig5 950)
+(w32-add-charset-info "gb2312.1980-0" 'w32-charset-gb2312 936)
+(w32-add-charset-info "jisx0208-sjis" 'w32-charset-shiftjis 932)
+(w32-add-charset-info "ksc5601.1987-0" 'w32-charset-hangeul 949)
+(w32-add-charset-info "tis620-0" 'w32-charset-thai 874)
(w32-add-charset-info "iso8859-1" 'w32-charset-ansi 1252)
(make-obsolete-variable 'w32-enable-italics
;;; wid-edit.el --- Functions for creating and using widgets -*-byte-compile-dynamic: t;-*-
;;
;; Copyright (C) 1996, 1997, 1999, 2000, 2001, 2002, 2003,
- ;; 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ ;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Maintainer: FSF
:complete-function 'ispell-complete-word
:prompt-history 'widget-string-prompt-value-history)
+(eval-when-compile (defvar widget))
+
+(defun widget-string-complete ()
+ "Complete contents of string field.
+Completions are taken from the :completion-alist property of the
+widget. If that isn't a list, it's evalled and expected to yield a list."
+ (interactive)
+ (let* ((prefix (buffer-substring-no-properties (widget-field-start widget)
+ (point)))
+ (completion-ignore-case (widget-get widget :completion-ignore-case))
+ (alist (widget-get widget :completion-alist))
+ (_ (unless (listp alist)
+ (setq alist (eval alist))))
+ (completion (try-completion prefix alist)))
+ (cond ((eq completion t)
+ (when completion-ignore-case
+ ;; Replace field with completion in case its case is different.
+ (delete-region (widget-field-start widget)
+ (widget-field-end widget))
+ (insert-and-inherit (car (assoc-ignore-case prefix alist))))
+ (message "Only match"))
+ ((null completion)
+ (error "No match"))
+ ((not (eq t (compare-strings prefix nil nil completion nil nil
+ completion-ignore-case)))
+ (when completion-ignore-case
+ ;; Replace field with completion in case its case is different.
+ (delete-region (widget-field-start widget)
+ (widget-field-end widget))
+ (insert-and-inherit completion)))
+ (t
+ (message "Making completion list...")
+ (with-output-to-temp-buffer "*Completions*"
+ (display-completion-list
+ (all-completions prefix alist nil)))
+ (message "Making completion list...done")))))
+
(define-widget 'regexp 'string
"A regular expression."
:match 'widget-regexp-match
(interactive)
(lisp-complete-symbol 'boundp))
:tag "Variable")
-\f
-(defvar widget-coding-system-prompt-value-history nil
- "History of input to `widget-coding-system-prompt-value'.")
(define-widget 'coding-system 'symbol
"A MULE coding-system."
:format "%{%t%}: %v"
:tag "Coding system"
:base-only nil
- :prompt-history 'widget-coding-system-prompt-value-history
+ :prompt-history 'coding-system-value-history
:prompt-value 'widget-coding-system-prompt-value
:action 'widget-coding-system-action
:complete-function (lambda ()
(aref value 0)
value))
:match (lambda (widget value)
- (char-valid-p value)))
+ (characterp value)))
(define-widget 'list 'group
"A Lisp list."
#### you should make sure that this script will include it.
# Copyright (C) 1995, 1997, 1998, 2000, 2001, 2002, 2003, 2004, 2005,
- # 2006, 2007 Free Software Foundation, Inc.
+ # 2006, 2007, 2008 Free Software Foundation, Inc.
#
# This file is part of GNU Emacs.
#
"--compress")
default_gzip="compress"
;;
+ ## Same with bzip2.
+ "--bzip2")
+ default_gzip="bzip2"
+ ;;
"--snapshot")
clean_up=yes
"--help")
echo "Usage: ${progname} [options]"
echo ""
+ echo " --bzip2 use bzip2 instead of gzip"
echo " --clean-up delete staging directories when done"
echo " --compress use compress instead of gzip"
echo " --newer=TIME don't include files older than TIME"
leim/SKK-DIC leim/ja-dic leim/quail \
src src/m src/s src/bitmaps lib-src oldXMenu lwlib \
nt nt/inc nt/inc/sys nt/inc/arpa nt/inc/netinet nt/icons \
- etc etc/e etc/gnus etc/nxml \
+ etc etc/charsets etc/e etc/gnus etc/nxml \
etc/images etc/images/ezimage etc/images/gnus etc/images/gud \
- etc/images/icons etc/images/low-color etc/images/mail \
+ etc/images/icons etc/images/icons/hicolor \
+ etc/images/icons/hicolor/*x* etc/images/icons/hicolor/*x*/apps \
+ etc/images/low-color etc/images/mail \
etc/images/smilies etc/images/smilies/grayscale \
etc/images/smilies/medium etc/images/tree-widget \
etc/images/tree-widget/default etc/images/tree-widget/folder \
### tex litter.
(cd etc
files=`ls -d * | grep -v CVS | grep -v RCS | grep -v 'Old' | grep -v '^e$' \
- | grep -v '^gnus$' | grep -v '^images$' | grep -v '^nxml$' \
+ | grep -v '^charsets$' | grep -v '^gnus$' | grep -v '^images$' | grep -v '^nxml$' \
| grep -v '^refcards$' | grep -v '^tutorials$'| grep -v '^schema$'`
ln $files ../${tempdir}/etc
## If we ended up with a symlink, or if we did not get anything
rm -f DOC* *~ \#*\# *.dvi *.log *.orig *.rej *,v =* core
rm -f TAGS)
-for dir in etc/e etc/gnus etc/nxml etc/tutorials etc/refcards etc/schema ; do
+for dir in etc/charsets etc/e etc/gnus etc/nxml etc/tutorials etc/refcards etc/schema ; do
echo "Making links to \`${dir}'"
(cd ${dir}
ln `ls -d * | grep -v CVS | grep -v RCS` ../../${tempdir}/${dir}
done
for dir in etc/images/tree-widget/default etc/images/tree-widget/folder \
- etc/images/smilies/grayscale etc/images/smilies/medium ; do
+ etc/images/smilies/grayscale etc/images/smilies/medium; do
echo "Making links to \`${dir}'"
(cd ${dir}
ln `ls -d * | grep -v CVS | grep -v RCS` ../../../../${tempdir}/${dir}
rm -f *~ \#*\# *,v =* core)
done
+ for dir in etc/images/icons/hicolor/*x*/apps ; do
+ echo "Making links to \`${dir}'"
+ (cd ${dir}
+ ln `ls -d * | grep -v CVS | grep -v RCS` ../../../../../../${tempdir}/${dir}
+ cd ../../../../../../${tempdir}/${dir}
+ rm -f *~ \#*\# *,v =* core)
+ done
+
echo "Making links to \`info'"
# Don't distribute backups or autosaves.
(cd info
)`
fi
case "${default_gzip}" in
+ bzip2) gzip_extension=.bz2 ;;
compress* ) gzip_extension=.Z ;;
* ) gzip_extension=.gz ;;
esac
rem ----------------------------------------------------------------------\r
rem Configuration script for MS Windows 95/98/Me and NT/2000/XP\r
rem Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005,\r
- rem 2006, 2007 Free Software Foundation, Inc.\r
+ rem 2006, 2007, 2008 Free Software Foundation, Inc.\r
\r
rem This file is part of GNU Emacs.\r
\r
if "%1" == "--without-gif" goto withoutgif\r
if "%1" == "--without-tiff" goto withouttiff\r
if "%1" == "--without-xpm" goto withoutxpm\r
+if "%1" == "--enable-font-backend" goto withfont\r
if "%1" == "" goto checkutils\r
:usage\r
echo Usage: configure [options]\r
echo. --without-gif do not use giflib or libungif\r
echo. --without-tiff do not use libtiff\r
echo. --without-xpm do not use libXpm\r
+echo. --enable-font-backend build with font backend support\r
goto end\r
rem ----------------------------------------------------------------------\r
:setprefix\r
shift\r
goto again\r
\r
+:withfont\r
+set usercflags=%usercflags%%sep1%-DUSE_FONT_BACKEND\r
+set sep1= %nothing%\r
+set usefontbackend=Y\r
+shift\r
+goto again\r
+\r
rem ----------------------------------------------------------------------\r
rem Check that necessary utilities (cp and rm) are present.\r
:checkutils\r
if (%docflags%)==(Y) echo USER_CFLAGS=%usercflags%>>config.settings\r
for %%v in (%userldflags%) do if not (%%v)==() set doldflags=Y\r
if (%doldflags%)==(Y) echo USER_LDFLAGS=%userldflags%>>config.settings\r
+if (%usefontbackend%) == (Y) echo USE_FONTBACKEND=1 >>config.settings\r
echo # End of settings from configure.bat>>config.settings\r
echo. >>config.settings\r
\r
# Makefile for GNU Emacs.
# Copyright (C) 1985, 1987, 1988, 1993, 1994, 1995, 1999, 2000, 2001, 2002,
- # 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ # 2003, 2004, 2005, 2006, 2007, 2008
+ # Free Software Foundation, Inc.
# This file is part of GNU Emacs.
dot = .
dotdot = ${dot}${dot}
lispsource = ${srcdir}/$(dot)$(dot)/lisp/
+admindir = $(srcdir)/$(dot)$(dot)/admin/
libsrc = $(dot)$(dot)/lib-src/
etc = $(dot)$(dot)/etc/
oldXMenudir = $(dot)$(dot)/oldXMenu/
/* C_SWITCH_X_SITE must come before C_SWITCH_X_MACHINE and C_SWITCH_X_SYSTEM
since it may have -I options that should override those two. */
-ALL_CFLAGS=-Demacs -DHAVE_CONFIG_H $(TOOLKIT_DEFINES) $(MYCPPFLAGS) -I. -I${srcdir} C_SWITCH_MACHINE C_SWITCH_SYSTEM C_SWITCH_SITE C_SWITCH_X_SITE C_SWITCH_X_MACHINE C_SWITCH_X_SYSTEM C_SWITCH_SYSTEM_TEMACS ${CFLAGS_SOUND} ${RSVG_CFLAGS} ${DBUS_CFLAGS} ${CFLAGS}
+ALL_CFLAGS=-Demacs -DHAVE_CONFIG_H $(TOOLKIT_DEFINES) $(MYCPPFLAGS) -I. -I${srcdir} C_SWITCH_MACHINE C_SWITCH_SYSTEM C_SWITCH_SITE C_SWITCH_X_SITE C_SWITCH_X_MACHINE C_SWITCH_X_SYSTEM C_SWITCH_SYSTEM_TEMACS ${CFLAGS_SOUND} ${RSVG_CFLAGS} ${DBUS_CFLAGS} ${CFLAGS} @FREETYPE_CFLAGS@ @FONTCONFIG_CFLAGS@ @LIBOTF_CFLAGS@ @M17N_FLT_CFLAGS@
.c.o:
$(CC) -c $(CPPFLAGS) $(ALL_CFLAGS) $<
emacsappsrc = ${srcdir}/../mac/Emacs.app/
#endif
+#ifdef HAVE_WINDOW_SYSTEM
+FONTSRC = font.h
+#ifdef USE_FONT_BACKEND
+#ifdef HAVE_X_WINDOWS
+#if defined (HAVE_XFT)
+FONTOBJ = font.o xfont.o ftfont.o xftfont.o ftxfont.o
+#elif defined (HAVE_FREETYPE)
+FONTOBJ = font.o xfont.o ftfont.o ftxfont.o
+#else /* ! defined (HAVE_XFT) && ! defined (HAVE_FREETYPE) */
+FONTOBJ = font.o xfont.o
+#endif /* ! defined (HAVE_XFT) && ! defined (HAVE_FREETYPE) */
+#else /* ! HAVE_X_WINDOWS */
+FONTOBJ = font.o
+#endif /* ! HAVE_X_WINDOWS */
+#else /* ! USE_FONT_BACKEND */
+FONTOBJ = font.o
+#endif /* ! USE_FONT_BACKEND */
+#endif /* HAVE_WINDOW_SYSTEM */
+
/* lastfile must follow all files
whose initialized data areas should be dumped as pure by dump-emacs. */
obj= dispnew.o frame.o scroll.o xdisp.o $(XMENU_OBJ) window.o \
- charset.o coding.o category.o ccl.o \
+ charset.o coding.o category.o ccl.o character.o chartab.o \
cm.o term.o terminal.o xfaces.o $(XOBJ) $(GTK_OBJ) $(DBUS_OBJ) \
emacs.o keyboard.o macros.o keymap.o sysdep.o \
buffer.o filelock.o insdel.o marker.o \
process.o callproc.o \
region-cache.o sound.o atimer.o \
doprnt.o strftime.o intervals.o textprop.o composite.o md5.o \
- $(MSDOS_OBJ) $(MAC_OBJ) $(CYGWIN_OBJ)
+ $(MSDOS_OBJ) $(MAC_OBJ) $(CYGWIN_OBJ) $(FONTOBJ)
/* Object files used on some machine or other.
These go in the DOC file on all machines
xterm.o xfns.o xmenu.o xselect.o xrdb.o xsmfns.o fringe.o image.o \
mac.o macterm.o macfns.o macmenu.o macselect.o fontset.o \
w32.o w32bdf.o w32console.o w32fns.o w32heap.o w32inevt.o \
- w32menu.o w32proc.o w32reg.o w32select.o w32term.o w32xfns.o
+ w32menu.o w32proc.o w32reg.o w32select.o w32term.o w32xfns.o $(FONTOBJ)
#ifdef TERMINFO
${lispsource}buff-menu.elc \
${lispsource}button.elc \
${lispsource}emacs-lisp/byte-run.elc \
+ ${lispsource}composite.elc \
${lispsource}cus-face.elc \
${lispsource}cus-start.elc \
${lispsource}custom.elc \
${lispsource}international/mule-conf.el \
${lispsource}international/mule-cmds.elc \
${lispsource}international/characters.elc \
- ${lispsource}international/ucs-tables.elc \
- ${lispsource}international/utf-8.elc \
- ${lispsource}international/utf-16.elc \
- ${lispsource}international/latin-1.el \
- ${lispsource}international/latin-2.el \
- ${lispsource}international/latin-3.el \
- ${lispsource}international/latin-4.el \
- ${lispsource}international/latin-5.el \
- ${lispsource}international/latin-8.el \
- ${lispsource}international/latin-9.el \
+ ${lispsource}international/charprop.el \
${lispsource}case-table.elc \
- ${lispsource}language/chinese.elc \
- ${lispsource}language/cyrillic.elc \
- ${lispsource}language/indian.elc \
+ ${lispsource}language/chinese.el \
+ ${lispsource}language/cyrillic.el \
+ ${lispsource}language/indian.el \
${lispsource}language/devanagari.el \
${lispsource}language/kannada.el \
${lispsource}language/malayalam.el \
${lispsource}language/japanese.el \
${lispsource}language/korean.el \
${lispsource}language/lao.el \
+ ${lispsource}language/tai-viet.el \
${lispsource}language/thai.el \
${lispsource}language/tibetan.elc \
- ${lispsource}language/vietnamese.elc \
+ ${lispsource}language/vietnamese.el \
${lispsource}language/misc-lang.el \
${lispsource}language/utf-8-lang.el \
${lispsource}language/georgian.el \
+ ${lispsource}language/khmer.el \
+ ${lispsource}language/myanmar.el \
${lispsource}paths.el \
${lispsource}register.elc \
${lispsource}replace.elc \
../lisp/buff-menu.elc \
../lisp/button.elc \
../lisp/emacs-lisp/byte-run.elc \
+ ../lisp/composite.elc \
../lisp/cus-face.elc \
../lisp/cus-start.elc \
../lisp/custom.elc \
../lisp/international/mule-conf.el \
../lisp/international/mule-cmds.elc \
../lisp/international/characters.elc \
- ../lisp/international/ucs-tables.elc \
- ../lisp/international/utf-8.elc \
- ../lisp/international/utf-16.elc \
- ../lisp/international/latin-1.el \
- ../lisp/international/latin-2.el \
- ../lisp/international/latin-3.el \
- ../lisp/international/latin-4.el \
- ../lisp/international/latin-5.el \
- ../lisp/international/latin-8.el \
- ../lisp/international/latin-9.el \
../lisp/case-table.elc \
- ../lisp/language/chinese.elc \
- ../lisp/language/cyrillic.elc \
- ../lisp/language/indian.elc \
+ ../lisp/language/chinese.el \
+ ../lisp/language/cyrillic.el \
+ ../lisp/language/indian.el \
../lisp/language/devanagari.el \
../lisp/language/kannada.el \
../lisp/language/malayalam.el \
../lisp/language/japanese.el \
../lisp/language/korean.el \
../lisp/language/lao.el \
+ ../lisp/language/tai-viet.el \
../lisp/language/thai.el \
../lisp/language/tibetan.elc \
- ../lisp/language/vietnamese.elc \
+ ../lisp/language/vietnamese.el \
../lisp/language/misc-lang.el \
../lisp/language/utf-8-lang.el \
../lisp/language/georgian.el \
+ ../lisp/language/khmer.el \
+ ../lisp/language/myanmar.el \
../lisp/menu-bar.elc \
../lisp/paths.el \
../lisp/register.elc \
with GCC, we might need gnulib again after them. */
LIBES = $(LOADLIBES) $(LIBS) $(LIBX) $(LIBSOUND) $(RSVG_LIBS) $(DBUS_LIBS) \
LIBGPM LIBRESOLV LIBS_SYSTEM LIBS_MACHINE LIBS_TERMCAP \
- LIBS_DEBUG $(GETLOADAVG_LIBS) $(GNULIB_VAR) LIB_MATH LIB_STANDARD \
- $(GNULIB_VAR)
+ LIBS_DEBUG $(GETLOADAVG_LIBS) \
+ @FREETYPE_LIBS@ @FONTCONFIG_LIBS@ @LIBOTF_LIBS@ @M17N_FLT_LIBS@ \
+ $(GNULIB_VAR) LIB_MATH LIB_STANDARD $(GNULIB_VAR)
/* Enable recompilation of certain other files depending on system type. */
#define OBJECTS_MACHINE
#endif
-RUN_TEMACS = ./temacs
+#ifdef HAVE_SHM
+RUN_TEMACS = `/bin/pwd`/temacs -nl
+#else
+RUN_TEMACS = `/bin/pwd`/temacs
+#endif
all: emacs${EXEEXT} OTHER_FILES
rm -f emacs${EXEEXT}
ln temacs${EXEEXT} emacs${EXEEXT}
#else
-#ifdef HAVE_SHM
- LC_ALL=C $(RUN_TEMACS) -nl -batch -l loadup dump
-#else /* ! defined (HAVE_SHM) */
LC_ALL=C $(RUN_TEMACS) -batch -l loadup dump
-#endif /* ! defined (HAVE_SHM) */
#endif /* ! defined (CANNOT_DUMP) */
-./emacs -q -batch -f list-load-path-shadows
${libsrc}make-docfile${EXEEXT}:
cd ${libsrc}; ${MAKE} ${MFLAGS} make-docfile${EXEEXT}
+#ifdef HAVE_UNIDATA
+UNIDATA=${admindir}unidata/UnicodeData.txt
+
+${lispsource}international/charprop.el: temacs${EXEEXT} ${UNIDATA}
+ RUNEMACS="$(RUN_TEMACS)"; \
+ cd ${admindir}unidata; \
+ $(MAKE) $(MFLAGS) \
+ RUNEMACS="$${RUNEMACS}" DSTDIR=${lispsource}international
+#endif
+
/* Some systems define this to cause parallel Make-ing. */
#ifndef MAKE_PARALLEL
#define MAKE_PARALLEL
it is so often changed in ways that do not require any recompilation
and so rarely changed in ways that do require any. */
+abbrev.o: abbrev.c buffer.h window.h dispextern.h commands.h character.h \
+ syntax.h $(config_h)
buffer.o: buffer.c buffer.h region-cache.h commands.h window.h \
- dispextern.h $(INTERVAL_SRC) blockinput.h atimer.h systime.h charset.h \
+ dispextern.h $(INTERVAL_SRC) blockinput.h atimer.h systime.h character.h \
$(config_h)
callint.o: callint.c window.h commands.h buffer.h keymap.h \
keyboard.h dispextern.h $(config_h)
callproc.o: callproc.c epaths.h buffer.h commands.h $(config_h) \
- process.h systty.h syssignal.h charset.h coding.h ccl.h msdos.h \
+ process.h systty.h syssignal.h character.h coding.h ccl.h msdos.h \
composite.h w32.h blockinput.h atimer.h systime.h frame.h termhooks.h
-casefiddle.o: casefiddle.c syntax.h commands.h buffer.h composite.h \
+casefiddle.o: casefiddle.c syntax.h commands.h buffer.h character.h \
+ composite.h \
charset.h keymap.h $(config_h)
casetab.o: casetab.c buffer.h $(config_h)
-category.o: category.c category.h buffer.h charset.h keymap.h $(config_h)
-ccl.o: ccl.c ccl.h charset.h coding.h $(config_h)
-charset.o: charset.c charset.h buffer.h coding.h composite.h disptab.h \
- $(config_h)
-coding.o: coding.c coding.h ccl.h buffer.h charset.h intervals.h composite.h \
+category.o: category.c category.h buffer.h charset.h keymap.h \
+ character.h $(config_h)
+ccl.o: ccl.c ccl.h charset.h character.h coding.h $(config_h)
+character.o: character.c character.h buffer.h charset.h composite.h disptab.h \
+ $(config.h)
+charset.o: charset.c charset.h character.h buffer.h coding.h composite.h \
+ disptab.h $(config_h)
+chartab.o: charset.h character.h $(config.h)
+coding.o: coding.c coding.h ccl.h buffer.h character.h charset.h intervals.h composite.h \
window.h dispextern.h frame.h termhooks.h $(config_h)
cm.o: cm.c frame.h cm.h termhooks.h termchar.h $(config_h)
-cmds.o: cmds.c syntax.h buffer.h charset.h commands.h window.h $(config_h) \
+cmds.o: cmds.c syntax.h buffer.h character.h commands.h window.h $(config_h) \
msdos.h dispextern.h keyboard.h keymap.h
pre-crt0.o: pre-crt0.c
ecrt0.o: ecrt0.c $(config_h)
CRT0_COMPILE ${srcdir}/ecrt0.c
-dired.o: dired.c commands.h buffer.h $(config_h) charset.h coding.h regex.h \
- systime.h blockinput.h atimer.h
+dired.o: dired.c commands.h buffer.h $(config_h) character.h charset.h \
+ coding.h regex.h systime.h blockinput.h atimer.h
dispnew.o: dispnew.c systime.h commands.h process.h frame.h \
window.h buffer.h dispextern.h termchar.h termopts.h termhooks.h cm.h \
disptab.h indent.h intervals.h \
- xterm.h blockinput.h atimer.h charset.h msdos.h composite.h keyboard.h \
+ xterm.h blockinput.h atimer.h character.h msdos.h composite.h keyboard.h \
$(config_h)
-doc.o: doc.c $(config_h) epaths.h buffer.h keyboard.h keymap.h charset.h
-doprnt.o: doprnt.c charset.h $(config_h)
+doc.o: doc.c $(config_h) epaths.h buffer.h keyboard.h keymap.h character.h
+doprnt.o: doprnt.c character.h $(config_h)
dosfns.o: buffer.h termchar.h termhooks.h frame.h blockinput.h window.h \
msdos.h dosfns.h dispextern.h charset.h coding.h atimer.h systime.h \
$(config_h)
-editfns.o: editfns.c window.h buffer.h systime.h $(INTERVAL_SRC) charset.h \
+editfns.o: editfns.c window.h buffer.h systime.h $(INTERVAL_SRC) character.h \
coding.h dispextern.h frame.h blockinput.h atimer.h $(config_h)
emacs.o: emacs.c commands.h systty.h syssignal.h blockinput.h process.h \
termhooks.h buffer.h atimer.h systime.h $(INTERVAL_SRC) $(config_h) \
window.h dispextern.h keyboard.h keymap.h
-fileio.o: fileio.c window.h buffer.h systime.h $(INTERVAL_SRC) charset.h \
+fileio.o: fileio.c window.h buffer.h systime.h $(INTERVAL_SRC) character.h \
coding.h msdos.h dispextern.h blockinput.h atimer.h $(config_h)
-filelock.o: filelock.c buffer.h charset.h coding.h systime.h epaths.h $(config_h)
+filelock.o: filelock.c buffer.h character.h charset.h coding.h systime.h \
+ epaths.h $(config_h)
filemode.o: filemode.c $(config_h)
frame.o: frame.c xterm.h window.h frame.h termhooks.h commands.h keyboard.h \
- blockinput.h atimer.h systime.h buffer.h charset.h fontset.h \
+ blockinput.h atimer.h systime.h buffer.h character.h fontset.h \
msdos.h dosfns.h dispextern.h w32term.h macterm.h termchar.h $(config_h)
fringe.o: fringe.c dispextern.h frame.h window.h buffer.h termhooks.h $(config_h)
-fontset.o: dispextern.h fontset.h fontset.c ccl.h buffer.h charset.h frame.h \
- keyboard.h termhooks.h $(config_h)
+font.o: font.c dispextern.h frame.h window.h ccl.h character.h charset.h \
+ font.h $(config_h)
+ftfont.o: dispextern.h frame.h character.h charset.h font.h $(config_h)
+fontset.o: dispextern.h fontset.h fontset.c ccl.h buffer.h character.h \
+ charset.h frame.h keyboard.h termhooks.h $(FONTSRC) $(config_h)
getloadavg.o: getloadavg.c $(config_h)
image.o: image.c frame.h window.h dispextern.h blockinput.h atimer.h \
systime.h xterm.h w32term.h w32gui.h macterm.h macgui.h $(config_h)
indent.o: indent.c frame.h window.h indent.h buffer.h $(config_h) termchar.h \
- termopts.h disptab.h region-cache.h charset.h composite.h dispextern.h \
- keyboard.h
-insdel.o: insdel.c window.h buffer.h $(INTERVAL_SRC) blockinput.h charset.h \
+ termopts.h disptab.h region-cache.h character.h category.h composite.h \
+ dispextern.h keyboard.h
+insdel.o: insdel.c window.h buffer.h $(INTERVAL_SRC) blockinput.h character.h \
dispextern.h atimer.h systime.h region-cache.h $(config_h)
-keyboard.o: keyboard.c termchar.h termhooks.h termopts.h buffer.h charset.h \
+keyboard.o: keyboard.c termchar.h termhooks.h termopts.h buffer.h character.h \
commands.h frame.h window.h macros.h disptab.h keyboard.h syssignal.h \
systime.h dispextern.h syntax.h $(INTERVAL_SRC) blockinput.h \
atimer.h xterm.h puresize.h msdos.h keymap.h w32term.h macterm.h $(config_h)
keymap.o: keymap.c buffer.h commands.h keyboard.h termhooks.h blockinput.h \
- atimer.h systime.h puresize.h charset.h intervals.h keymap.h window.h \
+ atimer.h systime.h puresize.h character.h intervals.h keymap.h window.h \
$(config_h)
lastfile.o: lastfile.c $(config_h)
macros.o: macros.c window.h buffer.h commands.h macros.h keyboard.h \
gmalloc.o: gmalloc.c $(config_h)
ralloc.o: ralloc.c $(config_h)
vm-limit.o: vm-limit.c mem-limits.h $(config_h)
-marker.o: marker.c buffer.h charset.h $(config_h)
+marker.o: marker.c buffer.h character.h $(config_h)
md5.o: md5.c md5.h $(config_h)
minibuf.o: minibuf.c syntax.h dispextern.h frame.h window.h keyboard.h \
- buffer.h commands.h charset.h msdos.h $(INTERVAL_SRC) keymap.h \
+ buffer.h commands.h character.h msdos.h $(INTERVAL_SRC) keymap.h \
termhooks.h $(config_h)
mktime.o: mktime.c $(config_h)
msdos.o: msdos.c msdos.h dosfns.h systime.h termhooks.h dispextern.h frame.h \
- termopts.h termchar.h charset.h coding.h ccl.h disptab.h window.h \
+ termopts.h termchar.h character.h coding.h ccl.h disptab.h window.h \
keyboard.h intervals.h buffer.h commands.h blockinput.h atimer.h $(config_h)
process.o: process.c process.h buffer.h window.h termhooks.h termopts.h \
commands.h syssignal.h systime.h systty.h syswait.h frame.h dispextern.h \
blockinput.h atimer.h charset.h coding.h ccl.h msdos.h composite.h \
keyboard.h $(config_h)
-regex.o: regex.c syntax.h buffer.h $(config_h) regex.h category.h charset.h
+regex.o: regex.c syntax.h buffer.h $(config_h) regex.h category.h character.h \
+ charset.h
region-cache.o: region-cache.c buffer.h region-cache.h $(config_h)
scroll.o: scroll.c termchar.h dispextern.h frame.h msdos.h keyboard.h \
termhooks.h $(config_h)
search.o: search.c regex.h commands.h buffer.h region-cache.h syntax.h \
- blockinput.h atimer.h systime.h category.h charset.h composite.h \
- $(INTERVAL_SRC) $(config_h)
+ blockinput.h atimer.h systime.h category.h character.h charset.h \
+ composite.h $(INTERVAL_SRC) \
+ $(config_h)
strftime.o: strftime.c $(config_h)
-syntax.o: syntax.c syntax.h buffer.h commands.h category.h charset.h \
+syntax.o: syntax.c syntax.h buffer.h commands.h category.h character.h \
composite.h keymap.h regex.h $(INTERVAL_SRC) $(config_h)
sysdep.o: sysdep.c syssignal.h systty.h systime.h syswait.h blockinput.h \
process.h dispextern.h termhooks.h termchar.h termopts.h \
frame.h atimer.h window.h msdos.h dosfns.h keyboard.h cm.h $(config_h)
term.o: term.c termchar.h termhooks.h termopts.h $(config_h) cm.h frame.h \
- disptab.h dispextern.h keyboard.h charset.h coding.h ccl.h msdos.h \
- window.h keymap.h blockinput.h atimer.h systime.h
+ disptab.h dispextern.h keyboard.h character.h charset.h coding.h ccl.h \
+ msdos.h window.h keymap.h blockinput.h atimer.h systime.h
termcap.o: termcap.c $(config_h)
terminal.o: terminal.c frame.h termchar.h termhooks.h charset.h coding.h \
keyboard.h $(config_h)
disptab.h keyboard.h dispextern.h msdos.h composite.h \
keymap.h blockinput.h atimer.h systime.h $(INTERVAL_SRC) \
xterm.h w32term.h macterm.h $(config_h)
-xdisp.o: xdisp.c macros.h commands.h process.h indent.h buffer.h dispextern.h coding.h \
- termchar.h frame.h window.h disptab.h termhooks.h charset.h $(config_h) \
- keyboard.h $(INTERVAL_SRC) region-cache.h xterm.h w32term.h macterm.h \
- msdos.h composite.h fontset.h blockinput.h atimer.h systime.h keymap.h
-xfaces.o: xfaces.c dispextern.h frame.h xterm.h buffer.h blockinput.h \
- window.h charset.h msdos.h dosfns.h composite.h atimer.h systime.h \
- keyboard.h fontset.h w32term.h macterm.h $(INTERVAL_SRC) termchar.h \
- termhooks.h $(config_h)
+xdisp.o: xdisp.c macros.h commands.h process.h indent.h buffer.h dispextern.h \
+ coding.h termchar.h frame.h window.h disptab.h termhooks.h character.h \
+ charset.h $(config_h) keyboard.h $(INTERVAL_SRC) region-cache.h xterm.h \
+ w32term.h macterm.h msdos.h composite.h fontset.h blockinput.h atimer.h \
+ systime.h keymap.h $(FONTSRC)
+xfaces.o: xfaces.c dispextern.h frame.h xterm.h buffer.h blockinput.h \
+ window.h character.h charset.h msdos.h dosfns.h composite.h atimer.h \
+ systime.h keyboard.h fontset.h w32term.h macterm.h $(INTERVAL_SRC) \
+ termchar.h termhooks.h $(FONTSRC) $(config_h)
xfns.o: xfns.c buffer.h frame.h window.h keyboard.h xterm.h dispextern.h \
$(srcdir)/../lwlib/lwlib.h blockinput.h atimer.h systime.h epaths.h \
- charset.h gtkutil.h termchar.h termhooks.h $(config_h)
+ character.h charset.h coding.h gtkutil.h $(config_h) termhooks.h \
+ fontset.h termchar.h $(FONTSRC)
+xfont.o: dispextern.h xterm.h frame.h blockinput.h character.h charset.h \
+ font.h $(config_h)
+xftfont.o: dispextern.h xterm.h frame.h blockinput.h character.h charset.h \
+ font.h $(config_h)
+ftxfont.o: dispextern.h xterm.h frame.h blockinput.h character.h charset.h \
+ font.h $(config_h)
xmenu.o: xmenu.c xterm.h termhooks.h window.h dispextern.h frame.h buffer.h \
- keyboard.h $(srcdir)/../lwlib/lwlib.h blockinput.h atimer.h systime.h \
- gtkutil.h msdos.h coding.h $(config_h)
+ charset.h keyboard.h $(srcdir)/../lwlib/lwlib.h blockinput.h atimer.h \
+ systime.h gtkutil.h msdos.h coding.h $(config_h)
xterm.o: xterm.c xterm.h termhooks.h termopts.h termchar.h window.h buffer.h \
- dispextern.h frame.h disptab.h blockinput.h atimer.h systime.h syssignal.h \
- keyboard.h gnu.h charset.h ccl.h fontset.h composite.h \
- coding.h process.h gtkutil.h $(config_h)
+ dispextern.h frame.h disptab.h blockinput.h atimer.h systime.h syssignal.h \
+ keyboard.h gnu.h character.h charset.h ccl.h fontset.h composite.h \
+ coding.h process.h gtkutil.h $(FONTSRC) $(config_h)
xselect.o: xselect.c process.h dispextern.h frame.h xterm.h blockinput.h \
buffer.h atimer.h systime.h termhooks.h $(config_h)
xrdb.o: xrdb.c $(config_h) epaths.h
/* The files of Lisp proper */
alloc.o: alloc.c process.h frame.h window.h buffer.h puresize.h syssignal.h keyboard.h \
- blockinput.h atimer.h systime.h charset.h dispextern.h $(config_h) $(INTERVAL_SRC)
-bytecode.o: bytecode.c buffer.h syntax.h charset.h window.h dispextern.h \
+ blockinput.h atimer.h systime.h character.h dispextern.h $(config_h) \
+ $(INTERVAL_SRC)
+bytecode.o: bytecode.c buffer.h syntax.h character.h window.h dispextern.h \
frame.h xterm.h $(config_h)
-data.o: data.c buffer.h puresize.h charset.h syssignal.h keyboard.h frame.h termhooks.h $(config_h)
+data.o: data.c buffer.h puresize.h character.h syssignal.h keyboard.h frame.h \
+ termhooks.h $(config_h)
eval.o: eval.c commands.h keyboard.h blockinput.h atimer.h systime.h \
dispextern.h $(config_h)
floatfns.o: floatfns.c $(config_h)
-fns.o: fns.c commands.h $(config_h) frame.h buffer.h charset.h keyboard.h \
+fns.o: fns.c commands.h $(config_h) frame.h buffer.h character.h keyboard.h \
keymap.h frame.h window.h dispextern.h $(INTERVAL_SRC) coding.h md5.h \
blockinput.h atimer.h systime.h xterm.h termhooks.h
-print.o: print.c process.h frame.h window.h buffer.h keyboard.h charset.h \
+print.o: print.c process.h frame.h window.h buffer.h keyboard.h character.h \
$(config_h) dispextern.h termchar.h $(INTERVAL_SRC) msdos.h composite.h \
blockinput.h atimer.h systime.h
-lread.o: lread.c commands.h keyboard.h buffer.h epaths.h charset.h \
- $(config_h) $(INTERVAL_SRC) termhooks.h coding.h msdos.h
+lread.o: lread.c commands.h keyboard.h buffer.h epaths.h character.h \
+ charset.h $(config_h) $(INTERVAL_SRC) termhooks.h coding.h msdos.h
/* Text properties support */
textprop.o: textprop.c buffer.h window.h dispextern.h $(INTERVAL_SRC) \
$(config_h)
intervals.o: intervals.c buffer.h $(INTERVAL_SRC) keyboard.h puresize.h \
keymap.h $(config_h)
-composite.o: composite.c buffer.h charset.h $(INTERVAL_SRC) $(config_h)
+composite.o: composite.c buffer.h character.h $(INTERVAL_SRC) $(config_h)
/* System-specific programs to be made.
OTHER_FILES and OBJECTS_MACHINE
/* Dump an Emacs executable named bootstrap-emacs containing the
files from loadup.el in source form. */
-bootstrap-emacs${EXEEXT}: temacs${EXEEXT}
+bootstrap-emacs${EXEEXT}: temacs${EXEEXT} ${lispsource}international/charprop.el
#ifdef CANNOT_DUMP
ln temacs${EXEEXT} bootstrap-emacs${EXEEXT}
#else
-#ifdef HAVE_SHM
- $(RUN_TEMACS) -nl -batch -l loadup bootstrap
-#else /* ! defined (HAVE_SHM) */
$(RUN_TEMACS) --batch --load loadup bootstrap
-#endif /* ! defined (HAVE_SHM) */
mv -f emacs${EXEEXT} bootstrap-emacs${EXEEXT}
#endif /* ! defined (CANNOT_DUMP) */
/* Storage allocation and gc for GNU Emacs Lisp interpreter.
Copyright (C) 1985, 1986, 1988, 1993, 1994, 1995, 1997, 1998, 1999,
- 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
+ Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include "keyboard.h"
#include "frame.h"
#include "blockinput.h"
-#include "charset.h"
+#include "character.h"
#include "syssignal.h"
#include "termhooks.h" /* For struct terminal. */
#include <setjmp.h>
/* Addresses of staticpro'd variables. Initialize it to a nonzero
value; otherwise some compilers put it into BSS. */
-#define NSTATICS 1280
+#define NSTATICS 0x600
static Lisp_Object *staticvec[NSTATICS] = {&Vpurify_flag};
/* Index of next unused slot in staticvec. */
CHECK_NUMBER (init);
c = XINT (init);
- if (SINGLE_BYTE_CHAR_P (c))
+ if (ASCII_CHAR_P (c))
{
nbytes = XINT (length);
val = make_uninit_string (nbytes);
}
-DEFUN ("make-char-table", Fmake_char_table, Smake_char_table, 1, 2, 0,
- doc: /* Return a newly created char-table, with purpose PURPOSE.
-Each element is initialized to INIT, which defaults to nil.
-PURPOSE should be a symbol which has a `char-table-extra-slots' property.
-The property's value should be an integer between 0 and 10. */)
- (purpose, init)
- register Lisp_Object purpose, init;
-{
- Lisp_Object vector;
- Lisp_Object n;
- CHECK_SYMBOL (purpose);
- n = Fget (purpose, Qchar_table_extra_slots);
- CHECK_NUMBER (n);
- if (XINT (n) < 0 || XINT (n) > 10)
- args_out_of_range (n, Qnil);
- /* Add 2 to the size for the defalt and parent slots. */
- vector = Fmake_vector (make_number (CHAR_TABLE_STANDARD_SLOTS + XINT (n)),
- init);
- XSETPVECTYPE (XVECTOR (vector), PVEC_CHAR_TABLE);
- XCHAR_TABLE (vector)->top = Qt;
- XCHAR_TABLE (vector)->parent = Qnil;
- XCHAR_TABLE (vector)->purpose = purpose;
- XSETCHAR_TABLE (vector, XCHAR_TABLE (vector));
- return vector;
-}
-
-
-/* Return a newly created sub char table with slots initialized by INIT.
- Since a sub char table does not appear as a top level Emacs Lisp
- object, we don't need a Lisp interface to make it. */
-
-Lisp_Object
-make_sub_char_table (init)
- Lisp_Object init;
-{
- Lisp_Object vector
- = Fmake_vector (make_number (SUB_CHAR_TABLE_STANDARD_SLOTS), init);
- XSETPVECTYPE (XVECTOR (vector), PVEC_CHAR_TABLE);
- XCHAR_TABLE (vector)->top = Qnil;
- XCHAR_TABLE (vector)->defalt = Qnil;
- XSETCHAR_TABLE (vector, XCHAR_TABLE (vector));
- return vector;
-}
-
-
DEFUN ("vector", Fvector, Svector, 0, MANY, 0,
doc: /* Return a newly created vector with specified arguments as elements.
Any number of arguments, even zero arguments, are allowed.
{
int mark_p = 0;
- switch (XGCTYPE (obj))
+ switch (XTYPE (obj))
{
case Lisp_String:
mark_p = (live_string_p (m, po)
break;
case Lisp_Vectorlike:
- /* Note: can't check GC_BUFFERP before we know it's a
+ /* Note: can't check BUFFERP before we know it's a
buffer because checking that dereferences the pointer
PO which might point anywhere. */
if (live_vector_p (m, po))
- mark_p = !GC_SUBRP (obj) && !VECTOR_MARKED_P (XVECTOR (obj));
+ mark_p = !SUBRP (obj) && !VECTOR_MARKED_P (XVECTOR (obj));
else if (live_buffer_p (m, po))
- mark_p = GC_BUFFERP (obj) && !VECTOR_MARKED_P (XBUFFER (obj));
+ mark_p = BUFFERP (obj) && !VECTOR_MARKED_P (XBUFFER (obj));
break;
case Lisp_Misc:
{
Lisp_Object tem;
XSETVECTOR (tem, p);
- if (!GC_SUBRP (tem) && !VECTOR_MARKED_P (XVECTOR (tem)))
+ if (!SUBRP (tem) && !VECTOR_MARKED_P (XVECTOR (tem)))
obj = tem;
}
break;
abort ();
}
- if (!GC_NILP (obj))
+ if (!NILP (obj))
mark_object (obj);
}
}
truncate_undo_list (nextb);
/* Shrink buffer gaps, but skip indirect and dead buffers. */
- if (nextb->base_buffer == 0 && !NILP (nextb->name))
+ if (nextb->base_buffer == 0 && !NILP (nextb->name)
+ && ! nextb->text->inhibit_shrinking)
{
/* If a buffer's gap size is more than 10% of the buffer
size, or larger than 2000 bytes, then shrink it
prev = Qnil;
while (CONSP (tail))
{
- if (GC_CONSP (XCAR (tail))
- && GC_MARKERP (XCAR (XCAR (tail)))
+ if (CONSP (XCAR (tail))
+ && MARKERP (XCAR (XCAR (tail)))
&& !XMARKER (XCAR (XCAR (tail)))->gcmarkbit)
{
if (NILP (prev))
struct glyph *end_glyph = glyph + row->used[area];
for (; glyph < end_glyph; ++glyph)
- if (GC_STRINGP (glyph->object)
+ if (STRINGP (glyph->object)
&& !STRING_MARKED_P (XSTRING (glyph->object)))
mark_object (glyph->object);
}
#endif /* not GC_CHECK_MARKED_OBJECTS */
- switch (SWITCH_ENUM_CAST (XGCTYPE (obj)))
+ switch (SWITCH_ENUM_CAST (XTYPE (obj)))
{
case Lisp_String:
{
case Lisp_Vectorlike:
#ifdef GC_CHECK_MARKED_OBJECTS
m = mem_find (po);
- if (m == MEM_NIL && !GC_SUBRP (obj)
+ if (m == MEM_NIL && !SUBRP (obj)
&& po != &buffer_defaults
&& po != &buffer_local_symbols)
abort ();
#endif /* GC_CHECK_MARKED_OBJECTS */
- if (GC_BUFFERP (obj))
+ if (BUFFERP (obj))
{
if (!VECTOR_MARKED_P (XBUFFER (obj)))
{
mark_buffer (obj);
}
}
- else if (GC_SUBRP (obj))
+ else if (SUBRP (obj))
break;
- else if (GC_COMPILEDP (obj))
+ else if (COMPILEDP (obj))
/* We could treat this just like a vector, but it is better to
save the COMPILED_CONSTANTS element for last and avoid
recursion there. */
obj = ptr->contents[COMPILED_CONSTANTS];
goto loop;
}
- else if (GC_FRAMEP (obj))
+ else if (FRAMEP (obj))
{
register struct frame *ptr = XFRAME (obj);
if (mark_vectorlike (XVECTOR (obj)))
#endif /* HAVE_WINDOW_SYSTEM */
}
}
- else if (GC_WINDOWP (obj))
+ else if (WINDOWP (obj))
{
register struct Lisp_Vector *ptr = XVECTOR (obj);
struct window *w = XWINDOW (obj);
}
}
}
- else if (GC_HASH_TABLE_P (obj))
+ else if (HASH_TABLE_P (obj))
{
struct Lisp_Hash_Table *h = XHASH_TABLE (obj);
if (mark_vectorlike ((struct Lisp_Vector *)h))
{ /* If hash table is not weak, mark all keys and values.
For weak tables, mark only the vector. */
- if (GC_NILP (h->weak))
+ if (NILP (h->weak))
mark_object (h->key_and_value);
else
VECTOR_MARK (XVECTOR (h->key_and_value));
{
int survives_p;
- switch (XGCTYPE (obj))
+ switch (XTYPE (obj))
{
case Lisp_Int:
survives_p = 1;
break;
case Lisp_Vectorlike:
- survives_p = GC_SUBRP (obj) || VECTOR_MARKED_P (XVECTOR (obj));
+ survives_p = SUBRP (obj) || VECTOR_MARKED_P (XVECTOR (obj));
break;
case Lisp_Cons:
defsubr (&Smake_byte_code);
defsubr (&Smake_list);
defsubr (&Smake_vector);
- defsubr (&Smake_char_table);
defsubr (&Smake_string);
defsubr (&Smake_bool_vector);
defsubr (&Smake_symbol);
/* Buffer manipulation primitives for GNU Emacs.
Copyright (C) 1985, 1986, 1987, 1988, 1989, 1993, 1994,
1995, 1997, 1998, 1999, 2000, 2001, 2002,
- 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ 2003, 2004, 2005, 2006, 2007, 2008
+ Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include "window.h"
#include "commands.h"
#include "buffer.h"
-#include "charset.h"
+#include "character.h"
#include "region-cache.h"
#include "indent.h"
#include "blockinput.h"
static void modify_overlay P_ ((struct buffer *, EMACS_INT, EMACS_INT));
static Lisp_Object buffer_lisp_local_variables P_ ((struct buffer *));
+extern char * emacs_strerror P_ ((int));
/* For debugging; temporary. See set_buffer_internal. */
/* Lisp_Object Qlisp_mode, Vcheck_symbol; */
doc: /* Set the multibyte flag of the current buffer to FLAG.
If FLAG is t, this makes the buffer a multibyte buffer.
If FLAG is nil, this makes the buffer a single-byte buffer.
-The buffer contents remain unchanged as a sequence of bytes
-but the contents viewed as characters do change.
+In these cases, the buffer contents remain unchanged as a sequence of
+bytes but the contents viewed as characters do change.
+If FLAG is `to', this makes the buffer a multibyte buffer by changing
+all eight-bit bytes to eight-bit characters.
If the multibyte flag was really changed, undo information of the
current buffer is cleared. */)
(flag)
p = GAP_END_ADDR;
stop = Z;
}
- if (MULTIBYTE_STR_AS_UNIBYTE_P (p, bytes))
- p += bytes, pos += bytes;
- else
+ if (ASCII_BYTE_P (*p))
+ p++, pos++;
+ else if (CHAR_BYTE8_HEAD_P (*p))
{
- c = STRING_CHAR (p, stop - pos);
+ c = STRING_CHAR_AND_LENGTH (p, stop - pos, bytes);
/* Delete all bytes for this 8-bit character but the
last one, and change the last one to the charcter
code. */
zv -= bytes;
stop = Z;
}
+ else
+ {
+ bytes = BYTES_BY_CHAR_HEAD (*p);
+ p += bytes, pos += bytes;
+ }
}
if (narrowed)
Fnarrow_to_region (make_number (begv), make_number (zv));
{
int pt = PT;
int pos, stop;
- unsigned char *p;
+ unsigned char *p, *pend;
/* Be sure not to have a multibyte sequence striding over the GAP.
- Ex: We change this: "...abc\201 _GAP_ \241def..."
- to: "...abc _GAP_ \201\241def..." */
+ Ex: We change this: "...abc\302 _GAP_ \241def..."
+ to: "...abc _GAP_ \302\241def..." */
- if (GPT_BYTE > 1 && GPT_BYTE < Z_BYTE
+ if (EQ (flag, Qt)
+ && GPT_BYTE > 1 && GPT_BYTE < Z_BYTE
&& ! CHAR_HEAD_P (*(GAP_END_ADDR)))
{
unsigned char *p = GPT_ADDR - 1;
pos = BEG;
stop = GPT;
p = BEG_ADDR;
+ pend = GPT_ADDR;
while (1)
{
int bytes;
if (pos == Z)
break;
p = GAP_END_ADDR;
+ pend = Z_ADDR;
stop = Z;
}
- if (UNIBYTE_STR_AS_MULTIBYTE_P (p, stop - pos, bytes))
+ if (ASCII_BYTE_P (*p))
+ p++, pos++;
+ else if (EQ (flag, Qt) && (bytes = MULTIBYTE_LENGTH (p, pend)) > 0)
p += bytes, pos += bytes;
else
{
unsigned char tmp[MAX_MULTIBYTE_LENGTH];
+ int c;
- bytes = CHAR_STRING (*p, tmp);
+ c = BYTE8_TO_CHAR (*p);
+ bytes = CHAR_STRING (c, tmp);
*p = tmp[0];
TEMP_SET_PT_BOTH (pos + 1, pos + 1);
bytes--;
zv += bytes;
if (pos <= pt)
pt += bytes;
+ pend = Z_ADDR;
stop = Z;
}
}
int endpos;
XSETMISC (overlay ,tail);
- if (!GC_OVERLAYP (overlay))
+ if (!OVERLAYP (overlay))
abort ();
endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
int startpos;
XSETMISC (overlay, tail);
- if (!GC_OVERLAYP (overlay))
+ if (!OVERLAYP (overlay))
abort ();
startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
/* Header file for the buffer manipulation primitives.
Copyright (C) 1985, 1986, 1993, 1994, 1995, 1997, 1998, 1999, 2000, 2001,
- 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ 2002, 2003, 2004, 2005, 2006, 2007, 2008
+ Free Software Foundation, Inc.
This file is part of GNU Emacs.
/* Variables used locally in FETCH_MULTIBYTE_CHAR. */
extern unsigned char *_fetch_multibyte_char_p;
-extern int _fetch_multibyte_char_len;
/* Return character code of multi-byte form at position POS. If POS
doesn't point the head of valid multi-byte form, only the byte at
#define FETCH_MULTIBYTE_CHAR(pos) \
(_fetch_multibyte_char_p = (((pos) >= GPT_BYTE ? GAP_SIZE : 0) \
- + (pos) + BEG_ADDR - BEG_BYTE), \
- _fetch_multibyte_char_len \
- = ((pos) >= GPT_BYTE ? ZV_BYTE : GPT_BYTE) - (pos), \
- STRING_CHAR (_fetch_multibyte_char_p, _fetch_multibyte_char_len))
+ + (pos) + BEG_ADDR - BEG_BYTE), \
+ STRING_CHAR (_fetch_multibyte_char_p, 0))
+
+/* Return character at position POS. If the current buffer is unibyte
+ and the character is not ASCII, make the returning character
+ multibyte. */
+
+#define FETCH_CHAR_AS_MULTIBYTE(pos) \
+ (!NILP (current_buffer->enable_multibyte_characters) \
+ ? FETCH_MULTIBYTE_CHAR ((pos)) \
+ : unibyte_char_to_multibyte (FETCH_BYTE ((pos))))
+
\f
/* Macros for accessing a character or byte,
or converting between byte positions and addresses,
(_fetch_multibyte_char_p \
= (((pos) >= BUF_GPT_BYTE (buf) ? BUF_GAP_SIZE (buf) : 0) \
+ (pos) + BUF_BEG_ADDR (buf) - BEG_BYTE), \
- _fetch_multibyte_char_len \
- = (((pos) >= BUF_GPT_BYTE (buf) ? BUF_ZV_BYTE (buf) : BUF_GPT_BYTE (buf)) \
- - (pos)), \
- STRING_CHAR (_fetch_multibyte_char_p, _fetch_multibyte_char_len))
+ STRING_CHAR (_fetch_multibyte_char_p, 0))
\f
/* Define the actual buffer data structures. */
successive elements in its marker `chain'
are the other markers referring to this buffer. */
struct Lisp_Marker *markers;
+
+ /* Usually 0. Temporarily set to 1 in decode_coding_gap to
+ prevent Fgarbage_collect from shrinking the gap and loosing
+ not-yet-decoded bytes. */
+ int inhibit_shrinking;
};
/* This is the structure that the buffer Lisp object points to. */
} \
} while (0)
+EXFUN (Fbuffer_live_p, 1);
EXFUN (Fbuffer_name, 1);
EXFUN (Fget_file_buffer, 1);
EXFUN (Fnext_overlay_change, 1);
We assume you know which buffer it's pointing into. */
#define OVERLAY_POSITION(P) \
- (GC_MARKERP (P) ? marker_position (P) : (abort (), 0))
+ (MARKERP (P) ? marker_position (P) : (abort (), 0))
\f
/***********************************************************************
/* Execution of byte code produced by bytecomp.el.
Copyright (C) 1985, 1986, 1987, 1988, 1993, 2000, 2001, 2002, 2003, 2004,
- 2005, 2006, 2007 Free Software Foundation, Inc.
+ 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include <config.h>
#include "lisp.h"
#include "buffer.h"
-#include "charset.h"
+#include "character.h"
#include "syntax.h"
#include "window.h"
break;
case Bchar_syntax:
- BEFORE_POTENTIAL_GC ();
- CHECK_NUMBER (TOP);
- AFTER_POTENTIAL_GC ();
- XSETFASTINT (TOP, syntax_code_spec[(int) SYNTAX (XINT (TOP))]);
+ {
+ int c;
+
+ BEFORE_POTENTIAL_GC ();
+ CHECK_CHARACTER (TOP);
+ AFTER_POTENTIAL_GC ();
+ c = XFASTINT (TOP);
+ if (NILP (current_buffer->enable_multibyte_characters))
+ MAKE_CHAR_MULTIBYTE (c);
+ XSETFASTINT (TOP, syntax_code_spec[(int) SYNTAX (c)]);
+ }
break;
case Bbuffer_substring:
/* Synchronous subprocess invocation for GNU Emacs.
Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995, 1999, 2000, 2001,
- 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ 2002, 2003, 2004, 2005, 2006, 2007, 2008
+ Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include "lisp.h"
#include "commands.h"
#include "buffer.h"
-#include "charset.h"
+#include "character.h"
#include "ccl.h"
#include "coding.h"
#include "composite.h"
if (nargs >= 5)
{
int must_encode = 0;
+ Lisp_Object coding_attrs;
for (i = 4; i < nargs; i++)
CHECK_STRING (args[i]);
else
val = Qnil;
}
+ val = coding_inherit_eol_type (val, Qnil);
setup_coding_system (Fcheck_coding_system (val), &argument_coding);
- if (argument_coding.common_flags & CODING_ASCII_INCOMPATIBLE_MASK)
- setup_coding_system (Qraw_text, &argument_coding);
- if (argument_coding.eol_type == CODING_EOL_UNDECIDED)
- argument_coding.eol_type = system_eol_type;
+ coding_attrs = CODING_ID_ATTRS (argument_coding.id);
+ if (NILP (CODING_ATTR_ASCII_COMPAT (coding_attrs)))
+ {
+ /* We should not use an ASCII incompatible coding system. */
+ val = raw_text_coding_system (val);
+ setup_coding_system (val, &argument_coding);
+ }
}
}
{
argument_coding.src_multibyte = STRING_MULTIBYTE (args[i]);
if (CODING_REQUIRE_ENCODING (&argument_coding))
- {
- /* We must encode this argument. */
- args[i] = encode_coding_string (args[i], &argument_coding, 1);
- if (argument_coding.type == coding_type_ccl)
- setup_ccl_program (&(argument_coding.spec.ccl.encoder), Qnil);
- }
+ /* We must encode this argument. */
+ args[i] = encode_coding_string (&argument_coding, args[i], 1);
new_argv[i - 3] = SDATA (args[i]);
}
UNGCPRO;
else
val = Qnil;
}
- setup_coding_system (Fcheck_coding_system (val), &process_coding);
+ Fcheck_coding_system (val);
/* In unibyte mode, character code conversion should not take
place but EOL conversion should. So, setup raw-text or one
of the subsidiary according to the information just setup. */
if (NILP (current_buffer->enable_multibyte_characters)
&& !NILP (val))
- setup_raw_text_coding_system (&process_coding);
+ val = raw_text_coding_system (val);
+ setup_coding_system (val, &process_coding);
}
- process_coding.src_multibyte = 0;
- process_coding.dst_multibyte
- = (BUFFERP (buffer)
- ? ! NILP (XBUFFER (buffer)->enable_multibyte_characters)
- : ! NILP (current_buffer->enable_multibyte_characters));
immediate_quit = 1;
QUIT;
int carryover = 0;
int display_on_the_fly = display_p;
struct coding_system saved_coding;
- int pt_orig = PT, pt_byte_orig = PT_BYTE;
- int inserted;
saved_coding = process_coding;
- if (process_coding.composing != COMPOSITION_DISABLED)
- coding_allocate_composition_data (&process_coding, PT);
while (1)
{
/* Repeatedly read until we've filled as much as possible
if (!NILP (buffer))
{
- if (! CODING_MAY_REQUIRE_DECODING (&process_coding))
+ if (NILP (current_buffer->enable_multibyte_characters)
+ && ! CODING_MAY_REQUIRE_DECODING (&process_coding))
insert_1_both (buf, nread, nread, 0, 1, 0);
else
{ /* We have to decode the input. */
- int size;
- char *decoding_buf;
-
- repeat_decoding:
- size = decoding_buffer_size (&process_coding, nread);
- decoding_buf = (char *) xmalloc (size);
-
- /* We can't use the macro CODING_REQUIRE_DETECTION
- because it always returns nonzero if the coding
- system requires EOL detection. Here, we have to
- check only whether or not the coding system
- requires text-encoding detection. */
- if (process_coding.type == coding_type_undecided)
- {
- detect_coding (&process_coding, buf, nread);
- if (process_coding.composing != COMPOSITION_DISABLED)
- /* We have not yet allocated the composition
- data because the coding type was undecided. */
- coding_allocate_composition_data (&process_coding, PT);
- }
- if (process_coding.cmp_data)
- process_coding.cmp_data->char_offset = PT;
-
- decode_coding (&process_coding, buf, decoding_buf,
- nread, size);
+ Lisp_Object curbuf;
+ XSETBUFFER (curbuf, current_buffer);
+ decode_coding_c_string (&process_coding, buf, nread,
+ curbuf);
if (display_on_the_fly
- && saved_coding.type == coding_type_undecided
- && process_coding.type != coding_type_undecided)
+ && CODING_REQUIRE_DETECTION (&saved_coding)
+ && ! CODING_REQUIRE_DETECTION (&process_coding))
{
/* We have detected some coding system. But,
there's a possibility that the detection was
- done by insufficient data. So, we try the code
- detection again with more data. */
- xfree (decoding_buf);
+ done by insufficient data. So, we give up
+ displaying on the fly. */
+ if (process_coding.produced > 0)
+ del_range_2 (process_coding.dst_pos,
+ process_coding.dst_pos_byte,
+ process_coding.dst_pos
+ + process_coding.produced_char,
+ process_coding.dst_pos_byte
+ + process_coding.produced, 0);
display_on_the_fly = 0;
process_coding = saved_coding;
carryover = nread;
/* This is to make the above condition always
fails in the future. */
- saved_coding.type = coding_type_no_conversion;
+ saved_coding.common_flags
+ &= ~CODING_REQUIRE_DETECTION_MASK;
continue;
}
- if (process_coding.produced > 0)
- insert_1_both (decoding_buf, process_coding.produced_char,
- process_coding.produced, 0, 1, 0);
- xfree (decoding_buf);
-
- if (process_coding.result == CODING_FINISH_INCONSISTENT_EOL)
- {
- Lisp_Object eol_type, coding;
-
- if (process_coding.eol_type == CODING_EOL_CR)
- {
- /* CRs have been replaced with LFs. Undo
- that in the text inserted above. */
- unsigned char *p;
-
- move_gap_both (PT, PT_BYTE);
-
- p = BYTE_POS_ADDR (pt_byte_orig);
- for (; p < GPT_ADDR; ++p)
- if (*p == '\n')
- *p = '\r';
- }
- else if (process_coding.eol_type == CODING_EOL_CRLF)
- {
- /* CR LFs have been replaced with LFs. Undo
- that by inserting CRs in front of LFs in
- the text inserted above. */
- EMACS_INT bytepos, old_pt, old_pt_byte, nCR;
-
- old_pt = PT;
- old_pt_byte = PT_BYTE;
- nCR = 0;
-
- for (bytepos = PT_BYTE - 1;
- bytepos >= pt_byte_orig;
- --bytepos)
- if (FETCH_BYTE (bytepos) == '\n')
- {
- EMACS_INT charpos = BYTE_TO_CHAR (bytepos);
- TEMP_SET_PT_BOTH (charpos, bytepos);
- insert_1_both ("\r", 1, 1, 0, 1, 0);
- ++nCR;
- }
-
- TEMP_SET_PT_BOTH (old_pt + nCR, old_pt_byte + nCR);
- }
-
- /* Set the coding system symbol to that for
- Unix-like EOL. */
- eol_type = Fget (saved_coding.symbol, Qeol_type);
- if (VECTORP (eol_type)
- && ASIZE (eol_type) == 3
- && SYMBOLP (AREF (eol_type, CODING_EOL_LF)))
- coding = AREF (eol_type, CODING_EOL_LF);
- else
- coding = saved_coding.symbol;
-
- process_coding.symbol = coding;
- process_coding.eol_type = CODING_EOL_LF;
- process_coding.mode
- &= ~CODING_MODE_INHIBIT_INCONSISTENT_EOL;
- }
-
- nread -= process_coding.consumed;
- carryover = nread;
+ TEMP_SET_PT_BOTH (PT + process_coding.produced_char,
+ PT_BYTE + process_coding.produced);
+ carryover = process_coding.carryover_bytes;
if (carryover > 0)
/* As CARRYOVER should not be that large, we had
better avoid overhead of bcopy. */
- BCOPY_SHORT (buf + process_coding.consumed, buf,
- carryover);
- if (process_coding.result == CODING_FINISH_INSUFFICIENT_CMP)
- {
- /* The decoding ended because of insufficient data
- area to record information about composition.
- We must try decoding with additional data area
- before reading more output for the process. */
- coding_allocate_composition_data (&process_coding, PT);
- goto repeat_decoding;
- }
+ BCOPY_SHORT (process_coding.carryover, buf,
+ process_coding.carryover_bytes);
}
}
}
give_up: ;
- if (!NILP (buffer)
- && process_coding.cmp_data)
- {
- coding_restore_composition (&process_coding, Fcurrent_buffer ());
- coding_free_composition_data (&process_coding);
- }
-
- {
- int post_read_count = SPECPDL_INDEX ();
-
- record_unwind_protect (save_excursion_restore, save_excursion_save ());
- inserted = PT - pt_orig;
- TEMP_SET_PT_BOTH (pt_orig, pt_byte_orig);
- if (SYMBOLP (process_coding.post_read_conversion)
- && !NILP (Ffboundp (process_coding.post_read_conversion)))
- call1 (process_coding.post_read_conversion, make_number (inserted));
-
- Vlast_coding_system_used = process_coding.symbol;
-
- /* If the caller required, let the buffer inherit the
- coding-system used to decode the process output. */
- if (inherit_process_coding_system)
- call1 (intern ("after-insert-file-set-buffer-file-coding-system"),
- make_number (total_read));
-
- unbind_to (post_read_count, Qnil);
- }
+ Vlast_coding_system_used = CODING_ID_NAME (process_coding.id);
+ /* If the caller required, let the buffer inherit the
+ coding-system used to decode the process output. */
+ if (inherit_process_coding_system)
+ call1 (intern ("after-insert-file-set-buffer-file-coding-system"),
+ make_number (total_read));
}
/* Wait for it to terminate, unless it already has. */
/* GNU Emacs case conversion functions.
Copyright (C) 1985, 1994, 1997, 1998, 1999, 2001, 2002, 2003, 2004,
- 2005, 2006, 2007 Free Software Foundation, Inc.
+ 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include <config.h>
#include "lisp.h"
#include "buffer.h"
-#include "charset.h"
+#include "character.h"
#include "commands.h"
#include "syntax.h"
#include "composite.h"
enum case_action flag;
Lisp_Object obj;
{
- register int i, c, len;
+ register int c, c1;
register int inword = flag == CASE_DOWN;
/* If the case table is flagged as modified, rescan it. */
int flagbits = (CHAR_ALT | CHAR_SUPER | CHAR_HYPER
| CHAR_SHIFT | CHAR_CTL | CHAR_META);
int flags = XINT (obj) & flagbits;
+ int multibyte = ! NILP (current_buffer->enable_multibyte_characters);
/* If the character has higher bits set
above the flags, return it unchanged.
if ((unsigned) XFASTINT (obj) > (unsigned) flagbits)
return obj;
- c = DOWNCASE (XFASTINT (obj) & ~flagbits);
+ c1 = XFASTINT (obj) & ~flagbits;
+ if (! multibyte)
+ MAKE_CHAR_MULTIBYTE (c1);
+ c = DOWNCASE (c1);
if (inword)
XSETFASTINT (obj, c | flags);
else if (c == (XFASTINT (obj) & ~flagbits))
{
- c = UPCASE1 ((XFASTINT (obj) & ~flagbits));
+ if (! inword)
+ c = UPCASE1 (c1);
+ if (! multibyte)
+ MAKE_CHAR_UNIBYTE (c);
XSETFASTINT (obj, c | flags);
}
return obj;
if (STRINGP (obj))
{
int multibyte = STRING_MULTIBYTE (obj);
- int n;
+ int i, i_byte, len;
+ int size = SCHARS (obj);
obj = Fcopy_sequence (obj);
- len = SBYTES (obj);
-
- /* I counts bytes, and N counts chars. */
- for (i = n = 0; i < len; n++)
+ for (i = i_byte = 0; i < size; i++, i_byte += len)
{
- int from_len = 1, to_len = 1;
-
- c = SREF (obj, i);
-
- if (multibyte && c >= 0x80)
- c = STRING_CHAR_AND_LENGTH (SDATA (obj) + i, len -i, from_len);
+ if (multibyte)
+ c = STRING_CHAR_AND_LENGTH (SDATA (obj) + i_byte, 0, len);
+ else
+ {
+ c = SREF (obj, i_byte);
+ len = 1;
+ MAKE_CHAR_MULTIBYTE (c);
+ }
+ c1 = c;
if (inword && flag != CASE_CAPITALIZE_UP)
c = DOWNCASE (c);
else if (!UPPERCASEP (c)
&& (!inword || flag != CASE_CAPITALIZE_UP))
- c = UPCASE1 (c);
- if ((ASCII_BYTE_P (c) && from_len == 1)
- || (! multibyte && SINGLE_BYTE_CHAR_P (c)))
- SSET (obj, i, c);
- else
+ c = UPCASE1 (c1);
+ if ((int) flag >= (int) CASE_CAPITALIZE)
+ inword = (SYNTAX (c) == Sword);
+ if (c != c1)
{
- to_len = CHAR_BYTES (c);
- if (from_len == to_len)
- CHAR_STRING (c, SDATA (obj) + i);
+ if (! multibyte)
+ {
+ MAKE_CHAR_UNIBYTE (c);
+ SSET (obj, i_byte, c);
+ }
+ else if (ASCII_CHAR_P (c1) && ASCII_CHAR_P (c))
+ SSET (obj, i_byte, c);
else
{
- Faset (obj, make_number (n), make_number (c));
- len += to_len - from_len;
+ Faset (obj, make_number (i), make_number (c));
+ i_byte += CHAR_BYTES (c) - len;
}
}
- if ((int) flag >= (int) CASE_CAPITALIZE)
- inword = SYNTAX (c) == Sword;
- i += to_len;
}
return obj;
}
enum case_action flag;
Lisp_Object b, e;
{
- register int i;
register int c;
register int inword = flag == CASE_DOWN;
register int multibyte = !NILP (current_buffer->enable_multibyte_characters);
int start, end;
int start_byte, end_byte;
int changed = 0;
+ int opoint = PT;
+ int opoint_byte = PT_BYTE;
if (EQ (b, e))
/* Not modifying because nothing marked */
start_byte = CHAR_TO_BYTE (start);
end_byte = CHAR_TO_BYTE (end);
- for (i = start_byte; i < end_byte; i++, start++)
+ while (start < end)
{
- int c2;
- c = c2 = FETCH_BYTE (i);
- if (multibyte && c >= 0x80)
- /* A multibyte character can't be handled in this simple loop. */
- break;
+ int c2, len;
+
+ if (multibyte)
+ {
+ c = FETCH_MULTIBYTE_CHAR (start_byte);
+ len = CHAR_BYTES (c);
+ }
+ else
+ {
+ c = FETCH_BYTE (start_byte);
+ MAKE_CHAR_MULTIBYTE (c);
+ len = 1;
+ }
+ c2 = c;
if (inword && flag != CASE_CAPITALIZE_UP)
c = DOWNCASE (c);
else if (!UPPERCASEP (c)
&& (!inword || flag != CASE_CAPITALIZE_UP))
c = UPCASE1 (c);
- if (multibyte && c >= 0x80)
- /* A multibyte result character can't be handled in this
- simple loop. */
- break;
- FETCH_BYTE (i) = c;
- if (c != c2)
- changed = 1;
if ((int) flag >= (int) CASE_CAPITALIZE)
- inword = SYNTAX (c) == Sword && (inword || !SYNTAX_PREFIX (c));
- }
- if (i < end_byte)
- {
- /* The work is not yet finished because of a multibyte character
- just encountered. */
- int opoint = PT;
- int opoint_byte = PT_BYTE;
- int c2;
-
- while (start < end)
+ inword = ((SYNTAX (c) == Sword) && (inword || !SYNTAX_PREFIX (c)));
+ if (c != c2)
{
- if ((c = FETCH_BYTE (i)) >= 0x80)
- c = FETCH_MULTIBYTE_CHAR (i);
- c2 = c;
- if (inword && flag != CASE_CAPITALIZE_UP)
- c2 = DOWNCASE (c);
- else if (!UPPERCASEP (c)
- && (!inword || flag != CASE_CAPITALIZE_UP))
- c2 = UPCASE1 (c);
- if (c != c2)
+ changed = 1;
+ if (! multibyte)
+ {
+ MAKE_CHAR_UNIBYTE (c);
+ FETCH_BYTE (start_byte) = c;
+ }
+ else if (ASCII_CHAR_P (c2) && ASCII_CHAR_P (c))
+ FETCH_BYTE (start_byte) = c;
+ else
{
- int fromlen, tolen, j;
+ int tolen = CHAR_BYTES (c);
+ int j;
unsigned char str[MAX_MULTIBYTE_LENGTH];
- changed = 1;
- /* Handle the most likely case */
- if (c < 0400 && c2 < 0400)
- FETCH_BYTE (i) = c2;
- else if (fromlen = CHAR_STRING (c, str),
- tolen = CHAR_STRING (c2, str),
- fromlen == tolen)
+ CHAR_STRING (c, str);
+ if (len == tolen)
{
/* Length is unchanged. */
- for (j = 0; j < tolen; ++j)
- FETCH_BYTE (i + j) = str[j];
+ for (j = 0; j < len; ++j)
+ FETCH_BYTE (start_byte + j) = str[j];
}
else
{
/* Replace one character with the other,
keeping text properties the same. */
- replace_range_2 (start, i,
- start + 1, i + fromlen,
+ replace_range_2 (start, start_byte,
+ start + 1, start_byte + len,
str, 1, tolen,
- 1);
- if (opoint > start)
- opoint_byte += tolen - fromlen;
+ 0);
+ len = tolen;
}
}
- if ((int) flag >= (int) CASE_CAPITALIZE)
- inword = SYNTAX (c2) == Sword;
- INC_BOTH (start, i);
}
- TEMP_SET_PT_BOTH (opoint, opoint_byte);
+ start++;
+ start_byte += len;
}
- start = XFASTINT (b);
+ if (PT != opoint)
+ TEMP_SET_PT_BOTH (opoint, opoint_byte);
+
if (changed)
{
+ start = XFASTINT (b);
signal_after_change (start, end - start, end - start);
update_compositions (start, end, CHECK_ALL);
}
/* GNU Emacs routines to deal with case tables.
Copyright (C) 1993, 1994, 2001, 2002, 2003, 2004,
- 2005, 2006, 2007 Free Software Foundation, Inc.
+ 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include <config.h>
#include "lisp.h"
#include "buffer.h"
-#include "charset.h"
+#include "character.h"
Lisp_Object Qcase_table_p, Qcase_table;
Lisp_Object Vascii_downcase_table, Vascii_upcase_table;
int standard;
{
Lisp_Object up, canon, eqv;
- int indices[3];
check_case_table (table);
if (NILP (up))
{
up = Fmake_char_table (Qcase_table, Qnil);
- map_char_table (set_identity, Qnil, table, table, up, 0, indices);
- map_char_table (shuffle, Qnil, table, table, up, 0, indices);
+ map_char_table (set_identity, Qnil, table, up);
+ map_char_table (shuffle, Qnil, table, up);
XCHAR_TABLE (table)->extras[0] = up;
}
{
canon = Fmake_char_table (Qcase_table, Qnil);
XCHAR_TABLE (table)->extras[1] = canon;
- map_char_table (set_canon, Qnil, table, table, table, 0, indices);
+ map_char_table (set_canon, Qnil, table, table);
}
if (NILP (eqv))
{
eqv = Fmake_char_table (Qcase_table, Qnil);
- map_char_table (set_identity, Qnil, canon, canon, eqv, 0, indices);
- map_char_table (shuffle, Qnil, canon, canon, eqv, 0, indices);
+ map_char_table (set_identity, Qnil, canon, eqv);
+ map_char_table (shuffle, Qnil, canon, eqv);
XCHAR_TABLE (table)->extras[2] = eqv;
}
\f
/* The following functions are called in map_char_table. */
-/* Set CANON char-table element for C to a translated ELT by UP and
- DOWN char-tables. This is done only when ELT is a character. The
- char-tables CANON, UP, and DOWN are in CASE_TABLE. */
+/* Set CANON char-table element for characters in RANGE to a
+ translated ELT by UP and DOWN char-tables. This is done only when
+ ELT is a character. The char-tables CANON, UP, and DOWN are in
+ CASE_TABLE. */
static void
-set_canon (case_table, c, elt)
- Lisp_Object case_table, c, elt;
+set_canon (case_table, range, elt)
+ Lisp_Object case_table, range, elt;
{
Lisp_Object up = XCHAR_TABLE (case_table)->extras[0];
Lisp_Object canon = XCHAR_TABLE (case_table)->extras[1];
if (NATNUMP (elt))
- Faset (canon, c, Faref (case_table, Faref (up, elt)));
+ Fset_char_table_range (canon, range, Faref (case_table, Faref (up, elt)));
}
-/* Set elements of char-table TABLE for C to C itself. This is done
- only when ELT is a character. This is called in map_char_table. */
+/* Set elements of char-table TABLE for C to C itself. C may be a
+ cons specifying a character range. In that case, set characters in
+ that range to themselves. This is done only when ELT is a
+ character. This is called in map_char_table. */
static void
set_identity (table, c, elt)
Lisp_Object table, c, elt;
{
if (NATNUMP (elt))
- Faset (table, c, c);
+ {
+ int from, to;
+
+ if (CONSP (c))
+ {
+ from = XINT (XCAR (c));
+ to = XINT (XCDR (c));
+ }
+ else
+ from = to = XINT (c);
+ for (; from <= to; from++)
+ CHAR_TABLE_SET (table, from, make_number (from));
+ }
}
/* Permute the elements of TABLE (which is initially an identity
shuffle (table, c, elt)
Lisp_Object table, c, elt;
{
- if (NATNUMP (elt) && !EQ (c, elt))
+ if (NATNUMP (elt))
{
Lisp_Object tem = Faref (table, elt);
- Faset (table, elt, c);
- Faset (table, c, tem);
+ int from, to;
+
+ if (CONSP (c))
+ {
+ from = XINT (XCAR (c));
+ to = XINT (XCDR (c));
+ }
+ else
+ from = to = XINT (c);
+
+ for (; from <= to; from++)
+ if (from != XINT (elt))
+ {
+ Faset (table, elt, make_number (from));
+ Faset (table, make_number (from), tem);
+ }
}
}
\f
Vascii_downcase_table = down;
XCHAR_TABLE (down)->purpose = Qcase_table;
- for (i = 0; i < CHAR_TABLE_SINGLE_BYTE_SLOTS; i++)
- XSETFASTINT (XCHAR_TABLE (down)->contents[i],
- (i >= 'A' && i <= 'Z') ? i + ('a' - 'A') : i);
+ for (i = 0; i < 128; i++)
+ {
+ int c = (i >= 'A' && i <= 'Z') ? i + ('a' - 'A') : i;
+ CHAR_TABLE_SET (down, i, make_number (c));
+ }
XCHAR_TABLE (down)->extras[1] = Fcopy_sequence (down);
up = Fmake_char_table (Qcase_table, Qnil);
XCHAR_TABLE (down)->extras[0] = up;
- for (i = 0; i < CHAR_TABLE_SINGLE_BYTE_SLOTS; i++)
- XSETFASTINT (XCHAR_TABLE (up)->contents[i],
- ((i >= 'A' && i <= 'Z')
- ? i + ('a' - 'A')
- : ((i >= 'a' && i <= 'z')
- ? i + ('A' - 'a')
- : i)));
+ for (i = 0; i < 128; i++)
+ {
+ int c = ((i >= 'A' && i <= 'Z') ? i + ('a' - 'A')
+ : ((i >= 'a' && i <= 'z') ? i + ('A' - 'a')
+ : i));;
+ CHAR_TABLE_SET (up, i, make_number (c));
+ }
XCHAR_TABLE (down)->extras[2] = Fcopy_sequence (up);
/* GNU Emacs routines to deal with category tables.
- Copyright (C) 1998, 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ Copyright (C) 1998, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
Free Software Foundation, Inc.
Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- 2005, 2006, 2007
+ 2005, 2006, 2007, 2008
National Institute of Advanced Industrial Science and Technology (AIST)
Registration Number H14PRO021
+ Copyright (C) 2003
+ National Institute of Advanced Industrial Science and Technology (AIST)
+ Registration Number H13PRO009
This file is part of GNU Emacs.
#include <ctype.h>
#include "lisp.h"
#include "buffer.h"
+#include "character.h"
#include "charset.h"
#include "category.h"
#include "keymap.h"
return Vstandard_category_table;
}
+
+static void
+copy_category_entry (table, c, val)
+ Lisp_Object table, c, val;
+{
+ val = Fcopy_sequence (val);
+ if (CONSP (c))
+ char_table_set_range (table, XINT (XCAR (c)), XINT (XCDR (c)), val);
+ else
+ char_table_set (table, XINT (c), val);
+}
+
/* Return a copy of category table TABLE. We can't simply use the
function copy-sequence because no contents should be shared between
the original and the copy. This function is called recursively by
copy_category_table (table)
Lisp_Object table;
{
- Lisp_Object tmp;
- int i, to;
+ table = copy_char_table (table);
- if (!NILP (XCHAR_TABLE (table)->top))
- {
- /* TABLE is a top level char table.
- At first, make a copy of tree structure of the table. */
- table = Fcopy_sequence (table);
-
- /* Then, copy elements for single byte characters one by one. */
- for (i = 0; i < CHAR_TABLE_SINGLE_BYTE_SLOTS; i++)
- if (!NILP (tmp = XCHAR_TABLE (table)->contents[i]))
- XCHAR_TABLE (table)->contents[i] = Fcopy_sequence (tmp);
- to = CHAR_TABLE_ORDINARY_SLOTS;
-
- /* Also copy the first (and sole) extra slot. It is a vector
- containing docstring of each category. */
- Fset_char_table_extra_slot
- (table, make_number (0),
- Fcopy_sequence (Fchar_table_extra_slot (table, make_number (0))));
- }
- else
- {
- i = 32;
- to = SUB_CHAR_TABLE_ORDINARY_SLOTS;
- }
-
- /* If the table has non-nil default value, copy it. */
- if (!NILP (tmp = XCHAR_TABLE (table)->defalt))
- XCHAR_TABLE (table)->defalt = Fcopy_sequence (tmp);
-
- /* At last, copy the remaining elements while paying attention to a
- sub char table. */
- for (; i < to; i++)
- if (!NILP (tmp = XCHAR_TABLE (table)->contents[i]))
- XCHAR_TABLE (table)->contents[i]
- = (SUB_CHAR_TABLE_P (tmp)
- ? copy_category_table (tmp) : Fcopy_sequence (tmp));
+ if (! NILP (XCHAR_TABLE (table)->defalt))
+ XCHAR_TABLE (table)->defalt
+ = Fcopy_sequence (XCHAR_TABLE (table)->defalt);
+ XCHAR_TABLE (table)->extras[0]
+ = Fcopy_sequence (XCHAR_TABLE (table)->extras[0]);
+ map_char_table (copy_category_entry, Qnil, table, table);
return table;
}
()
{
Lisp_Object val;
+ int i;
val = Fmake_char_table (Qcategory_table, Qnil);
XCHAR_TABLE (val)->defalt = MAKE_CATEGORY_SET;
+ for (i = 0; i < (1 << CHARTAB_SIZE_BITS_0); i++)
+ XCHAR_TABLE (val)->contents[i] = MAKE_CATEGORY_SET;
Fset_char_table_extra_slot (val, make_number (0),
Fmake_vector (make_number (95), Qnil));
return val;
}
\f
+Lisp_Object
+char_category_set (c)
+ int c;
+{
+ return CHAR_TABLE_REF (current_buffer->category_table, c);
+}
+
DEFUN ("char-category-set", Fchar_category_set, Schar_category_set, 1, 1, 0,
doc: /* Return the category set of CHAR.
usage: (char-category-set CHAR) */)
return build_string (str);
}
-/* Modify all category sets stored under sub char-table TABLE so that
- they contain (SET_VALUE is t) or don't contain (SET_VALUE is nil)
- CATEGORY. */
-
-void
-modify_lower_category_set (table, category, set_value)
- Lisp_Object table, category, set_value;
-{
- Lisp_Object val;
- int i;
-
- val = XCHAR_TABLE (table)->defalt;
- if (!CATEGORY_SET_P (val))
- val = MAKE_CATEGORY_SET;
- SET_CATEGORY_SET (val, category, set_value);
- XCHAR_TABLE (table)->defalt = val;
-
- for (i = 32; i < SUB_CHAR_TABLE_ORDINARY_SLOTS; i++)
- {
- val = XCHAR_TABLE (table)->contents[i];
-
- if (CATEGORY_SET_P (val))
- SET_CATEGORY_SET (val, category, set_value);
- else if (SUB_CHAR_TABLE_P (val))
- modify_lower_category_set (val, category, set_value);
- }
-}
-
void
set_category_set (category_set, category, val)
Lisp_Object category_set, category, val;
Smodify_category_entry, 2, 4, 0,
doc: /* Modify the category set of CHARACTER by adding CATEGORY to it.
The category is changed only for table TABLE, which defaults to
- the current buffer's category table.
+the current buffer's category table.
+CHARACTER can be either a single character or a cons representing the
+lower and upper ends of an inclusive character range to modify.
If optional fourth argument RESET is non-nil,
then delete CATEGORY from the category set instead of adding it. */)
(character, category, table, reset)
Lisp_Object character, category, table, reset;
{
- int c, charset, c1, c2;
Lisp_Object set_value; /* Actual value to be set in category sets. */
- Lisp_Object val, category_set;
+ Lisp_Object category_set;
+ int start, end;
+ int from, to;
- CHECK_NUMBER (character);
- c = XINT (character);
- CHECK_CATEGORY (category);
- table = check_category_table (table);
-
- if (NILP (CATEGORY_DOCSTRING (table, XFASTINT (category))))
- error ("Undefined category: %c", XFASTINT (category));
-
- set_value = NILP (reset) ? Qt : Qnil;
-
- if (c < CHAR_TABLE_SINGLE_BYTE_SLOTS)
- {
- val = XCHAR_TABLE (table)->contents[c];
- if (!CATEGORY_SET_P (val))
- XCHAR_TABLE (table)->contents[c] = (val = MAKE_CATEGORY_SET);
- SET_CATEGORY_SET (val, category, set_value);
- return Qnil;
- }
-
- SPLIT_CHAR (c, charset, c1, c2);
-
- /* The top level table. */
- val = XCHAR_TABLE (table)->contents[charset + 128];
- if (CATEGORY_SET_P (val))
- category_set = val;
- else if (!SUB_CHAR_TABLE_P (val))
- {
- category_set = val = MAKE_CATEGORY_SET;
- XCHAR_TABLE (table)->contents[charset + 128] = category_set;
- }
-
- if (c1 <= 0)
+ if (INTEGERP (character))
{
- /* Only a charset is specified. */
- if (SUB_CHAR_TABLE_P (val))
- /* All characters in CHARSET should be the same as for having
- CATEGORY or not. */
- modify_lower_category_set (val, category, set_value);
- else
- SET_CATEGORY_SET (category_set, category, set_value);
- return Qnil;
+ CHECK_CHARACTER (character);
+ start = end = XFASTINT (character);
}
-
- /* The second level table. */
- if (!SUB_CHAR_TABLE_P (val))
+ else
{
- val = make_sub_char_table (Qnil);
- XCHAR_TABLE (table)->contents[charset + 128] = val;
- /* We must set default category set of CHARSET in `defalt' slot. */
- XCHAR_TABLE (val)->defalt = category_set;
+ CHECK_CONS (character);
+ CHECK_CHARACTER_CAR (character);
+ CHECK_CHARACTER_CDR (character);
+ start = XFASTINT (XCAR (character));
+ end = XFASTINT (XCDR (character));
}
- table = val;
- val = XCHAR_TABLE (table)->contents[c1];
- if (CATEGORY_SET_P (val))
- category_set = val;
- else if (!SUB_CHAR_TABLE_P (val))
- {
- category_set = val = Fcopy_sequence (XCHAR_TABLE (table)->defalt);
- XCHAR_TABLE (table)->contents[c1] = category_set;
- }
+ CHECK_CATEGORY (category);
+ table = check_category_table (table);
- if (c2 <= 0)
- {
- if (SUB_CHAR_TABLE_P (val))
- /* All characters in C1 group of CHARSET should be the same as
- for CATEGORY. */
- modify_lower_category_set (val, category, set_value);
- else
- SET_CATEGORY_SET (category_set, category, set_value);
- return Qnil;
- }
+ if (NILP (CATEGORY_DOCSTRING (table, XFASTINT (category))))
+ error ("Undefined category: %c", XFASTINT (category));
- /* The third (bottom) level table. */
- if (!SUB_CHAR_TABLE_P (val))
- {
- val = make_sub_char_table (Qnil);
- XCHAR_TABLE (table)->contents[c1] = val;
- /* We must set default category set of CHARSET and C1 in
- `defalt' slot. */
- XCHAR_TABLE (val)->defalt = category_set;
- }
- table = val;
+ set_value = NILP (reset) ? Qt : Qnil;
- val = XCHAR_TABLE (table)->contents[c2];
- if (CATEGORY_SET_P (val))
- category_set = val;
- else if (!SUB_CHAR_TABLE_P (val))
+ while (start <= end)
{
- category_set = Fcopy_sequence (XCHAR_TABLE (table)->defalt);
- XCHAR_TABLE (table)->contents[c2] = category_set;
+ category_set = char_table_ref_and_range (table, start, &from, &to);
+ if (CATEGORY_MEMBER (XFASTINT (category), category_set) != NILP (reset))
+ {
+ category_set = Fcopy_sequence (category_set);
+ SET_CATEGORY_SET (category_set, category, set_value);
+ if (to > end)
+ char_table_set_range (table, start, end, category_set);
+ else
+ char_table_set_range (table, start, to, category_set);
+ }
+ start = to + 1;
}
- else
- /* This should never happen. */
- error ("Invalid category table");
-
- SET_CATEGORY_SET (category_set, category, set_value);
return Qnil;
}
/* Declarations having to do with Emacs category tables.
Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- 2005, 2006, 2007
+ 2005, 2006, 2007, 2008
National Institute of Advanced Industrial Science and Technology (AIST)
Registration Number H14PRO021
+ Copyright (C) 2003
+ National Institute of Advanced Industrial Science and Technology (AIST)
+ Registration Number H13PRO009
This file is part of GNU Emacs.
#define Vstandard_category_table buffer_defaults.category_table
/* Return the category set of character C in the current category table. */
-#ifdef __GNUC__
-#define CATEGORY_SET(c) \
- ({ Lisp_Object table = current_buffer->category_table; \
- Lisp_Object temp; \
- if ((c) < CHAR_TABLE_SINGLE_BYTE_SLOTS) \
- while (NILP (temp = XCHAR_TABLE (table)->contents[(unsigned char) c]) \
- && NILP (temp = XCHAR_TABLE (table)->defalt)) \
- table = XCHAR_TABLE (table)->parent; \
- else \
- temp = Faref (table, make_number (c)); \
- temp; })
-#else
-#define CATEGORY_SET(c) \
- Faref (current_buffer->category_table, make_number (c))
-#endif
+#define CATEGORY_SET(c) char_category_set (c)
/* Return the doc string of CATEGORY in category table TABLE. */
#define CATEGORY_DOCSTRING(table, category) \
/* Return 1 if there is a word boundary between two word-constituent
characters C1 and C2 if they appear in this order, else return 0.
- There is no word boundary between two word-constituent ASCII
- characters. */
+ There is no word boundary between two word-constituent ASCII and
+ Latin-1 characters. */
#define WORD_BOUNDARY_P(c1, c2) \
(!(SINGLE_BYTE_CHAR_P (c1) && SINGLE_BYTE_CHAR_P (c2)) \
&& word_boundary_p (c1, c2))
/* CCL (Code Conversion Language) interpreter.
Copyright (C) 2001, 2002, 2003, 2004, 2005,
- 2006, 2007 Free Software Foundation, Inc.
+ 2006, 2007, 2008 Free Software Foundation, Inc.
Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- 2005, 2006, 2007
+ 2005, 2006, 2007, 2008
National Institute of Advanced Industrial Science and Technology (AIST)
Registration Number H14PRO021
+ Copyright (C) 2003
+ National Institute of Advanced Industrial Science and Technology (AIST)
+ Registration Number H13PRO009
This file is part of GNU Emacs.
#include <stdio.h>
#include "lisp.h"
+#include "character.h"
#include "charset.h"
#include "ccl.h"
#include "coding.h"
+Lisp_Object Qccl, Qcclp;
+
/* This contains all code conversion map available to CCL. */
Lisp_Object Vcode_conversion_map_vector;
#define GET_HASH_TABLE(id) \
(XHASH_TABLE (XCDR(XVECTOR(Vtranslation_hash_table_vector)->contents[(id)])))
+extern int charset_unicode;
+
/* CCL (Code Conversion Language) is a simple language which has
operations on one input buffer, one output buffer, and 7 registers.
The syntax of CCL is described in `ccl.el'. Emacs Lisp function
#define CCL_WriteStringJump 0x0A /* Write string and jump:
1:A--D--D--R--E--S--S-000XXXXX
2:LENGTH
- 3:0000STRIN[0]STRIN[1]STRIN[2]
+ 3:000MSTRIN[0]STRIN[1]STRIN[2]
...
------------------------------
- write_string (STRING, LENGTH);
+ if (M)
+ write_multibyte_string (STRING, LENGTH);
+ else
+ write_string (STRING, LENGTH);
IC += ADDRESS;
*/
#define CCL_WriteConstString 0x14 /* Write a constant or a string:
1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
- [2:0000STRIN[0]STRIN[1]STRIN[2]]
+ [2:000MSTRIN[0]STRIN[1]STRIN[2]]
[...]
-----------------------------
if (!rrr)
write (CC..C)
else
- write_string (STRING, CC..C);
+ if (M)
+ write_multibyte_string (STRING, CC..C);
+ else
+ write_string (STRING, CC..C);
IC += (CC..C + 2) / 3;
*/
/* Encode one character CH to multibyte form and write to the current
output buffer. If CH is less than 256, CH is written as is. */
-#define CCL_WRITE_CHAR(ch) \
- do { \
- int bytes = SINGLE_BYTE_CHAR_P (ch) ? 1: CHAR_BYTES (ch); \
- if (!dst) \
- CCL_INVALID_CMD; \
- else if (dst + bytes + extra_bytes < (dst_bytes ? dst_end : src)) \
- { \
- if (bytes == 1) \
- { \
- *dst++ = (ch); \
- if (extra_bytes && (ch) >= 0x80 && (ch) < 0xA0) \
- /* We may have to convert this eight-bit char to \
- multibyte form later. */ \
- extra_bytes++; \
- } \
- else if (CHAR_VALID_P (ch, 0)) \
- dst += CHAR_STRING (ch, dst); \
- else \
- CCL_INVALID_CMD; \
- } \
- else \
- CCL_SUSPEND (CCL_STAT_SUSPEND_BY_DST); \
- } while (0)
-
-/* Encode one character CH to multibyte form and write to the current
- output buffer. The output bytes always forms a valid multibyte
- sequence. */
-#define CCL_WRITE_MULTIBYTE_CHAR(ch) \
- do { \
- int bytes = CHAR_BYTES (ch); \
- if (!dst) \
- CCL_INVALID_CMD; \
- else if (dst + bytes + extra_bytes < (dst_bytes ? dst_end : src)) \
- { \
- if (CHAR_VALID_P ((ch), 0)) \
- dst += CHAR_STRING ((ch), dst); \
- else \
- CCL_INVALID_CMD; \
- } \
- else \
- CCL_SUSPEND (CCL_STAT_SUSPEND_BY_DST); \
+#define CCL_WRITE_CHAR(ch) \
+ do { \
+ if (! dst) \
+ CCL_INVALID_CMD; \
+ else if (dst < dst_end) \
+ *dst++ = (ch); \
+ else \
+ CCL_SUSPEND (CCL_STAT_SUSPEND_BY_DST); \
} while (0)
/* Write a string at ccl_prog[IC] of length LEN to the current output
buffer. */
-#define CCL_WRITE_STRING(len) \
- do { \
- if (!dst) \
- CCL_INVALID_CMD; \
- else if (dst + len <= (dst_bytes ? dst_end : src)) \
- for (i = 0; i < len; i++) \
- *dst++ = ((XFASTINT (ccl_prog[ic + (i / 3)])) \
- >> ((2 - (i % 3)) * 8)) & 0xFF; \
- else \
- CCL_SUSPEND (CCL_STAT_SUSPEND_BY_DST); \
- } while (0)
-
-/* Read one byte from the current input buffer into REGth register. */
-#define CCL_READ_CHAR(REG) \
- do { \
- if (!src) \
- CCL_INVALID_CMD; \
- else if (src < src_end) \
- { \
- REG = *src++; \
- if (REG == '\n' \
- && ccl->eol_type != CODING_EOL_LF) \
- { \
- /* We are encoding. */ \
- if (ccl->eol_type == CODING_EOL_CRLF) \
- { \
- if (ccl->cr_consumed) \
- ccl->cr_consumed = 0; \
- else \
- { \
- ccl->cr_consumed = 1; \
- REG = '\r'; \
- src--; \
- } \
- } \
- else \
- REG = '\r'; \
- } \
- if (REG == LEADING_CODE_8_BIT_CONTROL \
- && ccl->multibyte) \
- REG = *src++ - 0x20; \
- } \
- else if (ccl->last_block) \
- { \
- REG = -1; \
- ic = eof_ic; \
- goto ccl_repeat; \
- } \
- else \
- CCL_SUSPEND (CCL_STAT_SUSPEND_BY_SRC); \
- } while (0)
-
-
-/* Set C to the character code made from CHARSET and CODE. This is
- like MAKE_CHAR but check the validity of CHARSET and CODE. If they
- are not valid, set C to (CODE & 0xFF) because that is usually the
- case that CCL_ReadMultibyteChar2 read an invalid code and it set
- CODE to that invalid byte. */
-
-#define CCL_MAKE_CHAR(charset, code, c) \
+#define CCL_WRITE_STRING(len) \
do { \
- if (charset == CHARSET_ASCII) \
- c = code & 0xFF; \
- else if (CHARSET_DEFINED_P (charset) \
- && (code & 0x7F) >= 32 \
- && (code < 256 || ((code >> 7) & 0x7F) >= 32)) \
+ int i; \
+ if (!dst) \
+ CCL_INVALID_CMD; \
+ else if (dst + len <= dst_end) \
{ \
- int c1 = code & 0x7F, c2 = 0; \
- \
- if (code >= 256) \
- c2 = c1, c1 = (code >> 7) & 0x7F; \
- c = MAKE_CHAR (charset, c1, c2); \
+ if (XFASTINT (ccl_prog[ic]) & 0x1000000) \
+ for (i = 0; i < len; i++) \
+ *dst++ = XFASTINT (ccl_prog[ic + i]) & 0xFFFFFF; \
+ else \
+ for (i = 0; i < len; i++) \
+ *dst++ = ((XFASTINT (ccl_prog[ic + (i / 3)])) \
+ >> ((2 - (i % 3)) * 8)) & 0xFF; \
} \
else \
- c = code & 0xFF; \
+ CCL_SUSPEND (CCL_STAT_SUSPEND_BY_DST); \
} while (0)
+/* Read one byte from the current input buffer into Rth register. */
+#define CCL_READ_CHAR(r) \
+ do { \
+ if (! src) \
+ CCL_INVALID_CMD; \
+ else if (src < src_end) \
+ r = *src++; \
+ else if (ccl->last_block) \
+ { \
+ r = -1; \
+ ic = ccl->eof_ic; \
+ goto ccl_repeat; \
+ } \
+ else \
+ CCL_SUSPEND (CCL_STAT_SUSPEND_BY_SRC); \
+ } while (0)
+
+/* Decode CODE by a charset whose id is ID. If ID is 0, return CODE
+ as is for backward compatibility. Assume that we can use the
+ variable `charset'. */
+
+#define CCL_DECODE_CHAR(id, code) \
+ ((id) == 0 ? (code) \
+ : (charset = CHARSET_FROM_ID ((id)), DECODE_CHAR (charset, (code))))
+
+/* Encode character C by some of charsets in CHARSET_LIST. Set ID to
+ the id of the used charset, ENCODED to the resulf of encoding.
+ Assume that we can use the variable `charset'. */
+
+#define CCL_ENCODE_CHAR(c, charset_list, id, encoded) \
+ do { \
+ unsigned code; \
+ \
+ charset = char_charset ((c), (charset_list), &code); \
+ if (! charset && ! NILP (charset_list)) \
+ charset = char_charset ((c), Qnil, &code); \
+ if (charset) \
+ { \
+ (id) = CHARSET_ID (charset); \
+ (encoded) = code; \
+ } \
+ } while (0)
-/* Execute CCL code on SRC_BYTES length text at SOURCE. The resulting
- text goes to a place pointed by DESTINATION, the length of which
- should not exceed DST_BYTES. The bytes actually processed is
- returned as *CONSUMED. The return value is the length of the
- resulting text. As a side effect, the contents of CCL registers
- are updated. If SOURCE or DESTINATION is NULL, only operations on
- registers are permitted. */
+/* Execute CCL code on characters at SOURCE (length SRC_SIZE). The
+ resulting text goes to a place pointed by DESTINATION, the length
+ of which should not exceed DST_SIZE. As a side effect, how many
+ characters are consumed and produced are recorded in CCL->consumed
+ and CCL->produced, and the contents of CCL registers are updated.
+ If SOURCE or DESTINATION is NULL, only operations on registers are
+ permitted. */
#ifdef CCL_DEBUG
#define CCL_DEBUG_BACKTRACE_LEN 256
/* For the moment, we only support depth 256 of stack. */
static struct ccl_prog_stack ccl_prog_stack_struct[256];
-int
-ccl_driver (ccl, source, destination, src_bytes, dst_bytes, consumed)
+void
+ccl_driver (ccl, source, destination, src_size, dst_size, charset_list)
struct ccl_program *ccl;
- unsigned char *source, *destination;
- int src_bytes, dst_bytes;
- int *consumed;
+ int *source, *destination;
+ int src_size, dst_size;
+ Lisp_Object charset_list;
{
register int *reg = ccl->reg;
register int ic = ccl->ic;
register int code = 0, field1, field2;
register Lisp_Object *ccl_prog = ccl->prog;
- unsigned char *src = source, *src_end = src + src_bytes;
- unsigned char *dst = destination, *dst_end = dst + dst_bytes;
+ int *src = source, *src_end = src + src_size;
+ int *dst = destination, *dst_end = dst + dst_size;
int jump_address;
int i = 0, j, op;
int stack_idx = ccl->stack_idx;
/* Instruction counter of the current CCL code. */
int this_ic = 0;
- /* CCL_WRITE_CHAR will produce 8-bit code of range 0x80..0x9F. But,
- each of them will be converted to multibyte form of 2-byte
- sequence. For that conversion, we remember how many more bytes
- we must keep in DESTINATION in this variable. */
- int extra_bytes = ccl->eight_bit_control;
+ struct charset *charset;
int eof_ic = ccl->eof_ic;
int eof_hit = 0;
if (ic >= eof_ic)
ic = CCL_HEADER_MAIN;
- if (ccl->buf_magnification == 0) /* We can't produce any bytes. */
+ if (ccl->buf_magnification == 0) /* We can't read/produce any bytes. */
dst = NULL;
/* Set mapping stack pointer. */
/* We can't just signal Qquit, instead break the loop as if
the whole data is processed. Don't reset Vquit_flag, it
must be handled later at a safer place. */
- if (consumed)
- src = source + src_bytes;
+ if (src)
+ src = source + src_size;
ccl->status = CCL_STAT_QUIT;
break;
}
case CCL_LE: reg[rrr] = i <= j; break;
case CCL_GE: reg[rrr] = i >= j; break;
case CCL_NE: reg[rrr] = i != j; break;
- case CCL_DECODE_SJIS: DECODE_SJIS (i, j, reg[rrr], reg[7]); break;
- case CCL_ENCODE_SJIS: ENCODE_SJIS (i, j, reg[rrr], reg[7]); break;
+ case CCL_DECODE_SJIS:
+ {
+ i = (i << 8) | j;
+ SJIS_TO_JIS (i);
+ reg[rrr] = i >> 8;
+ reg[7] = i & 0xFF;
+ break;
+ }
+ case CCL_ENCODE_SJIS:
+ {
+ i = (i << 8) | j;
+ JIS_TO_SJIS (i);
+ reg[rrr] = i >> 8;
+ reg[7] = i & 0xFF;
+ break;
+ }
default: CCL_INVALID_CMD;
}
code &= 0x1F;
case CCL_ReadMultibyteChar2:
if (!src)
CCL_INVALID_CMD;
-
- if (src >= src_end)
- {
- src++;
- goto ccl_read_multibyte_character_suspend;
- }
-
- if (!ccl->multibyte)
- {
- int bytes;
- if (!UNIBYTE_STR_AS_MULTIBYTE_P (src, src_end - src, bytes))
- {
- reg[RRR] = CHARSET_8_BIT_CONTROL;
- reg[rrr] = *src++;
- break;
- }
- }
- i = *src++;
- if (i == '\n' && ccl->eol_type != CODING_EOL_LF)
- {
- /* We are encoding. */
- if (ccl->eol_type == CODING_EOL_CRLF)
- {
- if (ccl->cr_consumed)
- ccl->cr_consumed = 0;
- else
- {
- ccl->cr_consumed = 1;
- i = '\r';
- src--;
- }
- }
- else
- i = '\r';
- reg[rrr] = i;
- reg[RRR] = CHARSET_ASCII;
- }
- else if (i < 0x80)
- {
- /* ASCII */
- reg[rrr] = i;
- reg[RRR] = CHARSET_ASCII;
- }
- else if (i <= MAX_CHARSET_OFFICIAL_DIMENSION2)
- {
- int dimension = BYTES_BY_CHAR_HEAD (i) - 1;
-
- if (dimension == 0)
- {
- /* `i' is a leading code for an undefined charset. */
- reg[RRR] = CHARSET_8_BIT_GRAPHIC;
- reg[rrr] = i;
- }
- else if (src + dimension > src_end)
- goto ccl_read_multibyte_character_suspend;
- else
- {
- reg[RRR] = i;
- i = (*src++ & 0x7F);
- if (dimension == 1)
- reg[rrr] = i;
- else
- reg[rrr] = ((i << 7) | (*src++ & 0x7F));
- }
- }
- else if ((i == LEADING_CODE_PRIVATE_11)
- || (i == LEADING_CODE_PRIVATE_12))
- {
- if ((src + 1) >= src_end)
- goto ccl_read_multibyte_character_suspend;
- reg[RRR] = *src++;
- reg[rrr] = (*src++ & 0x7F);
- }
- else if ((i == LEADING_CODE_PRIVATE_21)
- || (i == LEADING_CODE_PRIVATE_22))
- {
- if ((src + 2) >= src_end)
- goto ccl_read_multibyte_character_suspend;
- reg[RRR] = *src++;
- i = (*src++ & 0x7F);
- reg[rrr] = ((i << 7) | (*src & 0x7F));
- src++;
- }
- else if (i == LEADING_CODE_8_BIT_CONTROL)
- {
- if (src >= src_end)
- goto ccl_read_multibyte_character_suspend;
- reg[RRR] = CHARSET_8_BIT_CONTROL;
- reg[rrr] = (*src++ - 0x20);
- }
- else if (i >= 0xA0)
- {
- reg[RRR] = CHARSET_8_BIT_GRAPHIC;
- reg[rrr] = i;
- }
- else
- {
- /* INVALID CODE. Return a single byte character. */
- reg[RRR] = CHARSET_ASCII;
- reg[rrr] = i;
- }
- break;
-
- ccl_read_multibyte_character_suspend:
- if (src <= src_end && !ccl->multibyte && ccl->last_block)
- {
- reg[RRR] = CHARSET_8_BIT_CONTROL;
- reg[rrr] = i;
- break;
- }
- src--;
- if (ccl->last_block)
- {
- ic = eof_ic;
- eof_hit = 1;
- goto ccl_repeat;
- }
- else
- CCL_SUSPEND (CCL_STAT_SUSPEND_BY_SRC);
-
+ CCL_READ_CHAR (i);
+ CCL_ENCODE_CHAR (i, charset_list, reg[RRR], reg[rrr]);
break;
case CCL_WriteMultibyteChar2:
- i = reg[RRR]; /* charset */
- if (i == CHARSET_ASCII
- || i == CHARSET_8_BIT_CONTROL
- || i == CHARSET_8_BIT_GRAPHIC)
- i = reg[rrr] & 0xFF;
- else if (CHARSET_DIMENSION (i) == 1)
- i = ((i - 0x70) << 7) | (reg[rrr] & 0x7F);
- else if (i < MIN_CHARSET_PRIVATE_DIMENSION2)
- i = ((i - 0x8F) << 14) | reg[rrr];
- else
- i = ((i - 0xE0) << 14) | reg[rrr];
-
- CCL_WRITE_MULTIBYTE_CHAR (i);
-
+ if (! dst)
+ CCL_INVALID_CMD;
+ i = CCL_DECODE_CHAR (reg[RRR], reg[rrr]);
+ CCL_WRITE_CHAR (i);
break;
case CCL_TranslateCharacter:
- CCL_MAKE_CHAR (reg[RRR], reg[rrr], i);
- op = translate_char (GET_TRANSLATION_TABLE (reg[Rrr]),
- i, -1, 0, 0);
- SPLIT_CHAR (op, reg[RRR], i, j);
- if (j != -1)
- i = (i << 7) | j;
-
- reg[rrr] = i;
+ i = CCL_DECODE_CHAR (reg[RRR], reg[rrr]);
+ op = translate_char (GET_TRANSLATION_TABLE (reg[Rrr]), i);
+ CCL_ENCODE_CHAR (op, charset_list, reg[RRR], reg[rrr]);
break;
case CCL_TranslateCharacterConstTbl:
op = XINT (ccl_prog[ic]); /* table */
ic++;
- CCL_MAKE_CHAR (reg[RRR], reg[rrr], i);
- op = translate_char (GET_TRANSLATION_TABLE (op), i, -1, 0, 0);
- SPLIT_CHAR (op, reg[RRR], i, j);
- if (j != -1)
- i = (i << 7) | j;
-
- reg[rrr] = i;
+ i = CCL_DECODE_CHAR (reg[RRR], reg[rrr]);
+ op = translate_char (GET_TRANSLATION_TABLE (op), i);
+ CCL_ENCODE_CHAR (op, charset_list, reg[RRR], reg[rrr]);
break;
case CCL_LookupIntConstTbl:
{
Lisp_Object opl;
opl = HASH_VALUE (h, op);
- if (!CHAR_VALID_P (XINT (opl), 0))
+ if (! CHARACTERP (opl))
CCL_INVALID_CMD;
- SPLIT_CHAR (XINT (opl), reg[RRR], i, j);
- if (j != -1)
- i = (i << 7) | j;
- reg[rrr] = i;
+ reg[RRR] = charset_unicode;
+ reg[rrr] = op;
reg[7] = 1; /* r7 true for success */
}
else
case CCL_LookupCharConstTbl:
op = XINT (ccl_prog[ic]); /* table */
ic++;
- CCL_MAKE_CHAR (reg[RRR], reg[rrr], i);
+ i = CCL_DECODE_CHAR (reg[RRR], reg[rrr]);
{
struct Lisp_Hash_Table *h = GET_HASH_TABLE (op);
}
msglen = strlen (msg);
- if (dst + msglen <= (dst_bytes ? dst_end : src))
+ if (dst + msglen <= dst_end)
{
- bcopy (msg, dst, msglen);
- dst += msglen;
+ for (i = 0; i < msglen; i++)
+ *dst++ = msg[i];
}
if (ccl->status == CCL_STAT_INVALID_CMD)
ccl->ic = ic;
ccl->stack_idx = stack_idx;
ccl->prog = ccl_prog;
- ccl->eight_bit_control = (extra_bytes > 1);
- if (consumed)
- *consumed = src - source;
- return (dst ? dst - destination : 0);
+ ccl->consumed = src - source;
+ if (dst != NULL)
+ ccl->produced = dst - destination;
+ else
+ ccl->produced = 0;
}
/* Resolve symbols in the specified CCL code (Lisp vector). This
ccl->private_state = 0;
ccl->status = 0;
ccl->stack_idx = 0;
- ccl->eol_type = CODING_EOL_LF;
ccl->suppress_error = 0;
ccl->eight_bit_control = 0;
return 0;
? XINT (AREF (reg, i))
: 0);
- ccl_driver (&ccl, (unsigned char *)0, (unsigned char *)0, 0, 0, (int *)0);
+ ccl_driver (&ccl, NULL, NULL, 0, 0, Qnil);
QUIT;
if (ccl.status != CCL_STAT_SUCCESS)
error ("Error in CCL program at %dth code", ccl.ic);
{
Lisp_Object val;
struct ccl_program ccl;
- int i, produced;
+ int i;
int outbufsize;
- char *outbuf;
- struct gcpro gcpro1, gcpro2;
+ unsigned char *outbuf, *outp;
+ int str_chars, str_bytes;
+#define CCL_EXECUTE_BUF_SIZE 1024
+ int source[CCL_EXECUTE_BUF_SIZE], destination[CCL_EXECUTE_BUF_SIZE];
+ int consumed_chars, consumed_bytes, produced_chars;
if (setup_ccl_program (&ccl, ccl_prog) < 0)
error ("Invalid CCL program");
error ("Length of vector STATUS is not 9");
CHECK_STRING (str);
- GCPRO2 (status, str);
+ str_chars = SCHARS (str);
+ str_bytes = SBYTES (str);
for (i = 0; i < 8; i++)
{
if (ccl.ic < i && i < ccl.size)
ccl.ic = i;
}
- outbufsize = SBYTES (str) * ccl.buf_magnification + 256;
- outbuf = (char *) xmalloc (outbufsize);
- ccl.last_block = NILP (contin);
- ccl.multibyte = STRING_MULTIBYTE (str);
- produced = ccl_driver (&ccl, SDATA (str), outbuf,
- SBYTES (str), outbufsize, (int *) 0);
+
+ outbufsize = (ccl.buf_magnification
+ ? str_bytes * ccl.buf_magnification + 256
+ : str_bytes + 256);
+ outp = outbuf = (unsigned char *) xmalloc (outbufsize);
+
+ consumed_chars = consumed_bytes = 0;
+ produced_chars = 0;
+ while (1)
+ {
+ const unsigned char *p = SDATA (str) + consumed_bytes;
+ const unsigned char *endp = SDATA (str) + str_bytes;
+ int i = 0;
+ int *src, src_size;
+
+ if (endp - p == str_chars - consumed_chars)
+ while (i < CCL_EXECUTE_BUF_SIZE && p < endp)
+ source[i++] = *p++;
+ else
+ while (i < CCL_EXECUTE_BUF_SIZE && p < endp)
+ source[i++] = STRING_CHAR_ADVANCE (p);
+ consumed_chars += i;
+ consumed_bytes = p - SDATA (str);
+
+ if (consumed_bytes == str_bytes)
+ ccl.last_block = NILP (contin);
+ src = source;
+ src_size = i;
+ while (1)
+ {
+ ccl_driver (&ccl, src, destination, src_size, CCL_EXECUTE_BUF_SIZE,
+ Qnil);
+ produced_chars += ccl.produced;
+ if (NILP (unibyte_p))
+ {
+ if (outp - outbuf + MAX_MULTIBYTE_LENGTH * ccl.produced
+ > outbufsize)
+ {
+ int offset = outp - outbuf;
+ outbufsize += MAX_MULTIBYTE_LENGTH * ccl.produced;
+ outbuf = (unsigned char *) xrealloc (outbuf, outbufsize);
+ outp = outbuf + offset;
+ }
+ for (i = 0; i < ccl.produced; i++)
+ CHAR_STRING_ADVANCE (destination[i], outp);
+ }
+ else
+ {
+ if (outp - outbuf + ccl.produced > outbufsize)
+ {
+ int offset = outp - outbuf;
+ outbufsize += ccl.produced;
+ outbuf = (unsigned char *) xrealloc (outbuf, outbufsize);
+ outp = outbuf + offset;
+ }
+ for (i = 0; i < ccl.produced; i++)
+ *outp++ = destination[i];
+ }
+ src += ccl.consumed;
+ src_size -= ccl.consumed;
+ if (ccl.status != CCL_STAT_SUSPEND_BY_DST)
+ break;
+ }
+
+ if (ccl.status != CCL_STAT_SUSPEND_BY_SRC
+ || str_chars == consumed_chars)
+ break;
+ }
+
+ if (ccl.status == CCL_STAT_INVALID_CMD)
+ error ("Error in CCL program at %dth code", ccl.ic);
+ if (ccl.status == CCL_STAT_QUIT)
+ error ("CCL program interrupted at %dth code", ccl.ic);
+
for (i = 0; i < 8; i++)
ASET (status, i, make_number (ccl.reg[i]));
ASET (status, 8, make_number (ccl.ic));
- UNGCPRO;
if (NILP (unibyte_p))
- {
- int nchars;
-
- produced = str_as_multibyte (outbuf, outbufsize, produced, &nchars);
- val = make_multibyte_string (outbuf, nchars, produced);
- }
+ val = make_multibyte_string ((char *) outbuf, produced_chars,
+ outp - outbuf);
else
- val = make_unibyte_string (outbuf, produced);
+ val = make_unibyte_string ((char *) outbuf, produced_chars);
xfree (outbuf);
- QUIT;
- if (ccl.status == CCL_STAT_SUSPEND_BY_DST)
- error ("Output buffer for the CCL programs overflow");
- if (ccl.status != CCL_STAT_SUCCESS
- && ccl.status != CCL_STAT_SUSPEND_BY_SRC)
- error ("Error in CCL program at %dth code", ccl.ic);
return val;
}
staticpro (&Vccl_program_table);
Vccl_program_table = Fmake_vector (make_number (32), Qnil);
+ Qccl = intern ("ccl");
+ staticpro (&Qccl);
+
+ Qcclp = intern ("cclp");
+ staticpro (&Qcclp);
+
Qccl_program = intern ("ccl-program");
staticpro (&Qccl_program);
/* Header for CCL (Code Conversion Language) interpreter.
Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- 2005, 2006, 2007
+ 2005, 2006, 2007, 2008
National Institute of Advanced Industrial Science and Technology (AIST)
Registration Number H14PRO021
+ Copyright (C) 2003
+ National Institute of Advanced Industrial Science and Technology (AIST)
+ Registration Number H13PRO009
This file is part of GNU Emacs.
many times bigger the output buffer
should be than the input buffer. */
int stack_idx; /* How deep the call of CCL_Call is nested. */
- int eol_type; /* When the CCL program is used for
- encoding by a coding system, set to
- the eol_type of the coding system.
- In other cases, always
- CODING_EOL_LF. */
- int multibyte; /* 1 if the source text is multibyte. */
+ int src_multibyte; /* 1 if the input buffer is multibyte. */
+ int dst_multibyte; /* 1 if the output buffer is multibyte. */
int cr_consumed; /* Flag for encoding DOS-like EOL
format when the CCL program is used
for encoding by a coding
system. */
+ int consumed;
+ int produced;
int suppress_error; /* If nonzero, don't insert error
message in the output. */
int eight_bit_control; /* If nonzero, ccl_driver counts all
coding_system. */
struct ccl_spec {
- struct ccl_program decoder;
- struct ccl_program encoder;
- unsigned char valid_codes[256];
+ struct ccl_program ccl;
int cr_carryover; /* CR carryover flag. */
unsigned char eight_bit_carryover[MAX_MULTIBYTE_LENGTH];
};
+#define CODING_SPEC_CCL_PROGRAM(coding) ((coding)->spec.ccl.ccl)
+
/* Alist of fontname patterns vs corresponding CCL program. */
extern Lisp_Object Vfont_ccl_encoder_alist;
/* Check if CCL is updated or not. If not, re-setup members of CCL. */
extern int check_ccl_update P_ ((struct ccl_program *));
-extern int ccl_driver P_ ((struct ccl_program *, unsigned char *,
- unsigned char *, int, int, int *));
+extern void ccl_driver P_ ((struct ccl_program *, int *, int *, int, int,
+ Lisp_Object));
/* Vector of CCL program names vs corresponding program data. */
extern Lisp_Object Vccl_program_table;
is an index for Vccl_protram_table. */
extern Lisp_Object Qccl_program_idx;
+extern Lisp_Object Qccl, Qcclp;
+
+EXFUN (Fccl_program_p, 1);
+
+#define CHECK_CCL_PROGRAM(x) \
+ do { \
+ if (NILP (Fccl_program_p (x))) \
+ x = wrong_type_argument (Qcclp, (x)); \
+ } while (0);
+
#endif /* EMACS_CCL_H */
/* arch-tag: 14681df7-876d-43de-bc71-6b78e23a4e3c
-/* Basic multilingual character support.
+/* Basic character set support.
Copyright (C) 2001, 2002, 2003, 2004, 2005,
- 2006, 2007 Free Software Foundation, Inc.
+ 2006, 2007, 2008 Free Software Foundation, Inc.
Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- 2005, 2006, 2007
+ 2005, 2006, 2007, 2008
National Institute of Advanced Industrial Science and Technology (AIST)
Registration Number H14PRO021
+ Copyright (C) 2003, 2004
+ National Institute of Advanced Industrial Science and Technology (AIST)
+ Registration Number H13PRO009
+
This file is part of GNU Emacs.
GNU Emacs is free software; you can redistribute it and/or modify
the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
Boston, MA 02110-1301, USA. */
-/* At first, see the document in `charset.h' to understand the code in
- this file. */
-
-#ifdef emacs
#include <config.h>
-#endif
#include <stdio.h>
-
-#ifdef emacs
-
+#include <unistd.h>
+#include <ctype.h>
#include <sys/types.h>
#include "lisp.h"
-#include "buffer.h"
+#include "character.h"
#include "charset.h"
-#include "composite.h"
#include "coding.h"
#include "disptab.h"
+#include "buffer.h"
-#else /* not emacs */
+/*** GENERAL NOTES on CODED CHARACTER SETS (CHARSETS) ***
-#include "mulelib.h"
+ A coded character set ("charset" hereafter) is a meaningful
+ collection (i.e. language, culture, functionality, etc.) of
+ characters. Emacs handles multiple charsets at once. In Emacs Lisp
+ code, a charset is represented by a symbol. In C code, a charset is
+ represented by its ID number or by a pointer to a struct charset.
-#endif /* emacs */
+ The actual information about each charset is stored in two places.
+ Lispy information is stored in the hash table Vcharset_hash_table as
+ a vector (charset attributes). The other information is stored in
+ charset_table as a struct charset.
-Lisp_Object Qcharset, Qascii, Qeight_bit_control, Qeight_bit_graphic;
-Lisp_Object Qunknown;
-
-/* Declaration of special leading-codes. */
-EMACS_INT leading_code_private_11; /* for private DIMENSION1 of 1-column */
-EMACS_INT leading_code_private_12; /* for private DIMENSION1 of 2-column */
-EMACS_INT leading_code_private_21; /* for private DIMENSION2 of 1-column */
-EMACS_INT leading_code_private_22; /* for private DIMENSION2 of 2-column */
-
-/* Declaration of special charsets. The values are set by
- Fsetup_special_charsets. */
-int charset_latin_iso8859_1; /* ISO8859-1 (Latin-1) */
-int charset_jisx0208_1978; /* JISX0208.1978 (Japanese Kanji old set) */
-int charset_jisx0208; /* JISX0208.1983 (Japanese Kanji) */
-int charset_katakana_jisx0201; /* JISX0201.Kana (Japanese Katakana) */
-int charset_latin_jisx0201; /* JISX0201.Roman (Japanese Roman) */
-int charset_big5_1; /* Big5 Level 1 (Chinese Traditional) */
-int charset_big5_2; /* Big5 Level 2 (Chinese Traditional) */
-int charset_mule_unicode_0100_24ff;
-int charset_mule_unicode_2500_33ff;
-int charset_mule_unicode_e000_ffff;
-
-Lisp_Object Qcharset_table;
-
-/* A char-table containing information of each character set. */
-Lisp_Object Vcharset_table;
-
-/* A vector of charset symbol indexed by charset-id. This is used
- only for returning charset symbol from C functions. */
-Lisp_Object Vcharset_symbol_table;
-
-/* A list of charset symbols ever defined. */
+*/
+
+/* List of all charsets. This variable is used only from Emacs
+ Lisp. */
Lisp_Object Vcharset_list;
-/* Vector of translation table ever defined.
- ID of a translation table is used to index this vector. */
-Lisp_Object Vtranslation_table_vector;
+/* Hash table that contains attributes of each charset. Keys are
+ charset symbols, and values are vectors of charset attributes. */
+Lisp_Object Vcharset_hash_table;
-/* A char-table for characters which may invoke auto-filling. */
-Lisp_Object Vauto_fill_chars;
+/* Table of struct charset. */
+struct charset *charset_table;
-Lisp_Object Qauto_fill_chars;
+static int charset_table_size;
+static int charset_table_used;
-/* Tables used by macros BYTES_BY_CHAR_HEAD and WIDTH_BY_CHAR_HEAD. */
-int bytes_by_char_head[256];
-int width_by_char_head[256];
+Lisp_Object Qcharsetp;
-/* Mapping table from ISO2022's charset (specified by DIMENSION,
- CHARS, and FINAL-CHAR) to Emacs' charset. */
-int iso_charset_table[2][2][128];
+/* Special charset symbols. */
+Lisp_Object Qascii;
+Lisp_Object Qeight_bit;
+Lisp_Object Qiso_8859_1;
+Lisp_Object Qunicode;
+
+/* The corresponding charsets. */
+int charset_ascii;
+int charset_eight_bit;
+int charset_iso_8859_1;
+int charset_unicode;
+
+/* The other special charsets. */
+int charset_jisx0201_roman;
+int charset_jisx0208_1978;
+int charset_jisx0208;
+
+/* Value of charset attribute `charset-iso-plane'. */
+Lisp_Object Qgl, Qgr;
-/* Variables used locally in the macro FETCH_MULTIBYTE_CHAR. */
-unsigned char *_fetch_multibyte_char_p;
-int _fetch_multibyte_char_len;
+/* Charset of unibyte characters. */
+int charset_unibyte;
-/* Offset to add to a non-ASCII value when inserting it. */
-EMACS_INT nonascii_insert_offset;
+/* List of charsets ordered by the priority. */
+Lisp_Object Vcharset_ordered_list;
-/* Translation table for converting non-ASCII unibyte characters
- to multibyte codes, or nil. */
-Lisp_Object Vnonascii_translation_table;
+/* Incremented everytime we change Vcharset_ordered_list. This is
+ unsigned short so that it fits in Lisp_Int and never matches
+ -1. */
+unsigned short charset_ordered_list_tick;
+
+/* List of iso-2022 charsets. */
+Lisp_Object Viso_2022_charset_list;
+
+/* List of emacs-mule charsets. */
+Lisp_Object Vemacs_mule_charset_list;
+
+struct charset *emacs_mule_charset[256];
+
+/* Mapping table from ISO2022's charset (specified by DIMENSION,
+ CHARS, and FINAL-CHAR) to Emacs' charset. */
+int iso_charset_table[ISO_MAX_DIMENSION][ISO_MAX_CHARS][ISO_MAX_FINAL];
+
+Lisp_Object Vcharset_map_path;
+
+Lisp_Object Vchar_unified_charset_table;
+
+/* Defined in chartab.c */
+extern void
+map_char_table_for_charset P_ ((void (*c_function) (Lisp_Object, Lisp_Object),
+ Lisp_Object function, Lisp_Object table,
+ Lisp_Object arg, struct charset *charset,
+ unsigned from, unsigned to));
+
+#define CODE_POINT_TO_INDEX(charset, code) \
+ ((charset)->code_linear_p \
+ ? (code) - (charset)->min_code \
+ : (((charset)->code_space_mask[(code) >> 24] & 0x8) \
+ && ((charset)->code_space_mask[((code) >> 16) & 0xFF] & 0x4) \
+ && ((charset)->code_space_mask[((code) >> 8) & 0xFF] & 0x2) \
+ && ((charset)->code_space_mask[(code) & 0xFF] & 0x1)) \
+ ? (((((code) >> 24) - (charset)->code_space[12]) \
+ * (charset)->code_space[11]) \
+ + (((((code) >> 16) & 0xFF) - (charset)->code_space[8]) \
+ * (charset)->code_space[7]) \
+ + (((((code) >> 8) & 0xFF) - (charset)->code_space[4]) \
+ * (charset)->code_space[3]) \
+ + (((code) & 0xFF) - (charset)->code_space[0]) \
+ - ((charset)->char_index_offset)) \
+ : -1)
+
+
+/* Convert the character index IDX to code-point CODE for CHARSET.
+ It is assumed that IDX is in a valid range. */
+
+#define INDEX_TO_CODE_POINT(charset, idx) \
+ ((charset)->code_linear_p \
+ ? (idx) + (charset)->min_code \
+ : (idx += (charset)->char_index_offset, \
+ (((charset)->code_space[0] + (idx) % (charset)->code_space[2]) \
+ | (((charset)->code_space[4] \
+ + ((idx) / (charset)->code_space[3] % (charset)->code_space[6])) \
+ << 8) \
+ | (((charset)->code_space[8] \
+ + ((idx) / (charset)->code_space[7] % (charset)->code_space[10])) \
+ << 16) \
+ | (((charset)->code_space[12] + ((idx) / (charset)->code_space[11])) \
+ << 24))))
-/* List of all possible generic characters. */
-Lisp_Object Vgeneric_character_list;
\f
-void
-invalid_character (c)
- int c;
-{
- error ("Invalid character: %d, #o%o, #x%x", c, c, c);
-}
-/* Parse string STR of length LENGTH and fetch information of a
- character at STR. Set BYTES to the byte length the character
- occupies, CHARSET, C1, C2 to proper values of the character. */
-
-#define SPLIT_MULTIBYTE_SEQ(str, length, bytes, charset, c1, c2) \
- do { \
- (c1) = *(str); \
- (bytes) = BYTES_BY_CHAR_HEAD (c1); \
- if ((bytes) == 1) \
- (charset) = ASCII_BYTE_P (c1) ? CHARSET_ASCII : CHARSET_8_BIT_GRAPHIC; \
- else if ((bytes) == 2) \
- { \
- if ((c1) == LEADING_CODE_8_BIT_CONTROL) \
- (charset) = CHARSET_8_BIT_CONTROL, (c1) = (str)[1] - 0x20; \
- else \
- (charset) = (c1), (c1) = (str)[1] & 0x7F; \
- } \
- else if ((bytes) == 3) \
- { \
- if ((c1) < LEADING_CODE_PRIVATE_11) \
- (charset) = (c1), (c1) = (str)[1] & 0x7F, (c2) = (str)[2] & 0x7F; \
- else \
- (charset) = (str)[1], (c1) = (str)[2] & 0x7F; \
- } \
- else \
- (charset) = (str)[1], (c1) = (str)[2] & 0x7F, (c2) = (str)[3] & 0x7F; \
- } while (0)
-
-/* 1 if CHARSET, C1, and C2 compose a valid character, else 0.
- Note that this intentionally allows invalid components, such
- as 0xA0 0xA0, because there exist many files that contain
- such invalid byte sequences, especially in EUC-GB. */
-#define CHAR_COMPONENTS_VALID_P(charset, c1, c2) \
- ((charset) == CHARSET_ASCII \
- ? ((c1) >= 0 && (c1) <= 0x7F) \
- : ((charset) == CHARSET_8_BIT_CONTROL \
- ? ((c1) >= 0x80 && (c1) <= 0x9F) \
- : ((charset) == CHARSET_8_BIT_GRAPHIC \
- ? ((c1) >= 0x80 && (c1) <= 0xFF) \
- : (CHARSET_DIMENSION (charset) == 1 \
- ? ((c1) >= 0x20 && (c1) <= 0x7F) \
- : ((c1) >= 0x20 && (c1) <= 0x7F \
- && (c2) >= 0x20 && (c2) <= 0x7F)))))
-
-/* Store multi-byte form of the character C in STR. The caller should
- allocate at least 4-byte area at STR in advance. Returns the
- length of the multi-byte form. If C is an invalid character code,
- return -1. */
+/* Set to 1 to warn that a charset map is loaded and thus a buffer
+ text and a string data may be relocated. */
+int charset_map_loaded;
-int
-char_to_string_1 (c, str)
- int c;
- unsigned char *str;
+struct charset_map_entries
{
- unsigned char *p = str;
+ struct {
+ unsigned from, to;
+ int c;
+ } entry[0x10000];
+ struct charset_map_entries *next;
+};
+
+/* Load the mapping information for CHARSET from ENTRIES.
+
+ If CONTROL_FLAG is 0, setup CHARSET->min_char and CHARSET->max_char.
+
+ If CONTROL_FLAG is 1, setup CHARSET->min_char, CHARSET->max_char,
+ CHARSET->decoder, and CHARSET->encoder.
+
+ If CONTROL_FLAG is 2, setup CHARSET->deunifier and
+ Vchar_unify_table. If Vchar_unified_charset_table is non-nil,
+ setup it too. */
+
+static void
+load_charset_map (charset, entries, n_entries, control_flag)
+ struct charset *charset;
+ struct charset_map_entries *entries;
+ int n_entries;
+ int control_flag;
+{
+ Lisp_Object vec, table;
+ unsigned max_code = CHARSET_MAX_CODE (charset);
+ int ascii_compatible_p = charset->ascii_compatible_p;
+ int min_char, max_char, nonascii_min_char;
+ int i;
+ unsigned char *fast_map = charset->fast_map;
- if (c & CHAR_MODIFIER_MASK) /* This includes the case C is negative. */
+ if (n_entries <= 0)
+ return;
+
+ if (control_flag > 0)
{
- /* Multibyte character can't have a modifier bit. */
- if (! SINGLE_BYTE_CHAR_P ((c & ~CHAR_MODIFIER_MASK)))
- return -1;
+ int n = CODE_POINT_TO_INDEX (charset, max_code) + 1;
- /* For Meta, Shift, and Control modifiers, we need special care. */
- if (c & CHAR_META)
+ table = Fmake_char_table (Qnil, Qnil);
+ if (control_flag == 1)
+ vec = Fmake_vector (make_number (n), make_number (-1));
+ else if (! CHAR_TABLE_P (Vchar_unify_table))
+ Vchar_unify_table = Fmake_char_table (Qnil, Qnil);
+
+ charset_map_loaded = 1;
+ }
+
+ min_char = max_char = entries->entry[0].c;
+ nonascii_min_char = MAX_CHAR;
+ for (i = 0; i < n_entries; i++)
+ {
+ unsigned from, to;
+ int from_index, to_index;
+ int from_c, to_c;
+ int idx = i % 0x10000;
+
+ if (i > 0 && idx == 0)
+ entries = entries->next;
+ from = entries->entry[idx].from;
+ to = entries->entry[idx].to;
+ from_c = entries->entry[idx].c;
+ from_index = CODE_POINT_TO_INDEX (charset, from);
+ if (from == to)
{
- /* Move the meta bit to the right place for a string. */
- c = (c & ~CHAR_META) | 0x80;
+ to_index = from_index;
+ to_c = from_c;
}
- if (c & CHAR_SHIFT)
+ else
{
- /* Shift modifier is valid only with [A-Za-z]. */
- if ((c & 0377) >= 'A' && (c & 0377) <= 'Z')
- c &= ~CHAR_SHIFT;
- else if ((c & 0377) >= 'a' && (c & 0377) <= 'z')
- c = (c & ~CHAR_SHIFT) - ('a' - 'A');
+ to_index = CODE_POINT_TO_INDEX (charset, to);
+ to_c = from_c + (to_index - from_index);
}
- if (c & CHAR_CTL)
+ if (from_index < 0 || to_index < 0)
+ continue;
+
+ if (control_flag < 2)
{
- /* Simulate the code in lread.c. */
- /* Allow `\C- ' and `\C-?'. */
- if (c == (CHAR_CTL | ' '))
- c = 0;
- else if (c == (CHAR_CTL | '?'))
- c = 127;
- /* ASCII control chars are made from letters (both cases),
- as well as the non-letters within 0100...0137. */
- else if ((c & 0137) >= 0101 && (c & 0137) <= 0132)
- c &= (037 | (~0177 & ~CHAR_CTL));
- else if ((c & 0177) >= 0100 && (c & 0177) <= 0137)
- c &= (037 | (~0177 & ~CHAR_CTL));
- }
+ int c;
- /* If C still has any modifier bits, just ignore it. */
- c &= ~CHAR_MODIFIER_MASK;
- }
+ if (to_c > max_char)
+ max_char = to_c;
+ else if (from_c < min_char)
+ min_char = from_c;
+ if (ascii_compatible_p)
+ {
+ if (! ASCII_BYTE_P (from_c))
+ {
+ if (from_c < nonascii_min_char)
+ nonascii_min_char = from_c;
+ }
+ else if (! ASCII_BYTE_P (to_c))
+ {
+ nonascii_min_char = 0x80;
+ }
+ }
- if (SINGLE_BYTE_CHAR_P (c))
- {
- if (ASCII_BYTE_P (c) || c >= 0xA0)
- *p++ = c;
+ for (c = from_c; c <= to_c; c++)
+ CHARSET_FAST_MAP_SET (c, fast_map);
+
+ if (control_flag == 1)
+ {
+ unsigned code = from;
+
+ if (CHARSET_COMPACT_CODES_P (charset))
+ while (1)
+ {
+ ASET (vec, from_index, make_number (from_c));
+ if (NILP (CHAR_TABLE_REF (table, from_c)))
+ CHAR_TABLE_SET (table, from_c, make_number (code));
+ if (from_index == to_index)
+ break;
+ from_index++, from_c++;
+ code = INDEX_TO_CODE_POINT (charset, from_index);
+ }
+ else
+ for (; from_index <= to_index; from_index++, from_c++)
+ {
+ ASET (vec, from_index, make_number (from_c));
+ if (NILP (CHAR_TABLE_REF (table, from_c)))
+ CHAR_TABLE_SET (table, from_c, make_number (from_index));
+ }
+ }
+ }
else
{
- *p++ = LEADING_CODE_8_BIT_CONTROL;
- *p++ = c + 0x20;
+ unsigned code = from;
+
+ while (1)
+ {
+ int c1 = DECODE_CHAR (charset, code);
+
+ if (c1 >= 0)
+ {
+ CHAR_TABLE_SET (table, from_c, make_number (c1));
+ CHAR_TABLE_SET (Vchar_unify_table, c1, make_number (from_c));
+ if (CHAR_TABLE_P (Vchar_unified_charset_table))
+ CHAR_TABLE_SET (Vchar_unified_charset_table, c1,
+ CHARSET_NAME (charset));
+ }
+ if (from_index == to_index)
+ break;
+ from_index++, from_c++;
+ code = INDEX_TO_CODE_POINT (charset, from_index);
+ }
}
}
- else if (CHAR_VALID_P (c, 0))
- {
- int charset, c1, c2;
- SPLIT_CHAR (c, charset, c1, c2);
-
- if (charset >= LEADING_CODE_EXT_11)
- *p++ = (charset < LEADING_CODE_EXT_12
- ? LEADING_CODE_PRIVATE_11
- : (charset < LEADING_CODE_EXT_21
- ? LEADING_CODE_PRIVATE_12
- : (charset < LEADING_CODE_EXT_22
- ? LEADING_CODE_PRIVATE_21
- : LEADING_CODE_PRIVATE_22)));
- *p++ = charset;
- if ((c1 > 0 && c1 < 32) || (c2 > 0 && c2 < 32))
- return -1;
- if (c1)
+ if (control_flag < 2)
+ {
+ CHARSET_MIN_CHAR (charset) = (ascii_compatible_p
+ ? nonascii_min_char : min_char);
+ CHARSET_MAX_CHAR (charset) = max_char;
+ if (control_flag == 1)
{
- *p++ = c1 | 0x80;
- if (c2 > 0)
- *p++ = c2 | 0x80;
+ CHARSET_DECODER (charset) = vec;
+ CHARSET_ENCODER (charset) = table;
}
}
else
- return -1;
-
- return (p - str);
+ CHARSET_DEUNIFIER (charset) = table;
}
-/* Store multi-byte form of the character C in STR. The caller should
- allocate at least 4-byte area at STR in advance. Returns the
- length of the multi-byte form. If C is an invalid character code,
- signal an error.
-
- Use macro `CHAR_STRING (C, STR)' instead of calling this function
- directly if C can be an ASCII character. */
+/* Read a hexadecimal number (preceded by "0x") from the file FP while
+ paying attention to comment charcter '#'. */
-int
-char_to_string (c, str)
- int c;
- unsigned char *str;
+static INLINE unsigned
+read_hex (fp, eof)
+ FILE *fp;
+ int *eof;
{
- int len;
- len = char_to_string_1 (c, str);
- if (len == -1)
- invalid_character (c);
- return len;
-}
+ int c;
+ unsigned n;
+ while ((c = getc (fp)) != EOF)
+ {
+ if (c == '#')
+ {
+ while ((c = getc (fp)) != EOF && c != '\n');
+ }
+ else if (c == '0')
+ {
+ if ((c = getc (fp)) == EOF || c == 'x')
+ break;
+ }
+ }
+ if (c == EOF)
+ {
+ *eof = 1;
+ return 0;
+ }
+ *eof = 0;
+ n = 0;
+ if (c == 'x')
+ while ((c = getc (fp)) != EOF && isxdigit (c))
+ n = ((n << 4)
+ | (c <= '9' ? c - '0' : c <= 'F' ? c - 'A' + 10 : c - 'a' + 10));
+ else
+ while ((c = getc (fp)) != EOF && isdigit (c))
+ n = (n * 10) + c - '0';
+ if (c != EOF)
+ ungetc (c, fp);
+ return n;
+}
-/* Return the non-ASCII character corresponding to multi-byte form at
- STR of length LEN. If ACTUAL_LEN is not NULL, store the byte
- length of the multibyte form in *ACTUAL_LEN.
- Use macros STRING_CHAR or STRING_CHAR_AND_LENGTH instead of calling
- this function directly if you want ot handle ASCII characters as
- well. */
+/* Return a mapping vector for CHARSET loaded from MAPFILE.
+ Each line of MAPFILE has this form
+ 0xAAAA 0xCCCC
+ where 0xAAAA is a code-point and 0xCCCC is the corresponding
+ character code, or this form
+ 0xAAAA-0xBBBB 0xCCCC
+ where 0xAAAA and 0xBBBB are code-points specifying a range, and
+ 0xCCCC is the first character code of the range.
-int
-string_to_char (str, len, actual_len)
- const unsigned char *str;
- int len, *actual_len;
-{
- int c, bytes, charset, c1, c2;
+ The returned vector has this form:
+ [ CODE1 CHAR1 CODE2 CHAR2 .... ]
+ where CODE1 is a code-point or a cons of code-points specifying a
+ range. */
- SPLIT_MULTIBYTE_SEQ (str, len, bytes, charset, c1, c2);
- c = MAKE_CHAR (charset, c1, c2);
- if (actual_len)
- *actual_len = bytes;
- return c;
-}
+extern void add_to_log P_ ((char *, Lisp_Object, Lisp_Object));
-/* Return the length of the multi-byte form at string STR of length LEN.
- Use the macro MULTIBYTE_FORM_LENGTH instead. */
-int
-multibyte_form_length (str, len)
- const unsigned char *str;
- int len;
+static void
+load_charset_map_from_file (charset, mapfile, control_flag)
+ struct charset *charset;
+ Lisp_Object mapfile;
+ int control_flag;
{
- int bytes;
-
- PARSE_MULTIBYTE_SEQ (str, len, bytes);
- return bytes;
-}
-
-/* Check multibyte form at string STR of length LEN and set variables
- pointed by CHARSET, C1, and C2 to charset and position codes of the
- character at STR, and return 0. If there's no multibyte character,
- return -1. This should be used only in the macro SPLIT_STRING
- which checks range of STR in advance. */
+ unsigned min_code = CHARSET_MIN_CODE (charset);
+ unsigned max_code = CHARSET_MAX_CODE (charset);
+ int fd;
+ FILE *fp;
+ int eof;
+ Lisp_Object suffixes;
+ struct charset_map_entries *head, *entries;
+ int n_entries;
+
+ suffixes = Fcons (build_string (".map"),
+ Fcons (build_string (".TXT"), Qnil));
+
+ fd = openp (Vcharset_map_path, mapfile, suffixes, NULL, Qnil);
+ if (fd < 0
+ || ! (fp = fdopen (fd, "r")))
+ {
+ add_to_log ("Failure in loading charset map: %S", mapfile, Qnil);
+ return;
+ }
-int
-split_string (str, len, charset, c1, c2)
- const unsigned char *str;
- unsigned char *c1, *c2;
- int len, *charset;
-{
- register int bytes, cs, code1, code2 = -1;
+ head = entries = ((struct charset_map_entries *)
+ alloca (sizeof (struct charset_map_entries)));
+ n_entries = 0;
+ eof = 0;
+ while (1)
+ {
+ unsigned from, to;
+ int c;
+ int idx;
- SPLIT_MULTIBYTE_SEQ (str, len, bytes, cs, code1, code2);
- if (cs == CHARSET_ASCII)
- return -1;
- *charset = cs;
- *c1 = code1;
- *c2 = code2;
- return 0;
-}
+ from = read_hex (fp, &eof);
+ if (eof)
+ break;
+ if (getc (fp) == '-')
+ to = read_hex (fp, &eof);
+ else
+ to = from;
+ c = (int) read_hex (fp, &eof);
-/* Return 1 if character C has valid printable glyph.
- Use the macro CHAR_PRINTABLE_P instead. */
-int
-char_printable_p (c)
- int c;
-{
- int charset, c1, c2;
+ if (from < min_code || to > max_code || from > to || c > MAX_CHAR)
+ continue;
- if (ASCII_BYTE_P (c))
- return 1;
- else if (SINGLE_BYTE_CHAR_P (c))
- return 0;
- else if (c >= MAX_CHAR)
- return 0;
+ if (n_entries > 0 && (n_entries % 0x10000) == 0)
+ {
+ entries->next = ((struct charset_map_entries *)
+ alloca (sizeof (struct charset_map_entries)));
+ entries = entries->next;
+ }
+ idx = n_entries % 0x10000;
+ entries->entry[idx].from = from;
+ entries->entry[idx].to = to;
+ entries->entry[idx].c = c;
+ n_entries++;
+ }
+ fclose (fp);
+ close (fd);
- SPLIT_CHAR (c, charset, c1, c2);
- if (! CHARSET_DEFINED_P (charset))
- return 0;
- if (CHARSET_CHARS (charset) == 94
- ? c1 <= 32 || c1 >= 127
- : c1 < 32)
- return 0;
- if (CHARSET_DIMENSION (charset) == 2
- && (CHARSET_CHARS (charset) == 94
- ? c2 <= 32 || c2 >= 127
- : c2 < 32))
- return 0;
- return 1;
+ load_charset_map (charset, head, n_entries, control_flag);
}
-/* Translate character C by translation table TABLE. If C
- is negative, translate a character specified by CHARSET, C1, and C2
- (C1 and C2 are code points of the character). If no translation is
- found in TABLE, return C. */
-int
-translate_char (table, c, charset, c1, c2)
- Lisp_Object table;
- int c, charset, c1, c2;
+static void
+load_charset_map_from_vector (charset, vec, control_flag)
+ struct charset *charset;
+ Lisp_Object vec;
+ int control_flag;
{
- Lisp_Object ch;
- int alt_charset, alt_c1, alt_c2, dimension;
-
- if (c < 0) c = MAKE_CHAR (charset, (c1 & 0x7F) , (c2 & 0x7F));
- if (!CHAR_TABLE_P (table)
- || (ch = Faref (table, make_number (c)), !NATNUMP (ch)))
- return c;
-
- SPLIT_CHAR (XFASTINT (ch), alt_charset, alt_c1, alt_c2);
- dimension = CHARSET_DIMENSION (alt_charset);
- if ((dimension == 1 && alt_c1 > 0) || (dimension == 2 && alt_c2 > 0))
- /* CH is not a generic character, just return it. */
- return XFASTINT (ch);
-
- /* Since CH is a generic character, we must return a specific
- charater which has the same position codes as C from CH. */
- if (charset < 0)
- SPLIT_CHAR (c, charset, c1, c2);
- if (dimension != CHARSET_DIMENSION (charset))
- /* We can't make such a character because of dimension mismatch. */
- return c;
- return MAKE_CHAR (alt_charset, c1, c2);
-}
+ unsigned min_code = CHARSET_MIN_CODE (charset);
+ unsigned max_code = CHARSET_MAX_CODE (charset);
+ struct charset_map_entries *head, *entries;
+ int n_entries;
+ int len = ASIZE (vec);
+ int i;
-/* Convert the unibyte character C to multibyte based on
- Vnonascii_translation_table or nonascii_insert_offset. If they can't
- convert C to a valid multibyte character, convert it based on
- DEFAULT_NONASCII_INSERT_OFFSET which makes C a Latin-1 character. */
+ if (len % 2 == 1)
+ {
+ add_to_log ("Failure in loading charset map: %V", vec, Qnil);
+ return;
+ }
-int
-unibyte_char_to_multibyte (c)
- int c;
-{
- if (c < 0400 && c >= 0200)
+ head = entries = ((struct charset_map_entries *)
+ alloca (sizeof (struct charset_map_entries)));
+ n_entries = 0;
+ for (i = 0; i < len; i += 2)
{
- int c_save = c;
+ Lisp_Object val, val2;
+ unsigned from, to;
+ int c;
+ int idx;
- if (! NILP (Vnonascii_translation_table))
+ val = AREF (vec, i);
+ if (CONSP (val))
{
- c = XINT (Faref (Vnonascii_translation_table, make_number (c)));
- if (c >= 0400 && ! char_valid_p (c, 0))
- c = c_save + DEFAULT_NONASCII_INSERT_OFFSET;
+ val2 = XCDR (val);
+ val = XCAR (val);
+ CHECK_NATNUM (val);
+ CHECK_NATNUM (val2);
+ from = XFASTINT (val);
+ to = XFASTINT (val2);
}
- else if (c >= 0240 && nonascii_insert_offset > 0)
+ else
{
- c += nonascii_insert_offset;
- if (c < 0400 || ! char_valid_p (c, 0))
- c = c_save + DEFAULT_NONASCII_INSERT_OFFSET;
+ CHECK_NATNUM (val);
+ from = to = XFASTINT (val);
}
- else if (c >= 0240)
- c = c_save + DEFAULT_NONASCII_INSERT_OFFSET;
- }
- return c;
-}
+ val = AREF (vec, i + 1);
+ CHECK_NATNUM (val);
+ c = XFASTINT (val);
+
+ if (from < min_code || to > max_code || from > to || c > MAX_CHAR)
+ continue;
+ if (n_entries > 0 && (n_entries % 0x10000) == 0)
+ {
+ entries->next = ((struct charset_map_entries *)
+ alloca (sizeof (struct charset_map_entries)));
+ entries = entries->next;
+ }
+ idx = n_entries % 0x10000;
+ entries->entry[idx].from = from;
+ entries->entry[idx].to = to;
+ entries->entry[idx].c = c;
+ n_entries++;
+ }
-/* Convert the multibyte character C to unibyte 8-bit character based
- on Vnonascii_translation_table or nonascii_insert_offset. If
- REV_TBL is non-nil, it should be a reverse table of
- Vnonascii_translation_table, i.e. what given by:
- Fchar_table_extra_slot (Vnonascii_translation_table, make_number (0)) */
+ load_charset_map (charset, head, n_entries, control_flag);
+}
-int
-multibyte_char_to_unibyte (c, rev_tbl)
- int c;
- Lisp_Object rev_tbl;
+static void
+load_charset (charset)
+ struct charset *charset;
{
- if (!SINGLE_BYTE_CHAR_P (c))
+ if (CHARSET_METHOD (charset) == CHARSET_METHOD_MAP_DEFERRED)
{
- int c_save = c;
+ Lisp_Object map;
- if (! CHAR_TABLE_P (rev_tbl)
- && CHAR_TABLE_P (Vnonascii_translation_table))
- rev_tbl = Fchar_table_extra_slot (Vnonascii_translation_table,
- make_number (0));
- if (CHAR_TABLE_P (rev_tbl))
- {
- Lisp_Object temp;
- temp = Faref (rev_tbl, make_number (c));
- if (INTEGERP (temp))
- c = XINT (temp);
- if (c >= 256)
- c = (c_save & 0177) + 0200;
- }
+ map = CHARSET_MAP (charset);
+ if (STRINGP (map))
+ load_charset_map_from_file (charset, map, 1);
else
- {
- if (nonascii_insert_offset > 0)
- c -= nonascii_insert_offset;
- if (c < 128 || c >= 256)
- c = (c_save & 0177) + 0200;
- }
+ load_charset_map_from_vector (charset, map, 1);
+ CHARSET_METHOD (charset) = CHARSET_METHOD_MAP;
}
+}
- return c;
+
+DEFUN ("charsetp", Fcharsetp, Scharsetp, 1, 1, 0,
+ doc: /* Return non-nil if and only if OBJECT is a charset.*/)
+ (object)
+ Lisp_Object object;
+{
+ return (CHARSETP (object) ? Qt : Qnil);
}
-\f
-/* Update the table Vcharset_table with the given arguments (see the
- document of `define-charset' for the meaning of each argument).
- Several other table contents are also updated. The caller should
- check the validity of CHARSET-ID and the remaining arguments in
- advance. */
void
-update_charset_table (charset_id, dimension, chars, width, direction,
- iso_final_char, iso_graphic_plane,
- short_name, long_name, description)
- Lisp_Object charset_id, dimension, chars, width, direction;
- Lisp_Object iso_final_char, iso_graphic_plane;
- Lisp_Object short_name, long_name, description;
+map_charset_chars (c_function, function, arg,
+ charset, from, to)
+ void (*c_function) P_ ((Lisp_Object, Lisp_Object));
+ Lisp_Object function, arg;
+ struct charset *charset;
+ unsigned from, to;
{
- int charset = XINT (charset_id);
- int bytes;
- unsigned char leading_code_base, leading_code_ext;
-
- if (NILP (CHARSET_TABLE_ENTRY (charset)))
- CHARSET_TABLE_ENTRY (charset)
- = Fmake_vector (make_number (CHARSET_MAX_IDX), Qnil);
-
- if (NILP (long_name))
- long_name = short_name;
- if (NILP (description))
- description = long_name;
-
- /* Get byte length of multibyte form, base leading-code, and
- extended leading-code of the charset. See the comment under the
- title "GENERAL NOTE on CHARACTER SET (CHARSET)" in charset.h. */
- bytes = XINT (dimension);
- if (charset < MIN_CHARSET_PRIVATE_DIMENSION1)
- {
- /* Official charset, it doesn't have an extended leading-code. */
- if (charset != CHARSET_ASCII && charset != CHARSET_8_BIT_GRAPHIC)
- bytes += 1; /* For a base leading-code. */
- leading_code_base = charset;
- leading_code_ext = 0;
- }
- else
- {
- /* Private charset. */
- bytes += 2; /* For base and extended leading-codes. */
- leading_code_base
- = (charset < LEADING_CODE_EXT_12
- ? LEADING_CODE_PRIVATE_11
- : (charset < LEADING_CODE_EXT_21
- ? LEADING_CODE_PRIVATE_12
- : (charset < LEADING_CODE_EXT_22
- ? LEADING_CODE_PRIVATE_21
- : LEADING_CODE_PRIVATE_22)));
- leading_code_ext = charset;
- if (BYTES_BY_CHAR_HEAD (leading_code_base) != bytes)
- error ("Invalid dimension for the charset-ID %d", charset);
- }
-
- CHARSET_TABLE_INFO (charset, CHARSET_ID_IDX) = charset_id;
- CHARSET_TABLE_INFO (charset, CHARSET_BYTES_IDX) = make_number (bytes);
- CHARSET_TABLE_INFO (charset, CHARSET_DIMENSION_IDX) = dimension;
- CHARSET_TABLE_INFO (charset, CHARSET_CHARS_IDX) = chars;
- CHARSET_TABLE_INFO (charset, CHARSET_WIDTH_IDX) = width;
- CHARSET_TABLE_INFO (charset, CHARSET_DIRECTION_IDX) = direction;
- CHARSET_TABLE_INFO (charset, CHARSET_LEADING_CODE_BASE_IDX)
- = make_number (leading_code_base);
- CHARSET_TABLE_INFO (charset, CHARSET_LEADING_CODE_EXT_IDX)
- = make_number (leading_code_ext);
- CHARSET_TABLE_INFO (charset, CHARSET_ISO_FINAL_CHAR_IDX) = iso_final_char;
- CHARSET_TABLE_INFO (charset, CHARSET_ISO_GRAPHIC_PLANE_IDX)
- = iso_graphic_plane;
- CHARSET_TABLE_INFO (charset, CHARSET_SHORT_NAME_IDX) = short_name;
- CHARSET_TABLE_INFO (charset, CHARSET_LONG_NAME_IDX) = long_name;
- CHARSET_TABLE_INFO (charset, CHARSET_DESCRIPTION_IDX) = description;
- CHARSET_TABLE_INFO (charset, CHARSET_PLIST_IDX) = Qnil;
+ Lisp_Object range;
+ int partial;
- {
- /* If we have already defined a charset which has the same
- DIMENSION, CHARS and ISO-FINAL-CHAR but the different
- DIRECTION, we must update the entry REVERSE-CHARSET of both
- charsets. If there's no such charset, the value of the entry
- is set to nil. */
- int i;
-
- for (i = 0; i <= MAX_CHARSET; i++)
- if (!NILP (CHARSET_TABLE_ENTRY (i)))
- {
- if (CHARSET_DIMENSION (i) == XINT (dimension)
- && CHARSET_CHARS (i) == XINT (chars)
- && CHARSET_ISO_FINAL_CHAR (i) == XINT (iso_final_char)
- && CHARSET_DIRECTION (i) != XINT (direction))
- {
- CHARSET_TABLE_INFO (charset, CHARSET_REVERSE_CHARSET_IDX)
- = make_number (i);
- CHARSET_TABLE_INFO (i, CHARSET_REVERSE_CHARSET_IDX) = charset_id;
- break;
- }
- }
- if (i > MAX_CHARSET)
- /* No such a charset. */
- CHARSET_TABLE_INFO (charset, CHARSET_REVERSE_CHARSET_IDX)
- = make_number (-1);
- }
+ if (CHARSET_METHOD (charset) == CHARSET_METHOD_MAP_DEFERRED)
+ load_charset (charset);
- if (charset != CHARSET_ASCII && charset != CHARSET_8_BIT_GRAPHIC
- && charset < MIN_CHARSET_PRIVATE_DIMENSION1)
+ partial = (from > CHARSET_MIN_CODE (charset)
+ || to < CHARSET_MAX_CODE (charset));
+
+ if (CHARSET_UNIFIED_P (charset)
+ && CHAR_TABLE_P (CHARSET_DEUNIFIER (charset)))
{
- bytes_by_char_head[leading_code_base] = bytes;
- width_by_char_head[leading_code_base] = XINT (width);
+ map_char_table_for_charset (c_function, function,
+ CHARSET_DEUNIFIER (charset), arg,
+ partial ? charset : NULL, from, to);
+ }
- /* Update table emacs_code_class. */
- emacs_code_class[charset] = (bytes == 2
- ? EMACS_leading_code_2
- : (bytes == 3
- ? EMACS_leading_code_3
- : EMACS_leading_code_4));
+ if (CHARSET_METHOD (charset) == CHARSET_METHOD_OFFSET)
+ {
+ int from_idx = CODE_POINT_TO_INDEX (charset, from);
+ int to_idx = CODE_POINT_TO_INDEX (charset, to);
+ int from_c = from_idx + CHARSET_CODE_OFFSET (charset);
+ int to_c = to_idx + CHARSET_CODE_OFFSET (charset);
+
+ range = Fcons (make_number (from_c), make_number (to_c));
+ if (NILP (function))
+ (*c_function) (arg, range);
+ else
+ call2 (function, range, arg);
+ }
+ else if (CHARSET_METHOD (charset) == CHARSET_METHOD_MAP)
+ {
+ if (! CHAR_TABLE_P (CHARSET_ENCODER (charset)))
+ return;
+ map_char_table_for_charset (c_function, function,
+ CHARSET_ENCODER (charset), arg,
+ partial ? charset : NULL, from, to);
}
+ else if (CHARSET_METHOD (charset) == CHARSET_METHOD_SUBSET)
+ {
+ Lisp_Object subset_info;
+ int offset;
+
+ subset_info = CHARSET_SUBSET (charset);
+ charset = CHARSET_FROM_ID (XFASTINT (AREF (subset_info, 0)));
+ offset = XINT (AREF (subset_info, 3));
+ from -= offset;
+ if (from < XFASTINT (AREF (subset_info, 1)))
+ from = XFASTINT (AREF (subset_info, 1));
+ to -= offset;
+ if (to > XFASTINT (AREF (subset_info, 2)))
+ to = XFASTINT (AREF (subset_info, 2));
+ map_charset_chars (c_function, function, arg, charset, from, to);
+ }
+ else /* i.e. CHARSET_METHOD_SUPERSET */
+ {
+ Lisp_Object parents;
- /* Update table iso_charset_table. */
- if (XINT (iso_final_char) >= 0
- && ISO_CHARSET_TABLE (dimension, chars, iso_final_char) < 0)
- ISO_CHARSET_TABLE (dimension, chars, iso_final_char) = charset;
+ for (parents = CHARSET_SUPERSET (charset); CONSP (parents);
+ parents = XCDR (parents))
+ {
+ int offset;
+ unsigned this_from, this_to;
+
+ charset = CHARSET_FROM_ID (XFASTINT (XCAR (XCAR (parents))));
+ offset = XINT (XCDR (XCAR (parents)));
+ this_from = from - offset;
+ this_to = to - offset;
+ if (this_from < CHARSET_MIN_CODE (charset))
+ this_from = CHARSET_MIN_CODE (charset);
+ if (this_to > CHARSET_MAX_CODE (charset))
+ this_to = CHARSET_MAX_CODE (charset);
+ map_charset_chars (c_function, function, arg, charset,
+ this_from, this_to);
+ }
+ }
}
-#ifdef emacs
+DEFUN ("map-charset-chars", Fmap_charset_chars, Smap_charset_chars, 2, 5, 0,
+ doc: /* Call FUNCTION for all characters in CHARSET.
+FUNCTION is called with an argument RANGE and the optional 3rd
+argument ARG.
-/* Return charset id of CHARSET_SYMBOL, or return -1 if CHARSET_SYMBOL
- is invalid. */
-int
-get_charset_id (charset_symbol)
- Lisp_Object charset_symbol;
-{
- Lisp_Object val;
- int charset;
-
- /* This originally used a ?: operator, but reportedly the HP-UX
- compiler version HP92453-01 A.10.32.22 miscompiles that. */
- if (SYMBOLP (charset_symbol)
- && VECTORP (val = Fget (charset_symbol, Qcharset))
- && CHARSET_VALID_P (charset =
- XINT (XVECTOR (val)->contents[CHARSET_ID_IDX])))
- return charset;
- else
- return -1;
-}
+RANGE is a cons (FROM . TO), where FROM and TO indicate a range of
+characters contained in CHARSET.
-/* Return an identification number for a new private charset of
- DIMENSION and WIDTH. If there's no more room for the new charset,
- return 0. */
-Lisp_Object
-get_new_private_charset_id (dimension, width)
- int dimension, width;
+The optional 4th and 5th arguments FROM-CODE and TO-CODE specify the
+range of code points of target characters. */)
+ (function, charset, arg, from_code, to_code)
+ Lisp_Object function, charset, arg, from_code, to_code;
{
- int charset, from, to;
+ struct charset *cs;
+ unsigned from, to;
- if (dimension == 1)
+ CHECK_CHARSET_GET_CHARSET (charset, cs);
+ if (NILP (from_code))
+ from = CHARSET_MIN_CODE (cs);
+ else
{
- from = LEADING_CODE_EXT_11;
- to = LEADING_CODE_EXT_21;
+ CHECK_NATNUM (from_code);
+ from = XINT (from_code);
+ if (from < CHARSET_MIN_CODE (cs))
+ from = CHARSET_MIN_CODE (cs);
}
+ if (NILP (to_code))
+ to = CHARSET_MAX_CODE (cs);
else
{
- from = LEADING_CODE_EXT_21;
- to = LEADING_CODE_EXT_MAX + 1;
+ CHECK_NATNUM (to_code);
+ to = XINT (to_code);
+ if (to > CHARSET_MAX_CODE (cs))
+ to = CHARSET_MAX_CODE (cs);
}
-
- for (charset = from; charset < to; charset++)
- if (!CHARSET_DEFINED_P (charset)) break;
-
- return make_number (charset < to ? charset : 0);
-}
-
-DEFUN ("define-charset", Fdefine_charset, Sdefine_charset, 3, 3, 0,
- doc: /* Define CHARSET-ID as the identification number of CHARSET with INFO-VECTOR.
-If CHARSET-ID is nil, it is decided automatically, which means CHARSET is
- treated as a private charset.
-INFO-VECTOR is a vector of the format:
- [DIMENSION CHARS WIDTH DIRECTION ISO-FINAL-CHAR ISO-GRAPHIC-PLANE
- SHORT-NAME LONG-NAME DESCRIPTION]
-The meanings of each elements is as follows:
-DIMENSION (integer) is the number of bytes to represent a character: 1 or 2.
-CHARS (integer) is the number of characters in a dimension: 94 or 96.
-WIDTH (integer) is the number of columns a character in the charset
-occupies on the screen: one of 0, 1, and 2.
-
-DIRECTION (integer) is the rendering direction of characters in the
-charset when rendering. If 0, render from left to right, else
-render from right to left.
-
-ISO-FINAL-CHAR (character) is the final character of the
-corresponding ISO 2022 charset.
-It may be -1 if the charset is internal use only.
-
-ISO-GRAPHIC-PLANE (integer) is the graphic plane to be invoked
-while encoding to variants of ISO 2022 coding system, one of the
-following: 0/graphic-plane-left(GL), 1/graphic-plane-right(GR).
-It may be -1 if the charset is internal use only.
-
-SHORT-NAME (string) is the short name to refer to the charset.
-
-LONG-NAME (string) is the long name to refer to the charset.
-
-DESCRIPTION (string) is the description string of the charset. */)
- (charset_id, charset_symbol, info_vector)
- Lisp_Object charset_id, charset_symbol, info_vector;
-{
- Lisp_Object *vec;
-
- if (!NILP (charset_id))
- CHECK_NUMBER (charset_id);
- CHECK_SYMBOL (charset_symbol);
- CHECK_VECTOR (info_vector);
-
- if (! NILP (charset_id))
- {
- if (! CHARSET_VALID_P (XINT (charset_id)))
- error ("Invalid CHARSET: %d", XINT (charset_id));
- else if (CHARSET_DEFINED_P (XINT (charset_id)))
- error ("Already defined charset: %d", XINT (charset_id));
- }
-
- vec = XVECTOR (info_vector)->contents;
- if (XVECTOR (info_vector)->size != 9
- || !INTEGERP (vec[0]) || !(XINT (vec[0]) == 1 || XINT (vec[0]) == 2)
- || !INTEGERP (vec[1]) || !(XINT (vec[1]) == 94 || XINT (vec[1]) == 96)
- || !INTEGERP (vec[2]) || !(XINT (vec[2]) == 1 || XINT (vec[2]) == 2)
- || !INTEGERP (vec[3]) || !(XINT (vec[3]) == 0 || XINT (vec[3]) == 1)
- || !INTEGERP (vec[4])
- || !(XINT (vec[4]) == -1 || (XINT (vec[4]) >= '0' && XINT (vec[4]) <= '~'))
- || !INTEGERP (vec[5])
- || !(XINT (vec[5]) == -1 || XINT (vec[5]) == 0 || XINT (vec[5]) == 1)
- || !STRINGP (vec[6])
- || !STRINGP (vec[7])
- || !STRINGP (vec[8]))
- error ("Invalid info-vector argument for defining charset %s",
- SDATA (SYMBOL_NAME (charset_symbol)));
-
- if (NILP (charset_id))
- {
- charset_id = get_new_private_charset_id (XINT (vec[0]), XINT (vec[2]));
- if (XINT (charset_id) == 0)
- error ("There's no room for a new private charset %s",
- SDATA (SYMBOL_NAME (charset_symbol)));
- }
-
- update_charset_table (charset_id, vec[0], vec[1], vec[2], vec[3],
- vec[4], vec[5], vec[6], vec[7], vec[8]);
- Fput (charset_symbol, Qcharset, CHARSET_TABLE_ENTRY (XINT (charset_id)));
- CHARSET_SYMBOL (XINT (charset_id)) = charset_symbol;
- Vcharset_list = Fcons (charset_symbol, Vcharset_list);
- Fupdate_coding_systems_internal ();
+ map_charset_chars (NULL, function, arg, cs, from, to);
return Qnil;
}
-DEFUN ("generic-character-list", Fgeneric_character_list,
- Sgeneric_character_list, 0, 0, 0,
- doc: /* Return a list of all possible generic characters.
-It includes a generic character for a charset not yet defined. */)
- ()
-{
- return Vgeneric_character_list;
-}
-DEFUN ("get-unused-iso-final-char", Fget_unused_iso_final_char,
- Sget_unused_iso_final_char, 2, 2, 0,
- doc: /* Return an unused ISO's final char for a charset of DIMENSION and CHARS.
-DIMENSION is the number of bytes to represent a character: 1 or 2.
-CHARS is the number of characters in a dimension: 94 or 96.
+/* Define a charset according to the arguments. The Nth argument is
+ the Nth attribute of the charset (the last attribute `charset-id'
+ is not included). See the docstring of `define-charset' for the
+ detail. */
-This final char is for private use, thus the range is `0' (48) .. `?' (63).
-If there's no unused final char for the specified kind of charset,
-return nil. */)
- (dimension, chars)
- Lisp_Object dimension, chars;
+DEFUN ("define-charset-internal", Fdefine_charset_internal,
+ Sdefine_charset_internal, charset_arg_max, MANY, 0,
+ doc: /* For internal use only.
+usage: (define-charset-internal ...) */)
+ (nargs, args)
+ int nargs;
+ Lisp_Object *args;
{
- int final_char;
+ /* Charset attr vector. */
+ Lisp_Object attrs;
+ Lisp_Object val;
+ unsigned hash_code;
+ struct Lisp_Hash_Table *hash_table = XHASH_TABLE (Vcharset_hash_table);
+ int i, j;
+ struct charset charset;
+ int id;
+ int dimension;
+ int new_definition_p;
+ int nchars;
+
+ if (nargs != charset_arg_max)
+ return Fsignal (Qwrong_number_of_arguments,
+ Fcons (intern ("define-charset-internal"),
+ make_number (nargs)));
+
+ attrs = Fmake_vector (make_number (charset_attr_max), Qnil);
+
+ CHECK_SYMBOL (args[charset_arg_name]);
+ ASET (attrs, charset_name, args[charset_arg_name]);
+
+ val = args[charset_arg_code_space];
+ for (i = 0, dimension = 0, nchars = 1; i < 4; i++)
+ {
+ int min_byte, max_byte;
+
+ min_byte = XINT (Faref (val, make_number (i * 2)));
+ max_byte = XINT (Faref (val, make_number (i * 2 + 1)));
+ if (min_byte < 0 || min_byte > max_byte || max_byte >= 256)
+ error ("Invalid :code-space value");
+ charset.code_space[i * 4] = min_byte;
+ charset.code_space[i * 4 + 1] = max_byte;
+ charset.code_space[i * 4 + 2] = max_byte - min_byte + 1;
+ nchars *= charset.code_space[i * 4 + 2];
+ charset.code_space[i * 4 + 3] = nchars;
+ if (max_byte > 0)
+ dimension = i + 1;
+ }
- CHECK_NUMBER (dimension);
- CHECK_NUMBER (chars);
- if (XINT (dimension) != 1 && XINT (dimension) != 2)
- error ("Invalid charset dimension %d, it should be 1 or 2",
- XINT (dimension));
- if (XINT (chars) != 94 && XINT (chars) != 96)
- error ("Invalid charset chars %d, it should be 94 or 96",
- XINT (chars));
- for (final_char = '0'; final_char <= '?'; final_char++)
+ val = args[charset_arg_dimension];
+ if (NILP (val))
+ charset.dimension = dimension;
+ else
{
- if (ISO_CHARSET_TABLE (dimension, chars, make_number (final_char)) < 0)
- break;
+ CHECK_NATNUM (val);
+ charset.dimension = XINT (val);
+ if (charset.dimension < 1 || charset.dimension > 4)
+ args_out_of_range_3 (val, make_number (1), make_number (4));
}
- return (final_char <= '?' ? make_number (final_char) : Qnil);
-}
-DEFUN ("declare-equiv-charset", Fdeclare_equiv_charset, Sdeclare_equiv_charset,
- 4, 4, 0,
- doc: /* Declare an equivalent charset for ISO-2022 decoding.
+ charset.code_linear_p
+ = (charset.dimension == 1
+ || (charset.code_space[2] == 256
+ && (charset.dimension == 2
+ || (charset.code_space[6] == 256
+ && (charset.dimension == 3
+ || charset.code_space[10] == 256)))));
-On decoding by an ISO-2022 base coding system, when a charset
-specified by DIMENSION, CHARS, and FINAL-CHAR is designated, behave as
-if CHARSET is designated instead. */)
- (dimension, chars, final_char, charset)
- Lisp_Object dimension, chars, final_char, charset;
-{
- int charset_id;
+ if (! charset.code_linear_p)
+ {
+ charset.code_space_mask = (unsigned char *) xmalloc (256);
+ bzero (charset.code_space_mask, 256);
+ for (i = 0; i < 4; i++)
+ for (j = charset.code_space[i * 4]; j <= charset.code_space[i * 4 + 1];
+ j++)
+ charset.code_space_mask[j] |= (1 << i);
+ }
- CHECK_NUMBER (dimension);
- CHECK_NUMBER (chars);
- CHECK_NUMBER (final_char);
- CHECK_SYMBOL (charset);
+ charset.iso_chars_96 = charset.code_space[2] == 96;
- if (XINT (dimension) != 1 && XINT (dimension) != 2)
- error ("Invalid DIMENSION %d, it should be 1 or 2", XINT (dimension));
- if (XINT (chars) != 94 && XINT (chars) != 96)
- error ("Invalid CHARS %d, it should be 94 or 96", XINT (chars));
- if (XINT (final_char) < '0' || XFASTINT (final_char) > '~')
- error ("Invalid FINAL-CHAR %c, it should be `0'..`~'", XINT (chars));
- if ((charset_id = get_charset_id (charset)) < 0)
- error ("Invalid charset %s", SDATA (SYMBOL_NAME (charset)));
+ charset.min_code = (charset.code_space[0]
+ | (charset.code_space[4] << 8)
+ | (charset.code_space[8] << 16)
+ | (charset.code_space[12] << 24));
+ charset.max_code = (charset.code_space[1]
+ | (charset.code_space[5] << 8)
+ | (charset.code_space[9] << 16)
+ | (charset.code_space[13] << 24));
+ charset.char_index_offset = 0;
- ISO_CHARSET_TABLE (dimension, chars, final_char) = charset_id;
- return Qnil;
-}
+ val = args[charset_arg_min_code];
+ if (! NILP (val))
+ {
+ unsigned code;
-/* Return information about charsets in the text at PTR of NBYTES
- bytes, which are NCHARS characters. The value is:
+ if (INTEGERP (val))
+ code = XINT (val);
+ else
+ {
+ CHECK_CONS (val);
+ CHECK_NUMBER_CAR (val);
+ CHECK_NUMBER_CDR (val);
+ code = (XINT (XCAR (val)) << 16) | (XINT (XCDR (val)));
+ }
+ if (code < charset.min_code
+ || code > charset.max_code)
+ args_out_of_range_3 (make_number (charset.min_code),
+ make_number (charset.max_code), val);
+ charset.char_index_offset = CODE_POINT_TO_INDEX (&charset, code);
+ charset.min_code = code;
+ }
- 0: Each character is represented by one byte. This is always
- true for unibyte text.
- 1: No charsets other than ascii eight-bit-control,
- eight-bit-graphic, and latin-1 are found.
- 2: Otherwise.
+ val = args[charset_arg_max_code];
+ if (! NILP (val))
+ {
+ unsigned code;
+
+ if (INTEGERP (val))
+ code = XINT (val);
+ else
+ {
+ CHECK_CONS (val);
+ CHECK_NUMBER_CAR (val);
+ CHECK_NUMBER_CDR (val);
+ code = (XINT (XCAR (val)) << 16) | (XINT (XCDR (val)));
+ }
+ if (code < charset.min_code
+ || code > charset.max_code)
+ args_out_of_range_3 (make_number (charset.min_code),
+ make_number (charset.max_code), val);
+ charset.max_code = code;
+ }
- In addition, if CHARSETS is nonzero, for each found charset N, set
- CHARSETS[N] to 1. For that, callers should allocate CHARSETS
- (MAX_CHARSET + 1 elements) in advance. It may lookup a translation
- table TABLE if supplied. For invalid charsets, set CHARSETS[1] to
- 1 (note that there's no charset whose ID is 1). */
+ charset.compact_codes_p = charset.max_code < 0x1000000;
-int
-find_charset_in_text (ptr, nchars, nbytes, charsets, table)
- const unsigned char *ptr;
- int nchars, nbytes, *charsets;
- Lisp_Object table;
-{
- if (nchars == nbytes)
+ val = args[charset_arg_invalid_code];
+ if (NILP (val))
{
- if (charsets && nbytes > 0)
+ if (charset.min_code > 0)
+ charset.invalid_code = 0;
+ else
{
- const unsigned char *endp = ptr + nbytes;
- int maskbits = 0;
+ XSETINT (val, charset.max_code + 1);
+ if (XINT (val) == charset.max_code + 1)
+ charset.invalid_code = charset.max_code + 1;
+ else
+ error ("Attribute :invalid-code must be specified");
+ }
+ }
+ else
+ {
+ CHECK_NATNUM (val);
+ charset.invalid_code = XFASTINT (val);
+ }
- while (ptr < endp && maskbits != 7)
- {
- maskbits |= (*ptr < 0x80 ? 1 : *ptr < 0xA0 ? 2 : 4);
- ptr++;
- }
+ val = args[charset_arg_iso_final];
+ if (NILP (val))
+ charset.iso_final = -1;
+ else
+ {
+ CHECK_NUMBER (val);
+ if (XINT (val) < '0' || XINT (val) > 127)
+ error ("Invalid iso-final-char: %d", XINT (val));
+ charset.iso_final = XINT (val);
+ }
- if (maskbits & 1)
- charsets[CHARSET_ASCII] = 1;
- if (maskbits & 2)
- charsets[CHARSET_8_BIT_CONTROL] = 1;
- if (maskbits & 4)
- charsets[CHARSET_8_BIT_GRAPHIC] = 1;
- }
- return 0;
+ val = args[charset_arg_iso_revision];
+ if (NILP (val))
+ charset.iso_revision = -1;
+ else
+ {
+ CHECK_NUMBER (val);
+ if (XINT (val) > 63)
+ args_out_of_range (make_number (63), val);
+ charset.iso_revision = XINT (val);
}
+
+ val = args[charset_arg_emacs_mule_id];
+ if (NILP (val))
+ charset.emacs_mule_id = -1;
else
{
- int return_val = 1;
- int bytes, charset, c1, c2;
+ CHECK_NATNUM (val);
+ if ((XINT (val) > 0 && XINT (val) <= 128) || XINT (val) >= 256)
+ error ("Invalid emacs-mule-id: %d", XINT (val));
+ charset.emacs_mule_id = XINT (val);
+ }
- if (! CHAR_TABLE_P (table))
- table = Qnil;
+ charset.ascii_compatible_p = ! NILP (args[charset_arg_ascii_compatible_p]);
- while (nchars-- > 0)
- {
- SPLIT_MULTIBYTE_SEQ (ptr, len, bytes, charset, c1, c2);
- ptr += bytes;
+ charset.supplementary_p = ! NILP (args[charset_arg_supplementary_p]);
- if (!CHARSET_DEFINED_P (charset))
- charset = 1;
- else if (! NILP (table))
- {
- int c = translate_char (table, -1, charset, c1, c2);
- if (c >= 0)
- charset = CHAR_CHARSET (c);
- }
+ charset.unified_p = 0;
- if (return_val == 1
- && charset != CHARSET_ASCII
- && charset != CHARSET_8_BIT_CONTROL
- && charset != CHARSET_8_BIT_GRAPHIC
- && charset != charset_latin_iso8859_1)
- return_val = 2;
+ bzero (charset.fast_map, sizeof (charset.fast_map));
- if (charsets)
- charsets[charset] = 1;
- else if (return_val == 2)
- break;
- }
- return return_val;
+ if (! NILP (args[charset_arg_code_offset]))
+ {
+ val = args[charset_arg_code_offset];
+ CHECK_NUMBER (val);
+
+ charset.method = CHARSET_METHOD_OFFSET;
+ charset.code_offset = XINT (val);
+
+ i = CODE_POINT_TO_INDEX (&charset, charset.min_code);
+ charset.min_char = i + charset.code_offset;
+ i = CODE_POINT_TO_INDEX (&charset, charset.max_code);
+ charset.max_char = i + charset.code_offset;
+ if (charset.max_char > MAX_CHAR)
+ error ("Unsupported max char: %d", charset.max_char);
+
+ i = (charset.min_char >> 7) << 7;
+ for (; i < 0x10000 && i <= charset.max_char; i += 128)
+ CHARSET_FAST_MAP_SET (i, charset.fast_map);
+ i = (i >> 12) << 12;
+ for (; i <= charset.max_char; i += 0x1000)
+ CHARSET_FAST_MAP_SET (i, charset.fast_map);
}
-}
-
-DEFUN ("find-charset-region", Ffind_charset_region, Sfind_charset_region,
+ else if (! NILP (args[charset_arg_map]))
+ {
+ val = args[charset_arg_map];
+ ASET (attrs, charset_map, val);
+ if (STRINGP (val))
+ load_charset_map_from_file (&charset, val, 0);
+ else
+ load_charset_map_from_vector (&charset, val, 0);
+ charset.method = CHARSET_METHOD_MAP_DEFERRED;
+ }
+ else if (! NILP (args[charset_arg_subset]))
+ {
+ Lisp_Object parent;
+ Lisp_Object parent_min_code, parent_max_code, parent_code_offset;
+ struct charset *parent_charset;
+
+ val = args[charset_arg_subset];
+ parent = Fcar (val);
+ CHECK_CHARSET_GET_CHARSET (parent, parent_charset);
+ parent_min_code = Fnth (make_number (1), val);
+ CHECK_NATNUM (parent_min_code);
+ parent_max_code = Fnth (make_number (2), val);
+ CHECK_NATNUM (parent_max_code);
+ parent_code_offset = Fnth (make_number (3), val);
+ CHECK_NUMBER (parent_code_offset);
+ val = Fmake_vector (make_number (4), Qnil);
+ ASET (val, 0, make_number (parent_charset->id));
+ ASET (val, 1, parent_min_code);
+ ASET (val, 2, parent_max_code);
+ ASET (val, 3, parent_code_offset);
+ ASET (attrs, charset_subset, val);
+
+ charset.method = CHARSET_METHOD_SUBSET;
+ /* Here, we just copy the parent's fast_map. It's not accurate,
+ but at least it works for quickly detecting which character
+ DOESN'T belong to this charset. */
+ for (i = 0; i < 190; i++)
+ charset.fast_map[i] = parent_charset->fast_map[i];
+
+ /* We also copy these for parents. */
+ charset.min_char = parent_charset->min_char;
+ charset.max_char = parent_charset->max_char;
+ }
+ else if (! NILP (args[charset_arg_superset]))
+ {
+ val = args[charset_arg_superset];
+ charset.method = CHARSET_METHOD_SUPERSET;
+ val = Fcopy_sequence (val);
+ ASET (attrs, charset_superset, val);
+
+ charset.min_char = MAX_CHAR;
+ charset.max_char = 0;
+ for (; ! NILP (val); val = Fcdr (val))
+ {
+ Lisp_Object elt, car_part, cdr_part;
+ int this_id, offset;
+ struct charset *this_charset;
+
+ elt = Fcar (val);
+ if (CONSP (elt))
+ {
+ car_part = XCAR (elt);
+ cdr_part = XCDR (elt);
+ CHECK_CHARSET_GET_ID (car_part, this_id);
+ CHECK_NUMBER (cdr_part);
+ offset = XINT (cdr_part);
+ }
+ else
+ {
+ CHECK_CHARSET_GET_ID (elt, this_id);
+ offset = 0;
+ }
+ XSETCAR (val, Fcons (make_number (this_id), make_number (offset)));
+
+ this_charset = CHARSET_FROM_ID (this_id);
+ if (charset.min_char > this_charset->min_char)
+ charset.min_char = this_charset->min_char;
+ if (charset.max_char < this_charset->max_char)
+ charset.max_char = this_charset->max_char;
+ for (i = 0; i < 190; i++)
+ charset.fast_map[i] |= this_charset->fast_map[i];
+ }
+ }
+ else
+ error ("None of :code-offset, :map, :parents are specified");
+
+ val = args[charset_arg_unify_map];
+ if (! NILP (val) && !STRINGP (val))
+ CHECK_VECTOR (val);
+ ASET (attrs, charset_unify_map, val);
+
+ CHECK_LIST (args[charset_arg_plist]);
+ ASET (attrs, charset_plist, args[charset_arg_plist]);
+
+ charset.hash_index = hash_lookup (hash_table, args[charset_arg_name],
+ &hash_code);
+ if (charset.hash_index >= 0)
+ {
+ new_definition_p = 0;
+ id = XFASTINT (CHARSET_SYMBOL_ID (args[charset_arg_name]));
+ HASH_VALUE (hash_table, charset.hash_index) = attrs;
+ }
+ else
+ {
+ charset.hash_index = hash_put (hash_table, args[charset_arg_name], attrs,
+ hash_code);
+ if (charset_table_used == charset_table_size)
+ {
+ struct charset *new_table
+ = (struct charset *) xmalloc (sizeof (struct charset)
+ * (charset_table_size + 16));
+ bcopy (charset_table, new_table,
+ sizeof (struct charset) * charset_table_size);
+ charset_table_size += 16;
+ charset_table = new_table;
+ }
+ id = charset_table_used++;
+ new_definition_p = 1;
+ }
+
+ ASET (attrs, charset_id, make_number (id));
+ charset.id = id;
+ charset_table[id] = charset;
+
+ if (charset.iso_final >= 0)
+ {
+ ISO_CHARSET_TABLE (charset.dimension, charset.iso_chars_96,
+ charset.iso_final) = id;
+ if (new_definition_p)
+ Viso_2022_charset_list = nconc2 (Viso_2022_charset_list,
+ Fcons (make_number (id), Qnil));
+ if (ISO_CHARSET_TABLE (1, 0, 'J') == id)
+ charset_jisx0201_roman = id;
+ else if (ISO_CHARSET_TABLE (2, 0, '@') == id)
+ charset_jisx0208_1978 = id;
+ else if (ISO_CHARSET_TABLE (2, 0, 'B') == id)
+ charset_jisx0208 = id;
+ }
+
+ if (charset.emacs_mule_id >= 0)
+ {
+ emacs_mule_charset[charset.emacs_mule_id] = CHARSET_FROM_ID (id);
+ if (charset.emacs_mule_id < 0xA0)
+ emacs_mule_bytes[charset.emacs_mule_id] = charset.dimension + 1;
+ else
+ emacs_mule_bytes[charset.emacs_mule_id] = charset.dimension + 2;
+ if (new_definition_p)
+ Vemacs_mule_charset_list = nconc2 (Vemacs_mule_charset_list,
+ Fcons (make_number (id), Qnil));
+ }
+
+ if (new_definition_p)
+ {
+ Vcharset_list = Fcons (args[charset_arg_name], Vcharset_list);
+ if (charset.supplementary_p)
+ Vcharset_ordered_list = nconc2 (Vcharset_ordered_list,
+ Fcons (make_number (id), Qnil));
+ else
+ Vcharset_ordered_list = Fcons (make_number (id),
+ Vcharset_ordered_list);
+ charset_ordered_list_tick++;
+ }
+
+ return Qnil;
+}
+
+
+/* Same as Fdefine_charset_internal but arguments are more convenient
+ to call from C (typically in syms_of_charset). This can define a
+ charset of `offset' method only. Return the ID of the new
+ charset. */
+
+static int
+define_charset_internal (name, dimension, code_space, min_code, max_code,
+ iso_final, iso_revision, emacs_mule_id,
+ ascii_compatible, supplementary,
+ code_offset)
+ Lisp_Object name;
+ int dimension;
+ unsigned char *code_space;
+ unsigned min_code, max_code;
+ int iso_final, iso_revision, emacs_mule_id;
+ int ascii_compatible, supplementary;
+ int code_offset;
+{
+ Lisp_Object args[charset_arg_max];
+ Lisp_Object plist[14];
+ Lisp_Object val;
+ int i;
+
+ args[charset_arg_name] = name;
+ args[charset_arg_dimension] = make_number (dimension);
+ val = Fmake_vector (make_number (8), make_number (0));
+ for (i = 0; i < 8; i++)
+ ASET (val, i, make_number (code_space[i]));
+ args[charset_arg_code_space] = val;
+ args[charset_arg_min_code] = make_number (min_code);
+ args[charset_arg_max_code] = make_number (max_code);
+ args[charset_arg_iso_final]
+ = (iso_final < 0 ? Qnil : make_number (iso_final));
+ args[charset_arg_iso_revision] = make_number (iso_revision);
+ args[charset_arg_emacs_mule_id]
+ = (emacs_mule_id < 0 ? Qnil : make_number (emacs_mule_id));
+ args[charset_arg_ascii_compatible_p] = ascii_compatible ? Qt : Qnil;
+ args[charset_arg_supplementary_p] = supplementary ? Qt : Qnil;
+ args[charset_arg_invalid_code] = Qnil;
+ args[charset_arg_code_offset] = make_number (code_offset);
+ args[charset_arg_map] = Qnil;
+ args[charset_arg_subset] = Qnil;
+ args[charset_arg_superset] = Qnil;
+ args[charset_arg_unify_map] = Qnil;
+
+ plist[0] = intern (":name");
+ plist[1] = args[charset_arg_name];
+ plist[2] = intern (":dimension");
+ plist[3] = args[charset_arg_dimension];
+ plist[4] = intern (":code-space");
+ plist[5] = args[charset_arg_code_space];
+ plist[6] = intern (":iso-final-char");
+ plist[7] = args[charset_arg_iso_final];
+ plist[8] = intern (":emacs-mule-id");
+ plist[9] = args[charset_arg_emacs_mule_id];
+ plist[10] = intern (":ascii-compatible-p");
+ plist[11] = args[charset_arg_ascii_compatible_p];
+ plist[12] = intern (":code-offset");
+ plist[13] = args[charset_arg_code_offset];
+
+ args[charset_arg_plist] = Flist (14, plist);
+ Fdefine_charset_internal (charset_arg_max, args);
+
+ return XINT (CHARSET_SYMBOL_ID (name));
+}
+
+
+DEFUN ("define-charset-alias", Fdefine_charset_alias,
+ Sdefine_charset_alias, 2, 2, 0,
+ doc: /* Define ALIAS as an alias for charset CHARSET. */)
+ (alias, charset)
+ Lisp_Object alias, charset;
+{
+ Lisp_Object attr;
+
+ CHECK_CHARSET_GET_ATTR (charset, attr);
+ Fputhash (alias, attr, Vcharset_hash_table);
+ Vcharset_list = Fcons (alias, Vcharset_list);
+ return Qnil;
+}
+
+
+DEFUN ("unibyte-charset", Funibyte_charset, Sunibyte_charset, 0, 0, 0,
+ doc: /* Return the unibyte charset (set by `set-unibyte-charset'). */)
+ ()
+{
+ return CHARSET_NAME (CHARSET_FROM_ID (charset_unibyte));
+}
+
+
+DEFUN ("set-unibyte-charset", Fset_unibyte_charset, Sset_unibyte_charset,
+ 1, 1, 0,
+ doc: /* Set the unibyte charset to CHARSET.
+This determines how unibyte/multibyte conversion is done. See also
+function `unibyte-charset'. */)
+ (charset)
+ Lisp_Object charset;
+{
+ struct charset *cs;
+ int i, c;
+
+ CHECK_CHARSET_GET_CHARSET (charset, cs);
+ if (! cs->ascii_compatible_p
+ || cs->dimension != 1)
+ error ("Inappropriate unibyte charset: %s", SDATA (SYMBOL_NAME (charset)));
+ charset_unibyte = cs->id;
+ memset (unibyte_has_multibyte_table, 1, 128);
+ for (i = 128; i < 256; i++)
+ {
+ c = DECODE_CHAR (cs, i);
+ unibyte_to_multibyte_table[i] = (c < 0 ? BYTE8_TO_CHAR (i) : c);
+ unibyte_has_multibyte_table[i] = c >= 0;
+ }
+
+ return Qnil;
+}
+
+
+DEFUN ("charset-plist", Fcharset_plist, Scharset_plist, 1, 1, 0,
+ doc: /* Return the property list of CHARSET. */)
+ (charset)
+ Lisp_Object charset;
+{
+ Lisp_Object attrs;
+
+ CHECK_CHARSET_GET_ATTR (charset, attrs);
+ return CHARSET_ATTR_PLIST (attrs);
+}
+
+
+DEFUN ("set-charset-plist", Fset_charset_plist, Sset_charset_plist, 2, 2, 0,
+ doc: /* Set CHARSET's property list to PLIST. */)
+ (charset, plist)
+ Lisp_Object charset, plist;
+{
+ Lisp_Object attrs;
+
+ CHECK_CHARSET_GET_ATTR (charset, attrs);
+ CHARSET_ATTR_PLIST (attrs) = plist;
+ return plist;
+}
+
+
+DEFUN ("unify-charset", Funify_charset, Sunify_charset, 1, 3, 0,
+ doc: /* Unify characters of CHARSET with Unicode.
+This means reading the relevant file and installing the table defined
+by CHARSET's `:unify-map' property.
+
+Optional second arg UNIFY-MAP is a file name string or a vector. It has
+the same meaning as the `:unify-map' attribute in the function
+`define-charset' (which see).
+
+Optional third argument DEUNIFY, if non-nil, means to de-unify CHARSET. */)
+ (charset, unify_map, deunify)
+ Lisp_Object charset, unify_map, deunify;
+{
+ int id;
+ struct charset *cs;
+
+ CHECK_CHARSET_GET_ID (charset, id);
+ cs = CHARSET_FROM_ID (id);
+ if (CHARSET_METHOD (cs) == CHARSET_METHOD_MAP_DEFERRED)
+ load_charset (cs);
+ if (NILP (deunify)
+ ? CHARSET_UNIFIED_P (cs) && ! NILP (CHARSET_DEUNIFIER (cs))
+ : ! CHARSET_UNIFIED_P (cs))
+ return Qnil;
+
+ CHARSET_UNIFIED_P (cs) = 0;
+ if (NILP (deunify))
+ {
+ if (CHARSET_METHOD (cs) != CHARSET_METHOD_OFFSET)
+ error ("Can't unify charset: %s", SDATA (SYMBOL_NAME (charset)));
+ if (NILP (unify_map))
+ unify_map = CHARSET_UNIFY_MAP (cs);
+ if (STRINGP (unify_map))
+ load_charset_map_from_file (cs, unify_map, 2);
+ else if (VECTORP (unify_map))
+ load_charset_map_from_vector (cs, unify_map, 2);
+ else if (NILP (unify_map))
+ error ("No unify-map for charset");
+ else
+ error ("Bad unify-map arg");
+ CHARSET_UNIFIED_P (cs) = 1;
+ }
+ else if (CHAR_TABLE_P (Vchar_unify_table))
+ {
+ int min_code = CHARSET_MIN_CODE (cs);
+ int max_code = CHARSET_MAX_CODE (cs);
+ int min_char = DECODE_CHAR (cs, min_code);
+ int max_char = DECODE_CHAR (cs, max_code);
+
+ char_table_set_range (Vchar_unify_table, min_char, max_char, Qnil);
+ }
+
+ return Qnil;
+}
+
+DEFUN ("get-unused-iso-final-char", Fget_unused_iso_final_char,
+ Sget_unused_iso_final_char, 2, 2, 0,
+ doc: /*
+Return an unused ISO final char for a charset of DIMENISION and CHARS.
+DIMENSION is the number of bytes to represent a character: 1 or 2.
+CHARS is the number of characters in a dimension: 94 or 96.
+
+This final char is for private use, thus the range is `0' (48) .. `?' (63).
+If there's no unused final char for the specified kind of charset,
+return nil. */)
+ (dimension, chars)
+ Lisp_Object dimension, chars;
+{
+ int final_char;
+
+ CHECK_NUMBER (dimension);
+ CHECK_NUMBER (chars);
+ if (XINT (dimension) != 1 && XINT (dimension) != 2 && XINT (dimension) != 3)
+ args_out_of_range_3 (dimension, make_number (1), make_number (3));
+ if (XINT (chars) != 94 && XINT (chars) != 96)
+ args_out_of_range_3 (chars, make_number (94), make_number (96));
+ for (final_char = '0'; final_char <= '?'; final_char++)
+ if (ISO_CHARSET_TABLE (XINT (dimension), XINT (chars), final_char) < 0)
+ break;
+ return (final_char <= '?' ? make_number (final_char) : Qnil);
+}
+
+static void
+check_iso_charset_parameter (dimension, chars, final_char)
+ Lisp_Object dimension, chars, final_char;
+{
+ CHECK_NATNUM (dimension);
+ CHECK_NATNUM (chars);
+ CHECK_NATNUM (final_char);
+
+ if (XINT (dimension) > 3)
+ error ("Invalid DIMENSION %d, it should be 1, 2, or 3", XINT (dimension));
+ if (XINT (chars) != 94 && XINT (chars) != 96)
+ error ("Invalid CHARS %d, it should be 94 or 96", XINT (chars));
+ if (XINT (final_char) < '0' || XINT (final_char) > '~')
+ error ("Invalid FINAL-CHAR %c, it should be `0'..`~'", XINT (chars));
+}
+
+
+DEFUN ("declare-equiv-charset", Fdeclare_equiv_charset, Sdeclare_equiv_charset,
+ 4, 4, 0,
+ doc: /* Declare an equivalent charset for ISO-2022 decoding.
+
+On decoding by an ISO-2022 base coding system, when a charset
+specified by DIMENSION, CHARS, and FINAL-CHAR is designated, behave as
+if CHARSET is designated instead. */)
+ (dimension, chars, final_char, charset)
+ Lisp_Object dimension, chars, final_char, charset;
+{
+ int id;
+ int chars_flag;
+
+ CHECK_CHARSET_GET_ID (charset, id);
+ check_iso_charset_parameter (dimension, chars, final_char);
+ chars_flag = XINT (chars) == 96;
+ ISO_CHARSET_TABLE (XINT (dimension), chars_flag, XINT (final_char)) = id;
+ return Qnil;
+}
+
+
+/* Return information about charsets in the text at PTR of NBYTES
+ bytes, which are NCHARS characters. The value is:
+
+ 0: Each character is represented by one byte. This is always
+ true for a unibyte string. For a multibyte string, true if
+ it contains only ASCII characters.
+
+ 1: No charsets other than ascii, control-1, and latin-1 are
+ found.
+
+ 2: Otherwise.
+*/
+
+int
+string_xstring_p (string)
+ Lisp_Object string;
+{
+ const unsigned char *p = SDATA (string);
+ const unsigned char *endp = p + SBYTES (string);
+
+ if (SCHARS (string) == SBYTES (string))
+ return 0;
+
+ while (p < endp)
+ {
+ int c = STRING_CHAR_ADVANCE (p);
+
+ if (c >= 0x100)
+ return 2;
+ }
+ return 1;
+}
+
+
+/* Find charsets in the string at PTR of NCHARS and NBYTES.
+
+ CHARSETS is a vector. If Nth element is non-nil, it means the
+ charset whose id is N is already found.
+
+ It may lookup a translation table TABLE if supplied. */
+
+static void
+find_charsets_in_text (ptr, nchars, nbytes, charsets, table, multibyte)
+ const unsigned char *ptr;
+ EMACS_INT nchars, nbytes;
+ Lisp_Object charsets, table;
+ int multibyte;
+{
+ const unsigned char *pend = ptr + nbytes;
+
+ if (nchars == nbytes)
+ {
+ if (multibyte)
+ ASET (charsets, charset_ascii, Qt);
+ else
+ while (ptr < pend)
+ {
+ int c = *ptr++;
+
+ if (!NILP (table))
+ c = translate_char (table, c);
+ if (ASCII_BYTE_P (c))
+ ASET (charsets, charset_ascii, Qt);
+ else
+ ASET (charsets, charset_eight_bit, Qt);
+ }
+ }
+ else
+ {
+ while (ptr < pend)
+ {
+ int c = STRING_CHAR_ADVANCE (ptr);
+ struct charset *charset;
+
+ if (!NILP (table))
+ c = translate_char (table, c);
+ charset = CHAR_CHARSET (c);
+ ASET (charsets, CHARSET_ID (charset), Qt);
+ }
+ }
+}
+
+DEFUN ("find-charset-region", Ffind_charset_region, Sfind_charset_region,
2, 3, 0,
doc: /* Return a list of charsets in the region between BEG and END.
BEG and END are buffer positions.
Optional arg TABLE if non-nil is a translation table to look up.
-If the region contains invalid multibyte characters,
-`unknown' is included in the returned list.
-
If the current buffer is unibyte, the returned list may contain
only `ascii', `eight-bit-control', and `eight-bit-graphic'. */)
(beg, end, table)
Lisp_Object beg, end, table;
{
- int charsets[MAX_CHARSET + 1];
- int from, from_byte, to, stop, stop_byte, i;
+ Lisp_Object charsets;
+ EMACS_INT from, from_byte, to, stop, stop_byte;
+ int i;
Lisp_Object val;
+ int multibyte = ! NILP (current_buffer->enable_multibyte_characters);
validate_region (&beg, &end);
from = XFASTINT (beg);
from_byte = CHAR_TO_BYTE (from);
- bzero (charsets, (MAX_CHARSET + 1) * sizeof (int));
+ charsets = Fmake_vector (make_number (charset_table_used), Qnil);
while (1)
{
- find_charset_in_text (BYTE_POS_ADDR (from_byte), stop - from,
- stop_byte - from_byte, charsets, table);
+ find_charsets_in_text (BYTE_POS_ADDR (from_byte), stop - from,
+ stop_byte - from_byte, charsets, table,
+ multibyte);
if (stop < to)
{
from = stop, from_byte = stop_byte;
}
val = Qnil;
- if (charsets[1])
- val = Fcons (Qunknown, val);
- for (i = MAX_CHARSET; i >= MIN_CHARSET_OFFICIAL_DIMENSION1; i--)
- if (charsets[i])
- val = Fcons (CHARSET_SYMBOL (i), val);
- if (charsets[0])
- val = Fcons (Qascii, val);
+ for (i = charset_table_used - 1; i >= 0; i--)
+ if (!NILP (AREF (charsets, i)))
+ val = Fcons (CHARSET_NAME (charset_table + i), val);
return val;
}
doc: /* Return a list of charsets in STR.
Optional arg TABLE if non-nil is a translation table to look up.
-If the string contains invalid multibyte characters,
-`unknown' is included in the returned list.
-
If STR is unibyte, the returned list may contain
-only `ascii', `eight-bit-control', and `eight-bit-graphic'. */)
+only `ascii', `eight-bit-control', and `eight-bit-graphic'. */)
(str, table)
Lisp_Object str, table;
{
- int charsets[MAX_CHARSET + 1];
+ Lisp_Object charsets;
int i;
Lisp_Object val;
CHECK_STRING (str);
- bzero (charsets, (MAX_CHARSET + 1) * sizeof (int));
- find_charset_in_text (SDATA (str), SCHARS (str),
- SBYTES (str), charsets, table);
-
+ charsets = Fmake_vector (make_number (charset_table_used), Qnil);
+ find_charsets_in_text (SDATA (str), SCHARS (str), SBYTES (str),
+ charsets, table,
+ STRING_MULTIBYTE (str));
val = Qnil;
- if (charsets[1])
- val = Fcons (Qunknown, val);
- for (i = MAX_CHARSET; i >= MIN_CHARSET_OFFICIAL_DIMENSION1; i--)
- if (charsets[i])
- val = Fcons (CHARSET_SYMBOL (i), val);
- if (charsets[0])
- val = Fcons (Qascii, val);
+ for (i = charset_table_used - 1; i >= 0; i--)
+ if (!NILP (AREF (charsets, i)))
+ val = Fcons (CHARSET_NAME (charset_table + i), val);
return val;
}
\f
-DEFUN ("make-char-internal", Fmake_char_internal, Smake_char_internal, 1, 3, 0,
- doc: /* Return a character made from arguments.
-Internal use only. */)
- (charset, code1, code2)
- Lisp_Object charset, code1, code2;
+
+/* Return a character correponding to the code-point CODE of
+ CHARSET. */
+
+int
+decode_char (charset, code)
+ struct charset *charset;
+ unsigned code;
{
- int charset_id, c1, c2;
+ int c, char_index;
+ enum charset_method method = CHARSET_METHOD (charset);
- CHECK_NUMBER (charset);
- charset_id = XINT (charset);
- if (!CHARSET_DEFINED_P (charset_id))
- error ("Invalid charset ID: %d", XINT (charset));
+ if (code < CHARSET_MIN_CODE (charset) || code > CHARSET_MAX_CODE (charset))
+ return -1;
- if (NILP (code1))
- c1 = 0;
- else
+ if (method == CHARSET_METHOD_MAP_DEFERRED)
{
- CHECK_NUMBER (code1);
- c1 = XINT (code1);
- }
- if (NILP (code2))
- c2 = 0;
- else
- {
- CHECK_NUMBER (code2);
- c2 = XINT (code2);
+ load_charset (charset);
+ method = CHARSET_METHOD (charset);
}
- if (charset_id == CHARSET_ASCII)
- {
- if (c1 < 0 || c1 > 0x7F)
- goto invalid_code_posints;
- return make_number (c1);
- }
- else if (charset_id == CHARSET_8_BIT_CONTROL)
+ if (method == CHARSET_METHOD_SUBSET)
{
- if (NILP (code1))
- c1 = 0x80;
- else if (c1 < 0x80 || c1 > 0x9F)
- goto invalid_code_posints;
- return make_number (c1);
+ Lisp_Object subset_info;
+
+ subset_info = CHARSET_SUBSET (charset);
+ charset = CHARSET_FROM_ID (XFASTINT (AREF (subset_info, 0)));
+ code -= XINT (AREF (subset_info, 3));
+ if (code < XFASTINT (AREF (subset_info, 1))
+ || code > XFASTINT (AREF (subset_info, 2)))
+ c = -1;
+ else
+ c = DECODE_CHAR (charset, code);
}
- else if (charset_id == CHARSET_8_BIT_GRAPHIC)
+ else if (method == CHARSET_METHOD_SUPERSET)
{
- if (NILP (code1))
- c1 = 0xA0;
- else if (c1 < 0xA0 || c1 > 0xFF)
- goto invalid_code_posints;
- return make_number (c1);
- }
- else if (c1 < 0 || c1 > 0xFF || c2 < 0 || c2 > 0xFF)
- goto invalid_code_posints;
- c1 &= 0x7F;
- c2 &= 0x7F;
- if (c1 == 0
- ? c2 != 0
- : (c2 == 0
- ? !CHAR_COMPONENTS_VALID_P (charset_id, c1, 0x20)
- : !CHAR_COMPONENTS_VALID_P (charset_id, c1, c2)))
- goto invalid_code_posints;
- return make_number (MAKE_CHAR (charset_id, c1, c2));
-
- invalid_code_posints:
- error ("Invalid code points for charset ID %d: %d %d", charset_id, c1, c2);
-}
+ Lisp_Object parents;
-DEFUN ("split-char", Fsplit_char, Ssplit_char, 1, 1, 0,
- doc: /* Return list of charset and one or two position-codes of CH.
-If CH is invalid as a character code,
-return a list of symbol `unknown' and CH. */)
- (ch)
- Lisp_Object ch;
-{
- int c, charset, c1, c2;
+ parents = CHARSET_SUPERSET (charset);
+ c = -1;
+ for (; CONSP (parents); parents = XCDR (parents))
+ {
+ int id = XINT (XCAR (XCAR (parents)));
+ int code_offset = XINT (XCDR (XCAR (parents)));
+ unsigned this_code = code - code_offset;
- CHECK_NUMBER (ch);
- c = XFASTINT (ch);
- if (!CHAR_VALID_P (c, 1))
- return Fcons (Qunknown, Fcons (ch, Qnil));
- SPLIT_CHAR (XFASTINT (ch), charset, c1, c2);
- return (c2 >= 0
- ? Fcons (CHARSET_SYMBOL (charset),
- Fcons (make_number (c1), Fcons (make_number (c2), Qnil)))
- : Fcons (CHARSET_SYMBOL (charset), Fcons (make_number (c1), Qnil)));
-}
+ charset = CHARSET_FROM_ID (id);
+ if ((c = DECODE_CHAR (charset, this_code)) >= 0)
+ break;
+ }
+ }
+ else
+ {
+ char_index = CODE_POINT_TO_INDEX (charset, code);
+ if (char_index < 0)
+ return -1;
-DEFUN ("char-charset", Fchar_charset, Schar_charset, 1, 1, 0,
- doc: /* Return charset of CH. */)
- (ch)
- Lisp_Object ch;
-{
- CHECK_NUMBER (ch);
+ if (method == CHARSET_METHOD_MAP)
+ {
+ Lisp_Object decoder;
- return CHARSET_SYMBOL (CHAR_CHARSET (XINT (ch)));
-}
+ decoder = CHARSET_DECODER (charset);
+ if (! VECTORP (decoder))
+ return -1;
+ c = XINT (AREF (decoder, char_index));
+ }
+ else
+ {
+ c = char_index + CHARSET_CODE_OFFSET (charset);
+ }
+ }
-DEFUN ("charset-after", Fcharset_after, Scharset_after, 0, 1, 0,
- doc: /* Return charset of a character in the current buffer at position POS.
-If POS is nil, it defauls to the current point.
-If POS is out of range, the value is nil. */)
- (pos)
- Lisp_Object pos;
-{
- Lisp_Object ch;
- int charset;
+ if (CHARSET_UNIFIED_P (charset)
+ && c >= 0)
+ {
+ MAYBE_UNIFY_CHAR (c);
+ }
- ch = Fchar_after (pos);
- if (! INTEGERP (ch))
- return ch;
- charset = CHAR_CHARSET (XINT (ch));
- return CHARSET_SYMBOL (charset);
+ return c;
}
-DEFUN ("iso-charset", Fiso_charset, Siso_charset, 3, 3, 0,
- doc: /* Return charset of ISO's specification DIMENSION, CHARS, and FINAL-CHAR.
-
-ISO 2022's designation sequence (escape sequence) distinguishes charsets
-by their DIMENSION, CHARS, and FINAL-CHAR,
-where as Emacs distinguishes them by charset symbol.
-See the documentation of the function `charset-info' for the meanings of
-DIMENSION, CHARS, and FINAL-CHAR. */)
- (dimension, chars, final_char)
- Lisp_Object dimension, chars, final_char;
-{
- int charset;
-
- CHECK_NUMBER (dimension);
- CHECK_NUMBER (chars);
- CHECK_NUMBER (final_char);
+/* Variable used temporarily by the macro ENCODE_CHAR. */
+Lisp_Object charset_work;
- if ((charset = ISO_CHARSET_TABLE (dimension, chars, final_char)) < 0)
- return Qnil;
- return CHARSET_SYMBOL (charset);
-}
+/* Return a code-point of CHAR in CHARSET. If CHAR doesn't belong to
+ CHARSET, return CHARSET_INVALID_CODE (CHARSET). If STRICT is true,
+ use CHARSET's strict_max_char instead of max_char. */
-/* If GENERICP is nonzero, return nonzero if C is a valid normal or
- generic character. If GENERICP is zero, return nonzero if C is a
- valid normal character. Do not call this function directly,
- instead use macro CHAR_VALID_P. */
-int
-char_valid_p (c, genericp)
- int c, genericp;
+unsigned
+encode_char (charset, c)
+ struct charset *charset;
+ int c;
{
- int charset, c1, c2;
+ unsigned code;
+ enum charset_method method = CHARSET_METHOD (charset);
- if (c < 0 || c >= MAX_CHAR)
- return 0;
- if (SINGLE_BYTE_CHAR_P (c))
- return 1;
- SPLIT_CHAR (c, charset, c1, c2);
- if (genericp)
+ if (CHARSET_UNIFIED_P (charset))
{
- if (c1)
- {
- if (c2 <= 0) c2 = 0x20;
- }
- else
+ Lisp_Object deunifier, deunified;
+
+ deunifier = CHARSET_DEUNIFIER (charset);
+ if (! CHAR_TABLE_P (deunifier))
{
- if (c2 <= 0) c1 = c2 = 0x20;
+ Funify_charset (CHARSET_NAME (charset), Qnil, Qnil);
+ deunifier = CHARSET_DEUNIFIER (charset);
}
+ deunified = CHAR_TABLE_REF (deunifier, c);
+ if (! NILP (deunified))
+ c = XINT (deunified);
}
- return (CHARSET_DEFINED_P (charset)
- && CHAR_COMPONENTS_VALID_P (charset, c1, c2));
-}
-DEFUN ("char-valid-p", Fchar_valid_p, Schar_valid_p, 1, 2, 0,
- doc: /* Return t if OBJECT is a valid normal character.
-If optional arg GENERICP is non-nil, also return t if OBJECT is
-a valid generic character. */)
- (object, genericp)
- Lisp_Object object, genericp;
-{
- if (! NATNUMP (object))
- return Qnil;
- return (CHAR_VALID_P (XFASTINT (object), !NILP (genericp)) ? Qt : Qnil);
-}
+ if (method == CHARSET_METHOD_SUBSET)
+ {
+ Lisp_Object subset_info;
+ struct charset *this_charset;
+
+ subset_info = CHARSET_SUBSET (charset);
+ this_charset = CHARSET_FROM_ID (XFASTINT (AREF (subset_info, 0)));
+ code = ENCODE_CHAR (this_charset, c);
+ if (code == CHARSET_INVALID_CODE (this_charset)
+ || code < XFASTINT (AREF (subset_info, 1))
+ || code > XFASTINT (AREF (subset_info, 2)))
+ return CHARSET_INVALID_CODE (charset);
+ code += XINT (AREF (subset_info, 3));
+ return code;
+ }
-DEFUN ("unibyte-char-to-multibyte", Funibyte_char_to_multibyte,
- Sunibyte_char_to_multibyte, 1, 1, 0,
- doc: /* Convert the unibyte character CH to multibyte character.
-The conversion is done based on `nonascii-translation-table' (which see)
- or `nonascii-insert-offset' (which see). */)
- (ch)
- Lisp_Object ch;
-{
- int c;
+ if (method == CHARSET_METHOD_SUPERSET)
+ {
+ Lisp_Object parents;
- CHECK_NUMBER (ch);
- c = XINT (ch);
- if (c < 0 || c >= 0400)
- error ("Invalid unibyte character: %d", c);
- c = unibyte_char_to_multibyte (c);
- if (c < 0)
- error ("Can't convert to multibyte character: %d", XINT (ch));
- return make_number (c);
-}
+ parents = CHARSET_SUPERSET (charset);
+ for (; CONSP (parents); parents = XCDR (parents))
+ {
+ int id = XINT (XCAR (XCAR (parents)));
+ int code_offset = XINT (XCDR (XCAR (parents)));
+ struct charset *this_charset = CHARSET_FROM_ID (id);
-DEFUN ("multibyte-char-to-unibyte", Fmultibyte_char_to_unibyte,
- Smultibyte_char_to_unibyte, 1, 1, 0,
- doc: /* Convert the multibyte character CH to unibyte character.
-The conversion is done based on `nonascii-translation-table' (which see)
- or `nonascii-insert-offset' (which see). */)
- (ch)
- Lisp_Object ch;
-{
- int c;
+ code = ENCODE_CHAR (this_charset, c);
+ if (code != CHARSET_INVALID_CODE (this_charset))
+ return code + code_offset;
+ }
+ return CHARSET_INVALID_CODE (charset);
+ }
- CHECK_NUMBER (ch);
- c = XINT (ch);
- if (! CHAR_VALID_P (c, 0))
- error ("Invalid multibyte character: %d", c);
- c = multibyte_char_to_unibyte (c, Qnil);
- if (c < 0)
- error ("Can't convert to unibyte character: %d", XINT (ch));
- return make_number (c);
-}
+ if (! CHARSET_FAST_MAP_REF ((c), charset->fast_map)
+ || c < CHARSET_MIN_CHAR (charset) || c > CHARSET_MAX_CHAR (charset))
+ return CHARSET_INVALID_CODE (charset);
-DEFUN ("char-bytes", Fchar_bytes, Schar_bytes, 1, 1, 0,
- doc: /* Return 1 regardless of the argument CH. */)
- (ch)
- Lisp_Object ch;
-{
- CHECK_NUMBER (ch);
- return make_number (1);
-}
+ if (method == CHARSET_METHOD_MAP_DEFERRED)
+ {
+ load_charset (charset);
+ method = CHARSET_METHOD (charset);
+ }
-/* Return how many bytes C will occupy in a multibyte buffer.
- Don't call this function directly, instead use macro CHAR_BYTES. */
-int
-char_bytes (c)
- int c;
-{
- int charset;
+ if (method == CHARSET_METHOD_MAP)
+ {
+ Lisp_Object encoder;
+ Lisp_Object val;
- if (ASCII_BYTE_P (c) || (c & ~((1 << CHARACTERBITS) -1)))
- return 1;
- if (SINGLE_BYTE_CHAR_P (c) && c >= 0xA0)
- return 1;
+ encoder = CHARSET_ENCODER (charset);
+ if (! CHAR_TABLE_P (CHARSET_ENCODER (charset)))
+ return CHARSET_INVALID_CODE (charset);
+ val = CHAR_TABLE_REF (encoder, c);
+ if (NILP (val))
+ return CHARSET_INVALID_CODE (charset);
+ code = XINT (val);
+ if (! CHARSET_COMPACT_CODES_P (charset))
+ code = INDEX_TO_CODE_POINT (charset, code);
+ }
+ else /* method == CHARSET_METHOD_OFFSET */
+ {
+ code = c - CHARSET_CODE_OFFSET (charset);
+ code = INDEX_TO_CODE_POINT (charset, code);
+ }
- charset = CHAR_CHARSET (c);
- return (CHARSET_DEFINED_P (charset) ? CHARSET_BYTES (charset) : 1);
+ return code;
}
-/* Return the width of character of which multi-byte form starts with
- C. The width is measured by how many columns occupied on the
- screen when displayed in the current buffer. */
-
-#define ONE_BYTE_CHAR_WIDTH(c) \
- (c < 0x20 \
- ? (c == '\t' \
- ? XFASTINT (current_buffer->tab_width) \
- : (c == '\n' ? 0 : (NILP (current_buffer->ctl_arrow) ? 4 : 2))) \
- : (c < 0x7f \
- ? 1 \
- : (c == 0x7F \
- ? (NILP (current_buffer->ctl_arrow) ? 4 : 2) \
- : ((! NILP (current_buffer->enable_multibyte_characters) \
- && BASE_LEADING_CODE_P (c)) \
- ? WIDTH_BY_CHAR_HEAD (c) \
- : 4))))
-
-DEFUN ("char-width", Fchar_width, Schar_width, 1, 1, 0,
- doc: /* Return width of CH when displayed in the current buffer.
-The width is measured by how many columns it occupies on the screen.
-Tab is taken to occupy `tab-width' columns. */)
- (ch)
- Lisp_Object ch;
-{
- Lisp_Object val, disp;
- int c;
- struct Lisp_Char_Table *dp = buffer_display_table ();
- CHECK_NUMBER (ch);
+DEFUN ("decode-char", Fdecode_char, Sdecode_char, 2, 3, 0,
+ doc: /* Decode the pair of CHARSET and CODE-POINT into a character.
+Return nil if CODE-POINT is not valid in CHARSET.
- c = XINT (ch);
+CODE-POINT may be a cons (HIGHER-16-BIT-VALUE . LOWER-16-BIT-VALUE).
- /* Get the way the display table would display it. */
- disp = dp ? DISP_CHAR_VECTOR (dp, c) : Qnil;
+Optional argument RESTRICTION specifies a way to map the pair of CCS
+and CODE-POINT to a chracter. Currently not supported and just ignored. */)
+ (charset, code_point, restriction)
+ Lisp_Object charset, code_point, restriction;
+{
+ int c, id;
+ unsigned code;
+ struct charset *charsetp;
- if (VECTORP (disp))
- XSETINT (val, XVECTOR (disp)->size);
- else if (SINGLE_BYTE_CHAR_P (c))
- XSETINT (val, ONE_BYTE_CHAR_WIDTH (c));
+ CHECK_CHARSET_GET_ID (charset, id);
+ if (CONSP (code_point))
+ {
+ CHECK_NATNUM_CAR (code_point);
+ CHECK_NATNUM_CDR (code_point);
+ code = (XINT (XCAR (code_point)) << 16) | (XINT (XCDR (code_point)));
+ }
else
{
- int charset = CHAR_CHARSET (c);
-
- XSETFASTINT (val, CHARSET_WIDTH (charset));
+ CHECK_NATNUM (code_point);
+ code = XINT (code_point);
}
- return val;
+ charsetp = CHARSET_FROM_ID (id);
+ c = DECODE_CHAR (charsetp, code);
+ return (c >= 0 ? make_number (c) : Qnil);
}
-/* Return width of string STR of length LEN when displayed in the
- current buffer. The width is measured by how many columns it
- occupies on the screen. */
-int
-strwidth (str, len)
- unsigned char *str;
- int len;
+DEFUN ("encode-char", Fencode_char, Sencode_char, 2, 3, 0,
+ doc: /* Encode the character CH into a code-point of CHARSET.
+Return nil if CHARSET doesn't include CH.
+
+Optional argument RESTRICTION specifies a way to map CHAR to a
+code-point in CCS. Currently not supported and just ignored. */)
+ (ch, charset, restriction)
+ Lisp_Object ch, charset, restriction;
{
- return c_string_width (str, len, -1, NULL, NULL);
+ int id;
+ unsigned code;
+ struct charset *charsetp;
+
+ CHECK_CHARSET_GET_ID (charset, id);
+ CHECK_NATNUM (ch);
+ charsetp = CHARSET_FROM_ID (id);
+ code = ENCODE_CHAR (charsetp, XINT (ch));
+ if (code == CHARSET_INVALID_CODE (charsetp))
+ return Qnil;
+ if (code > 0x7FFFFFF)
+ return Fcons (make_number (code >> 16), make_number (code & 0xFFFF));
+ return make_number (code);
}
-/* Return width of string STR of length LEN when displayed in the
- current buffer. The width is measured by how many columns it
- occupies on the screen. If PRECISION > 0, return the width of
- longest substring that doesn't exceed PRECISION, and set number of
- characters and bytes of the substring in *NCHARS and *NBYTES
- respectively. */
-int
-c_string_width (str, len, precision, nchars, nbytes)
- const unsigned char *str;
- int len, precision, *nchars, *nbytes;
+DEFUN ("make-char", Fmake_char, Smake_char, 1, 5, 0,
+ doc:
+ /* Return a character of CHARSET whose position codes are CODEn.
+
+CODE1 through CODE4 are optional, but if you don't supply sufficient
+position codes, it is assumed that the minimum code in each dimension
+is specified. */)
+ (charset, code1, code2, code3, code4)
+ Lisp_Object charset, code1, code2, code3, code4;
{
- int i = 0, i_byte = 0;
- int width = 0;
- int chars;
- struct Lisp_Char_Table *dp = buffer_display_table ();
+ int id, dimension;
+ struct charset *charsetp;
+ unsigned code;
+ int c;
- while (i_byte < len)
+ CHECK_CHARSET_GET_ID (charset, id);
+ charsetp = CHARSET_FROM_ID (id);
+
+ dimension = CHARSET_DIMENSION (charsetp);
+ if (NILP (code1))
+ code = (CHARSET_ASCII_COMPATIBLE_P (charsetp)
+ ? 0 : CHARSET_MIN_CODE (charsetp));
+ else
{
- int bytes, thiswidth;
- Lisp_Object val;
+ CHECK_NATNUM (code1);
+ if (XFASTINT (code1) >= 0x100)
+ args_out_of_range (make_number (0xFF), code1);
+ code = XFASTINT (code1);
- if (dp)
+ if (dimension > 1)
{
- int c = STRING_CHAR_AND_LENGTH (str + i_byte, len - i_byte, bytes);
-
- chars = 1;
- val = DISP_CHAR_VECTOR (dp, c);
- if (VECTORP (val))
- thiswidth = XVECTOR (val)->size;
+ code <<= 8;
+ if (NILP (code2))
+ code |= charsetp->code_space[(dimension - 2) * 4];
else
- thiswidth = ONE_BYTE_CHAR_WIDTH (str[i_byte]);
- }
- else
- {
- chars = 1;
- PARSE_MULTIBYTE_SEQ (str + i_byte, len - i_byte, bytes);
- thiswidth = ONE_BYTE_CHAR_WIDTH (str[i_byte]);
- }
+ {
+ CHECK_NATNUM (code2);
+ if (XFASTINT (code2) >= 0x100)
+ args_out_of_range (make_number (0xFF), code2);
+ code |= XFASTINT (code2);
+ }
- if (precision > 0
- && (width + thiswidth > precision))
- {
- *nchars = i;
- *nbytes = i_byte;
- return width;
+ if (dimension > 2)
+ {
+ code <<= 8;
+ if (NILP (code3))
+ code |= charsetp->code_space[(dimension - 3) * 4];
+ else
+ {
+ CHECK_NATNUM (code3);
+ if (XFASTINT (code3) >= 0x100)
+ args_out_of_range (make_number (0xFF), code3);
+ code |= XFASTINT (code3);
+ }
+
+ if (dimension > 3)
+ {
+ code <<= 8;
+ if (NILP (code4))
+ code |= charsetp->code_space[0];
+ else
+ {
+ CHECK_NATNUM (code4);
+ if (XFASTINT (code4) >= 0x100)
+ args_out_of_range (make_number (0xFF), code4);
+ code |= XFASTINT (code4);
+ }
+ }
+ }
}
- i++;
- i_byte += bytes;
- width += thiswidth;
- }
-
- if (precision > 0)
- {
- *nchars = i;
- *nbytes = i_byte;
}
- return width;
+ if (CHARSET_ISO_FINAL (charsetp) >= 0)
+ code &= 0x7F7F7F7F;
+ c = DECODE_CHAR (charsetp, code);
+ if (c < 0)
+ error ("Invalid code(s)");
+ return make_number (c);
}
-/* Return width of Lisp string STRING when displayed in the current
- buffer. The width is measured by how many columns it occupies on
- the screen while paying attention to compositions. If PRECISION >
- 0, return the width of longest substring that doesn't exceed
- PRECISION, and set number of characters and bytes of the substring
- in *NCHARS and *NBYTES respectively. */
-int
-lisp_string_width (string, precision, nchars, nbytes)
- Lisp_Object string;
- int precision, *nchars, *nbytes;
-{
- int len = SCHARS (string);
- int len_byte = SBYTES (string);
- /* This set multibyte to 0 even if STRING is multibyte when it
- contains only ascii and eight-bit-graphic, but that's
- intentional. */
- int multibyte = len < len_byte;
- const unsigned char *str = SDATA (string);
- int i = 0, i_byte = 0;
- int width = 0;
- struct Lisp_Char_Table *dp = buffer_display_table ();
-
- while (i < len)
- {
- int chars, bytes, thiswidth;
- Lisp_Object val;
- int cmp_id;
- int ignore, end;
+/* Return the first charset in CHARSET_LIST that contains C.
+ CHARSET_LIST is a list of charset IDs. If it is nil, use
+ Vcharset_ordered_list. */
- if (find_composition (i, -1, &ignore, &end, &val, string)
- && ((cmp_id = get_composition_id (i, i_byte, end - i, val, string))
- >= 0))
- {
- thiswidth = composition_table[cmp_id]->width;
- chars = end - i;
- bytes = string_char_to_byte (string, end) - i_byte;
- }
- else if (dp)
- {
- int c;
+struct charset *
+char_charset (c, charset_list, code_return)
+ int c;
+ Lisp_Object charset_list;
+ unsigned *code_return;
+{
+ if (NILP (charset_list))
+ charset_list = Vcharset_ordered_list;
- if (multibyte)
- c = STRING_CHAR_AND_LENGTH (str + i_byte, len - i_byte, bytes);
- else
- c = str[i_byte], bytes = 1;
- chars = 1;
- val = DISP_CHAR_VECTOR (dp, c);
- if (VECTORP (val))
- thiswidth = XVECTOR (val)->size;
- else
- thiswidth = ONE_BYTE_CHAR_WIDTH (str[i_byte]);
- }
- else
- {
- chars = 1;
- if (multibyte)
- PARSE_MULTIBYTE_SEQ (str + i_byte, len_byte - i_byte, bytes);
- else
- bytes = 1;
- thiswidth = ONE_BYTE_CHAR_WIDTH (str[i_byte]);
- }
+ while (CONSP (charset_list))
+ {
+ struct charset *charset = CHARSET_FROM_ID (XINT (XCAR (charset_list)));
+ unsigned code = ENCODE_CHAR (charset, c);
- if (precision > 0
- && (width + thiswidth > precision))
+ if (code != CHARSET_INVALID_CODE (charset))
{
- *nchars = i;
- *nbytes = i_byte;
- return width;
+ if (code_return)
+ *code_return = code;
+ return charset;
}
- i += chars;
- i_byte += bytes;
- width += thiswidth;
- }
-
- if (precision > 0)
- {
- *nchars = i;
- *nbytes = i_byte;
+ charset_list = XCDR (charset_list);
}
-
- return width;
+ return NULL;
}
-DEFUN ("string-width", Fstring_width, Sstring_width, 1, 1, 0,
- doc: /* Return width of STRING when displayed in the current buffer.
-Width is measured by how many columns it occupies on the screen.
-When calculating width of a multibyte character in STRING,
-only the base leading-code is considered; the validity of
-the following bytes is not checked. Tabs in STRING are always
-taken to occupy `tab-width' columns. */)
- (string)
- Lisp_Object string;
-{
- Lisp_Object val;
-
- CHECK_STRING (string);
- XSETFASTINT (val, lisp_string_width (string, -1, NULL, NULL));
- return val;
-}
-DEFUN ("char-direction", Fchar_direction, Schar_direction, 1, 1, 0,
- doc: /* Return the direction of CH.
-The returned value is 0 for left-to-right and 1 for right-to-left. */)
+DEFUN ("split-char", Fsplit_char, Ssplit_char, 1, 1, 0,
+ doc:
+ /*Return list of charset and one to four position-codes of CHAR.
+The charset is decided by the current priority order of charsets.
+A position-code is a byte value of each dimension of the code-point of
+CHAR in the charset. */)
(ch)
Lisp_Object ch;
{
- int charset;
+ struct charset *charset;
+ int c, dimension;
+ unsigned code;
+ Lisp_Object val;
- CHECK_NUMBER (ch);
- charset = CHAR_CHARSET (XFASTINT (ch));
- if (!CHARSET_DEFINED_P (charset))
- invalid_character (XINT (ch));
- return CHARSET_TABLE_INFO (charset, CHARSET_DIRECTION_IDX);
+ CHECK_CHARACTER (ch);
+ c = XFASTINT (ch);
+ charset = CHAR_CHARSET (c);
+ if (! charset)
+ abort ();
+ code = ENCODE_CHAR (charset, c);
+ if (code == CHARSET_INVALID_CODE (charset))
+ abort ();
+ dimension = CHARSET_DIMENSION (charset);
+ for (val = Qnil; dimension > 0; dimension--)
+ {
+ val = Fcons (make_number (code & 0xFF), val);
+ code >>= 8;
+ }
+ return Fcons (CHARSET_NAME (charset), val);
}
-/* Return the number of characters in the NBYTES bytes at PTR.
- This works by looking at the contents and checking for multibyte sequences.
- However, if the current buffer has enable-multibyte-characters = nil,
- we treat each byte as a character. */
-int
-chars_in_text (ptr, nbytes)
- const unsigned char *ptr;
- int nbytes;
+DEFUN ("char-charset", Fchar_charset, Schar_charset, 1, 1, 0,
+ doc: /* Return the charset of highest priority that contains CH. */)
+ (ch)
+ Lisp_Object ch;
{
- /* current_buffer is null at early stages of Emacs initialization. */
- if (current_buffer == 0
- || NILP (current_buffer->enable_multibyte_characters))
- return nbytes;
+ struct charset *charset;
- return multibyte_chars_in_text (ptr, nbytes);
+ CHECK_CHARACTER (ch);
+ charset = CHAR_CHARSET (XINT (ch));
+ return (CHARSET_NAME (charset));
}
-/* Return the number of characters in the NBYTES bytes at PTR.
- This works by looking at the contents and checking for multibyte sequences.
- It ignores enable-multibyte-characters. */
-int
-multibyte_chars_in_text (ptr, nbytes)
- const unsigned char *ptr;
- int nbytes;
+DEFUN ("charset-after", Fcharset_after, Scharset_after, 0, 1, 0,
+ doc: /*
+Return charset of a character in the current buffer at position POS.
+If POS is nil, it defauls to the current point.
+If POS is out of range, the value is nil. */)
+ (pos)
+ Lisp_Object pos;
{
- const unsigned char *endp;
- int chars, bytes;
+ Lisp_Object ch;
+ struct charset *charset;
- endp = ptr + nbytes;
- chars = 0;
+ ch = Fchar_after (pos);
+ if (! INTEGERP (ch))
+ return ch;
+ charset = CHAR_CHARSET (XINT (ch));
+ return (CHARSET_NAME (charset));
+}
- while (ptr < endp)
- {
- PARSE_MULTIBYTE_SEQ (ptr, endp - ptr, bytes);
- ptr += bytes;
- chars++;
- }
- return chars;
-}
+DEFUN ("iso-charset", Fiso_charset, Siso_charset, 3, 3, 0,
+ doc: /*
+Return charset of ISO's specification DIMENSION, CHARS, and FINAL-CHAR.
-/* Parse unibyte text at STR of LEN bytes as multibyte text, and
- count the numbers of characters and bytes in it. On counting
- bytes, pay attention to the fact that 8-bit characters in the range
- 0x80..0x9F are represented by 2 bytes in multibyte text. */
-void
-parse_str_as_multibyte (str, len, nchars, nbytes)
- const unsigned char *str;
- int len, *nchars, *nbytes;
+ISO 2022's designation sequence (escape sequence) distinguishes charsets
+by their DIMENSION, CHARS, and FINAL-CHAR,
+where as Emacs distinguishes them by charset symbol.
+See the documentation of the function `charset-info' for the meanings of
+DIMENSION, CHARS, and FINAL-CHAR. */)
+ (dimension, chars, final_char)
+ Lisp_Object dimension, chars, final_char;
{
- const unsigned char *endp = str + len;
- int n, chars = 0, bytes = 0;
-
- while (str < endp)
- {
- if (UNIBYTE_STR_AS_MULTIBYTE_P (str, endp - str, n))
- str += n, bytes += n;
- else
- str++, bytes += 2;
- chars++;
- }
- *nchars = chars;
- *nbytes = bytes;
- return;
+ int id;
+ int chars_flag;
+
+ check_iso_charset_parameter (dimension, chars, final_char);
+ chars_flag = XFASTINT (chars) == 96;
+ id = ISO_CHARSET_TABLE (XFASTINT (dimension), chars_flag,
+ XFASTINT (final_char));
+ return (id >= 0 ? CHARSET_NAME (CHARSET_FROM_ID (id)) : Qnil);
}
-/* Arrange unibyte text at STR of NBYTES bytes as multibyte text.
- It actually converts only 8-bit characters in the range 0x80..0x9F
- that don't contruct multibyte characters to multibyte forms. If
- NCHARS is nonzero, set *NCHARS to the number of characters in the
- text. It is assured that we can use LEN bytes at STR as a work
- area and that is enough. Return the number of bytes of the
- resulting text. */
-int
-str_as_multibyte (str, len, nbytes, nchars)
- unsigned char *str;
- int len, nbytes, *nchars;
+DEFUN ("clear-charset-maps", Fclear_charset_maps, Sclear_charset_maps,
+ 0, 0, 0,
+ doc: /*
+Clear encoder and decoder of charsets that are loaded from mapfiles. */)
+ ()
{
- unsigned char *p = str, *endp = str + nbytes;
- unsigned char *to;
- int chars = 0;
- int n;
-
- while (p < endp && UNIBYTE_STR_AS_MULTIBYTE_P (p, endp - p, n))
- p += n, chars++;
- if (nchars)
- *nchars = chars;
- if (p == endp)
- return nbytes;
-
- to = p;
- nbytes = endp - p;
- endp = str + len;
- safe_bcopy (p, endp - nbytes, nbytes);
- p = endp - nbytes;
- while (p < endp)
+ int i;
+ struct charset *charset;
+ Lisp_Object attrs;
+
+ for (i = 0; i < charset_table_used; i++)
{
- if (UNIBYTE_STR_AS_MULTIBYTE_P (p, endp - p, n))
- {
- while (n--)
- *to++ = *p++;
- }
- else
+ charset = CHARSET_FROM_ID (i);
+ attrs = CHARSET_ATTRIBUTES (charset);
+
+ if (CHARSET_METHOD (charset) == CHARSET_METHOD_MAP)
{
- *to++ = LEADING_CODE_8_BIT_CONTROL;
- *to++ = *p++ + 0x20;
+ CHARSET_ATTR_DECODER (attrs) = Qnil;
+ CHARSET_ATTR_ENCODER (attrs) = Qnil;
+ CHARSET_METHOD (charset) = CHARSET_METHOD_MAP_DEFERRED;
}
- chars++;
- }
- if (nchars)
- *nchars = chars;
- return (to - str);
-}
-
-/* Parse unibyte string at STR of LEN bytes, and return the number of
- bytes it may ocupy when converted to multibyte string by
- `str_to_multibyte'. */
-
-int
-parse_str_to_multibyte (str, len)
- unsigned char *str;
- int len;
-{
- unsigned char *endp = str + len;
- int bytes;
-
- for (bytes = 0; str < endp; str++)
- bytes += (*str < 0x80 || *str >= 0xA0) ? 1 : 2;
- return bytes;
-}
-/* Convert unibyte text at STR of NBYTES bytes to multibyte text
- that contains the same single-byte characters. It actually
- converts all 8-bit characters to multibyte forms. It is assured
- that we can use LEN bytes at STR as a work area and that is
- enough. */
+ if (CHARSET_UNIFIED_P (charset))
+ CHARSET_ATTR_DEUNIFIER (attrs) = Qnil;
+ }
-int
-str_to_multibyte (str, len, bytes)
- unsigned char *str;
- int len, bytes;
-{
- unsigned char *p = str, *endp = str + bytes;
- unsigned char *to;
-
- while (p < endp && (*p < 0x80 || *p >= 0xA0)) p++;
- if (p == endp)
- return bytes;
- to = p;
- bytes = endp - p;
- endp = str + len;
- safe_bcopy (p, endp - bytes, bytes);
- p = endp - bytes;
- while (p < endp)
+ if (CHAR_TABLE_P (Vchar_unified_charset_table))
{
- if (*p < 0x80 || *p >= 0xA0)
- *to++ = *p++;
- else
- *to++ = LEADING_CODE_8_BIT_CONTROL, *to++ = *p++ + 0x20;
+ Foptimize_char_table (Vchar_unified_charset_table);
+ Vchar_unify_table = Vchar_unified_charset_table;
+ Vchar_unified_charset_table = Qnil;
}
- return (to - str);
-}
-/* Arrange multibyte text at STR of LEN bytes as a unibyte text. It
- actually converts only 8-bit characters in the range 0x80..0x9F to
- unibyte forms. */
+ return Qnil;
+}
-int
-str_as_unibyte (str, bytes)
- unsigned char *str;
- int bytes;
+DEFUN ("charset-priority-list", Fcharset_priority_list,
+ Scharset_priority_list, 0, 1, 0,
+ doc: /* Return the list of charsets ordered by priority.
+HIGHESTP non-nil means just return the highest priority one. */)
+ (highestp)
+ Lisp_Object highestp;
{
- unsigned char *p = str, *endp = str + bytes;
- unsigned char *to = str;
+ Lisp_Object val = Qnil, list = Vcharset_ordered_list;
- while (p < endp && *p != LEADING_CODE_8_BIT_CONTROL) p++;
- to = p;
- while (p < endp)
+ if (!NILP (highestp))
+ return CHARSET_NAME (CHARSET_FROM_ID (XINT (Fcar (list))));
+
+ while (!NILP (list))
{
- if (*p == LEADING_CODE_8_BIT_CONTROL)
- *to++ = *(p + 1) - 0x20, p += 2;
- else
- *to++ = *p++;
+ val = Fcons (CHARSET_NAME (CHARSET_FROM_ID (XINT (XCAR (list)))), val);
+ list = XCDR (list);
}
- return (to - str);
+ return Fnreverse (val);
}
-\f
-DEFUN ("string", Fstring, Sstring, 0, MANY, 0,
- doc: /* Concatenate all the argument characters and make the result a string.
-usage: (string &rest CHARACTERS) */)
- (n, args)
- int n;
+DEFUN ("set-charset-priority", Fset_charset_priority, Sset_charset_priority,
+ 1, MANY, 0,
+ doc: /* Assign higher priority to the charsets given as arguments.
+usage: (set-charset-priority &rest charsets) */)
+ (nargs, args)
+ int nargs;
Lisp_Object *args;
{
- int i, bufsize;
- unsigned char *buf, *p;
- int c;
- int multibyte = 0;
- Lisp_Object ret;
- USE_SAFE_ALLOCA;
-
- bufsize = MAX_MULTIBYTE_LENGTH * n;
- SAFE_ALLOCA (buf, unsigned char *, bufsize);
- p = buf;
+ Lisp_Object new_head, old_list, arglist[2];
+ Lisp_Object list_2022, list_emacs_mule;
+ int i, id;
- for (i = 0; i < n; i++)
+ old_list = Fcopy_sequence (Vcharset_ordered_list);
+ new_head = Qnil;
+ for (i = 0; i < nargs; i++)
{
- CHECK_NUMBER (args[i]);
- if (!multibyte && !SINGLE_BYTE_CHAR_P (XFASTINT (args[i])))
- multibyte = 1;
+ CHECK_CHARSET_GET_ID (args[i], id);
+ if (! NILP (Fmemq (make_number (id), old_list)))
+ {
+ old_list = Fdelq (make_number (id), old_list);
+ new_head = Fcons (make_number (id), new_head);
+ }
}
+ arglist[0] = Fnreverse (new_head);
+ arglist[1] = old_list;
+ Vcharset_ordered_list = Fnconc (2, arglist);
+ charset_ordered_list_tick++;
- for (i = 0; i < n; i++)
+ for (old_list = Vcharset_ordered_list, list_2022 = list_emacs_mule = Qnil;
+ CONSP (old_list); old_list = XCDR (old_list))
{
- c = XINT (args[i]);
- if (multibyte)
- p += CHAR_STRING (c, p);
- else
- *p++ = c;
+ if (! NILP (Fmemq (XCAR (old_list), Viso_2022_charset_list)))
+ list_2022 = Fcons (XCAR (old_list), list_2022);
+ if (! NILP (Fmemq (XCAR (old_list), Vemacs_mule_charset_list)))
+ list_emacs_mule = Fcons (XCAR (old_list), list_emacs_mule);
}
+ Viso_2022_charset_list = Fnreverse (list_2022);
+ Vemacs_mule_charset_list = Fnreverse (list_emacs_mule);
- ret = make_string_from_bytes (buf, n, p - buf);
- SAFE_FREE ();
-
- return ret;
+ return Qnil;
}
-#endif /* emacs */
-\f
-int
-charset_id_internal (charset_name)
- char *charset_name;
+DEFUN ("charset-id-internal", Fcharset_id_internal, Scharset_id_internal,
+ 0, 1, 0,
+ doc: /* Internal use only.
+Return charset identification number of CHARSET. */)
+ (charset)
+ Lisp_Object charset;
{
- Lisp_Object val;
-
- val= Fget (intern (charset_name), Qcharset);
- if (!VECTORP (val))
- error ("Charset %s is not defined", charset_name);
+ int id;
- return (XINT (XVECTOR (val)->contents[0]));
+ CHECK_CHARSET_GET_ID (charset, id);
+ return make_number (id);
}
-DEFUN ("setup-special-charsets", Fsetup_special_charsets,
- Ssetup_special_charsets, 0, 0, 0, doc: /* Internal use only. */)
- ()
+\f
+void
+init_charset ()
{
- charset_latin_iso8859_1 = charset_id_internal ("latin-iso8859-1");
- charset_jisx0208_1978 = charset_id_internal ("japanese-jisx0208-1978");
- charset_jisx0208 = charset_id_internal ("japanese-jisx0208");
- charset_katakana_jisx0201 = charset_id_internal ("katakana-jisx0201");
- charset_latin_jisx0201 = charset_id_internal ("latin-jisx0201");
- charset_big5_1 = charset_id_internal ("chinese-big5-1");
- charset_big5_2 = charset_id_internal ("chinese-big5-2");
- charset_mule_unicode_0100_24ff
- = charset_id_internal ("mule-unicode-0100-24ff");
- charset_mule_unicode_2500_33ff
- = charset_id_internal ("mule-unicode-2500-33ff");
- charset_mule_unicode_e000_ffff
- = charset_id_internal ("mule-unicode-e000-ffff");
- return Qnil;
+ Vcharset_map_path
+ = Fcons (Fexpand_file_name (build_string ("charsets"), Vdata_directory),
+ Qnil);
}
+
void
init_charset_once ()
{
int i, j, k;
- staticpro (&Vcharset_table);
- staticpro (&Vcharset_symbol_table);
- staticpro (&Vgeneric_character_list);
-
- /* This has to be done here, before we call Fmake_char_table. */
- Qcharset_table = intern ("charset-table");
- staticpro (&Qcharset_table);
-
- /* Intern this now in case it isn't already done.
- Setting this variable twice is harmless.
- But don't staticpro it here--that is done in alloc.c. */
- Qchar_table_extra_slots = intern ("char-table-extra-slots");
-
- /* Now we are ready to set up this property, so we can
- create the charset table. */
- Fput (Qcharset_table, Qchar_table_extra_slots, make_number (0));
- Vcharset_table = Fmake_char_table (Qcharset_table, Qnil);
-
- Qunknown = intern ("unknown");
- staticpro (&Qunknown);
- Vcharset_symbol_table = Fmake_vector (make_number (MAX_CHARSET + 1),
- Qunknown);
-
- /* Setup tables. */
- for (i = 0; i < 2; i++)
- for (j = 0; j < 2; j++)
- for (k = 0; k < 128; k++)
- iso_charset_table [i][j][k] = -1;
+ for (i = 0; i < ISO_MAX_DIMENSION; i++)
+ for (j = 0; j < ISO_MAX_CHARS; j++)
+ for (k = 0; k < ISO_MAX_FINAL; k++)
+ iso_charset_table[i][j][k] = -1;
for (i = 0; i < 256; i++)
- bytes_by_char_head[i] = 1;
- bytes_by_char_head[LEADING_CODE_PRIVATE_11] = 3;
- bytes_by_char_head[LEADING_CODE_PRIVATE_12] = 3;
- bytes_by_char_head[LEADING_CODE_PRIVATE_21] = 4;
- bytes_by_char_head[LEADING_CODE_PRIVATE_22] = 4;
+ emacs_mule_charset[i] = NULL;
+
+ charset_jisx0201_roman = -1;
+ charset_jisx0208_1978 = -1;
+ charset_jisx0208 = -1;
for (i = 0; i < 128; i++)
- width_by_char_head[i] = 1;
+ unibyte_to_multibyte_table[i] = i;
for (; i < 256; i++)
- width_by_char_head[i] = 4;
- width_by_char_head[LEADING_CODE_PRIVATE_11] = 1;
- width_by_char_head[LEADING_CODE_PRIVATE_12] = 2;
- width_by_char_head[LEADING_CODE_PRIVATE_21] = 1;
- width_by_char_head[LEADING_CODE_PRIVATE_22] = 2;
-
- {
- Lisp_Object val;
-
- val = Qnil;
- for (i = 0x81; i < 0x90; i++)
- val = Fcons (make_number ((i - 0x70) << 7), val);
- for (; i < 0x9A; i++)
- val = Fcons (make_number ((i - 0x8F) << 14), val);
- for (i = 0xA0; i < 0xF0; i++)
- val = Fcons (make_number ((i - 0x70) << 7), val);
- for (; i < 0xFF; i++)
- val = Fcons (make_number ((i - 0xE0) << 14), val);
- Vgeneric_character_list = Fnreverse (val);
- }
-
- nonascii_insert_offset = 0;
- Vnonascii_translation_table = Qnil;
+ unibyte_to_multibyte_table[i] = BYTE8_TO_CHAR (i);
}
#ifdef emacs
void
syms_of_charset ()
{
- Qcharset = intern ("charset");
- staticpro (&Qcharset);
-
- Qascii = intern ("ascii");
- staticpro (&Qascii);
-
- Qeight_bit_control = intern ("eight-bit-control");
- staticpro (&Qeight_bit_control);
-
- Qeight_bit_graphic = intern ("eight-bit-graphic");
- staticpro (&Qeight_bit_graphic);
-
- /* Define special charsets ascii, eight-bit-control, and
- eight-bit-graphic. */
- update_charset_table (make_number (CHARSET_ASCII),
- make_number (1), make_number (94),
- make_number (1),
- make_number (0),
- make_number ('B'),
- make_number (0),
- build_string ("ASCII"),
- Qnil, /* same as above */
- build_string ("ASCII (ISO646 IRV)"));
- CHARSET_SYMBOL (CHARSET_ASCII) = Qascii;
- Fput (Qascii, Qcharset, CHARSET_TABLE_ENTRY (CHARSET_ASCII));
-
- update_charset_table (make_number (CHARSET_8_BIT_CONTROL),
- make_number (1), make_number (96),
- make_number (4),
- make_number (0),
- make_number (-1),
- make_number (-1),
- build_string ("8-bit control code (0x80..0x9F)"),
- Qnil, /* same as above */
- Qnil); /* same as above */
- CHARSET_SYMBOL (CHARSET_8_BIT_CONTROL) = Qeight_bit_control;
- Fput (Qeight_bit_control, Qcharset,
- CHARSET_TABLE_ENTRY (CHARSET_8_BIT_CONTROL));
-
- update_charset_table (make_number (CHARSET_8_BIT_GRAPHIC),
- make_number (1), make_number (96),
- make_number (4),
- make_number (0),
- make_number (-1),
- make_number (-1),
- build_string ("8-bit graphic char (0xA0..0xFF)"),
- Qnil, /* same as above */
- Qnil); /* same as above */
- CHARSET_SYMBOL (CHARSET_8_BIT_GRAPHIC) = Qeight_bit_graphic;
- Fput (Qeight_bit_graphic, Qcharset,
- CHARSET_TABLE_ENTRY (CHARSET_8_BIT_GRAPHIC));
-
- Qauto_fill_chars = intern ("auto-fill-chars");
- staticpro (&Qauto_fill_chars);
- Fput (Qauto_fill_chars, Qchar_table_extra_slots, make_number (0));
-
- defsubr (&Sdefine_charset);
- defsubr (&Sgeneric_character_list);
+ DEFSYM (Qcharsetp, "charsetp");
+
+ DEFSYM (Qascii, "ascii");
+ DEFSYM (Qunicode, "unicode");
+ DEFSYM (Qeight_bit, "eight-bit");
+ DEFSYM (Qiso_8859_1, "iso-8859-1");
+
+ DEFSYM (Qgl, "gl");
+ DEFSYM (Qgr, "gr");
+
+ staticpro (&Vcharset_ordered_list);
+ Vcharset_ordered_list = Qnil;
+
+ staticpro (&Viso_2022_charset_list);
+ Viso_2022_charset_list = Qnil;
+
+ staticpro (&Vemacs_mule_charset_list);
+ Vemacs_mule_charset_list = Qnil;
+
+ staticpro (&Vcharset_hash_table);
+ {
+ Lisp_Object args[2];
+ args[0] = QCtest;
+ args[1] = Qeq;
+ Vcharset_hash_table = Fmake_hash_table (2, args);
+ }
+
+ charset_table_size = 128;
+ charset_table = ((struct charset *)
+ xmalloc (sizeof (struct charset) * charset_table_size));
+ charset_table_used = 0;
+
+ staticpro (&Vchar_unified_charset_table);
+ Vchar_unified_charset_table = Fmake_char_table (Qnil, make_number (-1));
+
+ defsubr (&Scharsetp);
+ defsubr (&Smap_charset_chars);
+ defsubr (&Sdefine_charset_internal);
+ defsubr (&Sdefine_charset_alias);
+ defsubr (&Sunibyte_charset);
+ defsubr (&Sset_unibyte_charset);
+ defsubr (&Scharset_plist);
+ defsubr (&Sset_charset_plist);
+ defsubr (&Sunify_charset);
defsubr (&Sget_unused_iso_final_char);
defsubr (&Sdeclare_equiv_charset);
defsubr (&Sfind_charset_region);
defsubr (&Sfind_charset_string);
- defsubr (&Smake_char_internal);
+ defsubr (&Sdecode_char);
+ defsubr (&Sencode_char);
defsubr (&Ssplit_char);
+ defsubr (&Smake_char);
defsubr (&Schar_charset);
defsubr (&Scharset_after);
defsubr (&Siso_charset);
- defsubr (&Schar_valid_p);
- defsubr (&Sunibyte_char_to_multibyte);
- defsubr (&Smultibyte_char_to_unibyte);
- defsubr (&Schar_bytes);
- defsubr (&Schar_width);
- defsubr (&Sstring_width);
- defsubr (&Schar_direction);
- defsubr (&Sstring);
- defsubr (&Ssetup_special_charsets);
+ defsubr (&Sclear_charset_maps);
+ defsubr (&Scharset_priority_list);
+ defsubr (&Sset_charset_priority);
+ defsubr (&Scharset_id_internal);
+
+ DEFVAR_LISP ("charset-map-path", &Vcharset_map_path,
+ doc: /* *Lisp of directories to search for charset map files. */);
+ Vcharset_map_path = Qnil;
DEFVAR_LISP ("charset-list", &Vcharset_list,
- doc: /* List of charsets ever defined. */);
- Vcharset_list = Fcons (Qascii, Fcons (Qeight_bit_control,
- Fcons (Qeight_bit_graphic, Qnil)));
-
- DEFVAR_LISP ("translation-table-vector", &Vtranslation_table_vector,
- doc: /* Vector of cons cell of a symbol and translation table ever defined.
-An ID of a translation table is an index of this vector. */);
- Vtranslation_table_vector = Fmake_vector (make_number (16), Qnil);
-
- DEFVAR_INT ("leading-code-private-11", &leading_code_private_11,
- doc: /* Leading-code of private TYPE9N charset of column-width 1. */);
- leading_code_private_11 = LEADING_CODE_PRIVATE_11;
-
- DEFVAR_INT ("leading-code-private-12", &leading_code_private_12,
- doc: /* Leading-code of private TYPE9N charset of column-width 2. */);
- leading_code_private_12 = LEADING_CODE_PRIVATE_12;
-
- DEFVAR_INT ("leading-code-private-21", &leading_code_private_21,
- doc: /* Leading-code of private TYPE9Nx9N charset of column-width 1. */);
- leading_code_private_21 = LEADING_CODE_PRIVATE_21;
-
- DEFVAR_INT ("leading-code-private-22", &leading_code_private_22,
- doc: /* Leading-code of private TYPE9Nx9N charset of column-width 2. */);
- leading_code_private_22 = LEADING_CODE_PRIVATE_22;
-
- DEFVAR_INT ("nonascii-insert-offset", &nonascii_insert_offset,
- doc: /* Offset for converting non-ASCII unibyte codes 0240...0377 to multibyte.
-This is used for converting unibyte text to multibyte,
-and for inserting character codes specified by number.
-
-This serves to convert a Latin-1 or similar 8-bit character code
-to the corresponding Emacs multibyte character code.
-Typically the value should be (- (make-char CHARSET 0) 128),
-for your choice of character set.
-If `nonascii-translation-table' is non-nil, it overrides this variable. */);
- nonascii_insert_offset = 0;
-
- DEFVAR_LISP ("nonascii-translation-table", &Vnonascii_translation_table,
- doc: /* Translation table to convert non-ASCII unibyte codes to multibyte.
-This is used for converting unibyte text to multibyte,
-and for inserting character codes specified by number.
-
-Conversion is performed only when multibyte characters are enabled,
-and it serves to convert a Latin-1 or similar 8-bit character code
-to the corresponding Emacs character code.
-
-If this is nil, `nonascii-insert-offset' is used instead.
-See also the docstring of `make-translation-table'. */);
- Vnonascii_translation_table = Qnil;
-
- DEFVAR_LISP ("auto-fill-chars", &Vauto_fill_chars,
- doc: /* A char-table for characters which invoke auto-filling.
-Such characters have value t in this table. */);
- Vauto_fill_chars = Fmake_char_table (Qauto_fill_chars, Qnil);
- CHAR_TABLE_SET (Vauto_fill_chars, make_number (' '), Qt);
- CHAR_TABLE_SET (Vauto_fill_chars, make_number ('\n'), Qt);
+ doc: /* List of all charsets ever defined. */);
+ Vcharset_list = Qnil;
+
+ charset_ascii
+ = define_charset_internal (Qascii, 1, "\x00\x7F\x00\x00\x00\x00",
+ 0, 127, 'B', -1, 0, 1, 0, 0);
+ charset_iso_8859_1
+ = define_charset_internal (Qiso_8859_1, 1, "\x00\xFF\x00\x00\x00\x00",
+ 0, 255, -1, -1, -1, 1, 0, 0);
+ charset_unicode
+ = define_charset_internal (Qunicode, 3, "\x00\xFF\x00\xFF\x00\x10",
+ 0, MAX_UNICODE_CHAR, -1, 0, -1, 1, 0, 0);
+ charset_eight_bit
+ = define_charset_internal (Qeight_bit, 1, "\x80\xFF\x00\x00\x00\x00",
+ 128, 255, -1, 0, -1, 0, 0,
+ MAX_5_BYTE_CHAR + 1);
}
#endif /* emacs */
-/* Header for multibyte character handler.
+/* Header for charset handler.
Copyright (C) 2001, 2002, 2003, 2004, 2005,
- 2006, 2007 Free Software Foundation, Inc.
+ 2006, 2007, 2008 Free Software Foundation, Inc.
Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- 2005, 2006, 2007
+ 2005, 2006, 2007, 2008
National Institute of Advanced Industrial Science and Technology (AIST)
Registration Number H14PRO021
+ Copyright (C) 2003
+ National Institute of Advanced Industrial Science and Technology (AIST)
+ Registration Number H13PRO009
+
This file is part of GNU Emacs.
GNU Emacs is free software; you can redistribute it and/or modify
#ifndef EMACS_CHARSET_H
#define EMACS_CHARSET_H
-/* #define BYTE_COMBINING_DEBUG */
-
-/*** GENERAL NOTE on CHARACTER SET (CHARSET) ***
-
- A character set ("charset" hereafter) is a meaningful collection
- (i.e. language, culture, functionality, etc) of characters. Emacs
- handles multiple charsets at once. Each charset corresponds to one
- of the ISO charsets. Emacs identifies a charset by a unique
- identification number, whereas ISO identifies a charset by a triplet
- of DIMENSION, CHARS and FINAL-CHAR. So, hereafter, just saying
- "charset" means an identification number (integer value).
-
- The value range of charsets is 0x00, 0x81..0xFE. There are four
- kinds of charset depending on DIMENSION (1 or 2) and CHARS (94 or
- 96). For instance, a charset of DIMENSION2_CHARS94 contains 94x94
- characters.
-
- Within Emacs Lisp, a charset is treated as a symbol which has a
- property `charset'. The property value is a vector containing
- various information about the charset. For readability of C code,
- we use the following convention for C variable names:
- charset_symbol: Emacs Lisp symbol of a charset
- charset_id: Emacs Lisp integer of an identification number of a charset
- charset: C integer of an identification number of a charset
-
- Each charset (except for ascii) is assigned a base leading-code
- (range 0x80..0x9E). In addition, a charset of greater than 0xA0
- (whose base leading-code is 0x9A..0x9D) is assigned an extended
- leading-code (range 0xA0..0xFE). In this case, each base
- leading-code specifies the allowable range of extended leading-code
- as shown in the table below. A leading-code is used to represent a
- character in Emacs' buffer and string.
-
- We call a charset which has extended leading-code a "private
- charset" because those are mainly for a charset which is not yet
- registered by ISO. On the contrary, we call a charset which does
- not have extended leading-code an "official charset".
-
- ---------------------------------------------------------------------------
- charset dimension base leading-code extended leading-code
- ---------------------------------------------------------------------------
- 0x00 official dim1 -- none -- -- none --
- (ASCII)
- 0x01..0x7F --never used--
- 0x80 official dim1 -- none -- -- none --
- (eight-bit-graphic)
- 0x81..0x8F official dim1 same as charset -- none --
- 0x90..0x99 official dim2 same as charset -- none --
- 0x9A..0x9D --never used--
- 0x9E official dim1 same as charset -- none --
- (eight-bit-control)
- 0x9F --never used--
- 0xA0..0xDF private dim1 0x9A same as charset
- of 1-column width
- 0xE0..0xEF private dim1 0x9B same as charset
- of 2-column width
- 0xF0..0xF4 private dim2 0x9C same as charset
- of 1-column width
- 0xF5..0xFE private dim2 0x9D same as charset
- of 2-column width
- 0xFF --never used--
- ---------------------------------------------------------------------------
-
-*/
-
-/* Definition of special leading-codes. */
-/* Leading-code followed by extended leading-code. */
-#define LEADING_CODE_PRIVATE_11 0x9A /* for private DIMENSION1 of 1-column */
-#define LEADING_CODE_PRIVATE_12 0x9B /* for private DIMENSION1 of 2-column */
-#define LEADING_CODE_PRIVATE_21 0x9C /* for private DIMENSION2 of 1-column */
-#define LEADING_CODE_PRIVATE_22 0x9D /* for private DIMENSION2 of 2-column */
-
-#define LEADING_CODE_8_BIT_CONTROL 0x9E /* for `eight-bit-control' */
-
-/* Extended leading-code. */
-/* Start of each extended leading-codes. */
-#define LEADING_CODE_EXT_11 0xA0 /* follows LEADING_CODE_PRIVATE_11 */
-#define LEADING_CODE_EXT_12 0xE0 /* follows LEADING_CODE_PRIVATE_12 */
-#define LEADING_CODE_EXT_21 0xF0 /* follows LEADING_CODE_PRIVATE_21 */
-#define LEADING_CODE_EXT_22 0xF5 /* follows LEADING_CODE_PRIVATE_22 */
-/* Maximum value of extended leading-codes. */
-#define LEADING_CODE_EXT_MAX 0xFE
-
-/* Definition of minimum/maximum charset of each DIMENSION. */
-#define MIN_CHARSET_OFFICIAL_DIMENSION1 0x80
-#define MAX_CHARSET_OFFICIAL_DIMENSION1 0x8F
-#define MIN_CHARSET_OFFICIAL_DIMENSION2 0x90
-#define MAX_CHARSET_OFFICIAL_DIMENSION2 0x99
-#define MIN_CHARSET_PRIVATE_DIMENSION1 LEADING_CODE_EXT_11
-#define MIN_CHARSET_PRIVATE_DIMENSION2 LEADING_CODE_EXT_21
-
-/* Maximum value of overall charset identification number. */
-#define MAX_CHARSET 0xFE
-
-/* Definition of special charsets. */
-#define CHARSET_ASCII 0 /* 0x00..0x7F */
-#define CHARSET_8_BIT_CONTROL 0x9E /* 0x80..0x9F */
-#define CHARSET_8_BIT_GRAPHIC 0x80 /* 0xA0..0xFF */
-
-extern int charset_latin_iso8859_1; /* ISO8859-1 (Latin-1) */
-extern int charset_jisx0208_1978; /* JISX0208.1978 (Japanese Kanji old set) */
-extern int charset_jisx0208; /* JISX0208.1983 (Japanese Kanji) */
-extern int charset_katakana_jisx0201; /* JISX0201.Kana (Japanese Katakana) */
-extern int charset_latin_jisx0201; /* JISX0201.Roman (Japanese Roman) */
-extern int charset_big5_1; /* Big5 Level 1 (Chinese Traditional) */
-extern int charset_big5_2; /* Big5 Level 2 (Chinese Traditional) */
-extern int charset_mule_unicode_0100_24ff;
-extern int charset_mule_unicode_2500_33ff;
-extern int charset_mule_unicode_e000_ffff;
-
-/* Check if CH is an ASCII character or a base leading-code.
- Nowadays, any byte can be the first byte of a character in a
- multibyte buffer/string. So this macro name is not appropriate. */
-#define CHAR_HEAD_P(ch) ((unsigned char) (ch) < 0xA0)
-
-/*** GENERAL NOTE on CHARACTER REPRESENTATION ***
-
- Firstly, the term "character" or "char" is used for a multilingual
- character (of course, including ASCII characters), not for a byte in
- computer memory. We use the term "code" or "byte" for the latter
- case.
-
- A character is identified by charset and one or two POSITION-CODEs.
- POSITION-CODE is the position of the character in the charset. A
- character of DIMENSION1 charset has one POSITION-CODE: POSITION-CODE-1.
- A character of DIMENSION2 charset has two POSITION-CODE:
- POSITION-CODE-1 and POSITION-CODE-2. The code range of
- POSITION-CODE is 0x20..0x7F.
-
- Emacs has two kinds of representation of a character: multi-byte
- form (for buffers and strings) and single-word form (for character
- objects in Emacs Lisp). The latter is called "character code"
- hereafter. Both representations encode the information of charset
- and POSITION-CODE but in a different way (for instance, the MSB of
- POSITION-CODE is set in multi-byte form).
-
- For details of the multi-byte form, see the section "2. Emacs
- internal format handlers" of `coding.c'.
-
- Emacs uses 19 bits for a character code. The bits are divided into
- 3 fields: FIELD1(5bits):FIELD2(7bits):FIELD3(7bits).
-
- A character code of DIMENSION1 character uses FIELD2 to hold charset
- and FIELD3 to hold POSITION-CODE-1. A character code of DIMENSION2
- character uses FIELD1 to hold charset, FIELD2 and FIELD3 to hold
- POSITION-CODE-1 and POSITION-CODE-2 respectively.
-
- More precisely...
-
- FIELD2 of DIMENSION1 character (except for ascii, eight-bit-control,
- and eight-bit-graphic) is "charset - 0x70". This is to make all
- character codes except for ASCII and 8-bit codes greater than 256.
- So, the range of FIELD2 of DIMENSION1 character is 0, 1, or
- 0x11..0x7F.
-
- FIELD1 of DIMENSION2 character is "charset - 0x8F" for official
- charset and "charset - 0xE0" for private charset. So, the range of
- FIELD1 of DIMENSION2 character is 0x01..0x1E.
-
- -----------------------------------------------------------------------------
- charset FIELD1 (5-bit) FIELD2 (7-bit) FIELD3 (7-bit)
- -----------------------------------------------------------------------------
- ascii 0 0 0x00..0x7F
- eight-bit-control 0 1 0x00..0x1F
- eight-bit-graphic 0 1 0x20..0x7F
- DIMENSION1 0 charset - 0x70 POSITION-CODE-1
- DIMENSION2(o) charset - 0x8F POSITION-CODE-1 POSITION-CODE-2
- DIMENSION2(p) charset - 0xE0 POSITION-CODE-1 POSITION-CODE-2
- -----------------------------------------------------------------------------
- "(o)": official, "(p)": private
- -----------------------------------------------------------------------------
-*/
-
-/* Masks of each field of character code. */
-#define CHAR_FIELD1_MASK (0x1F << 14)
-#define CHAR_FIELD2_MASK (0x7F << 7)
-#define CHAR_FIELD3_MASK 0x7F
-
-/* Macros to access each field of character C. */
-#define CHAR_FIELD1(c) (((c) & CHAR_FIELD1_MASK) >> 14)
-#define CHAR_FIELD2(c) (((c) & CHAR_FIELD2_MASK) >> 7)
-#define CHAR_FIELD3(c) ((c) & CHAR_FIELD3_MASK)
-
-/* Minimum character code of character of each DIMENSION. */
-#define MIN_CHAR_OFFICIAL_DIMENSION1 \
- ((0x81 - 0x70) << 7)
-#define MIN_CHAR_PRIVATE_DIMENSION1 \
- ((MIN_CHARSET_PRIVATE_DIMENSION1 - 0x70) << 7)
-#define MIN_CHAR_OFFICIAL_DIMENSION2 \
- ((MIN_CHARSET_OFFICIAL_DIMENSION2 - 0x8F) << 14)
-#define MIN_CHAR_PRIVATE_DIMENSION2 \
- ((MIN_CHARSET_PRIVATE_DIMENSION2 - 0xE0) << 14)
-/* Maximum character code currently used plus 1. */
-#define MAX_CHAR (0x1F << 14)
-
-/* 1 if C is a single byte character, else 0. */
-#define SINGLE_BYTE_CHAR_P(c) (((unsigned)(c) & 0xFF) == (c))
-
-/* 1 if BYTE is an ASCII character in itself, in multibyte mode. */
-#define ASCII_BYTE_P(byte) ((byte) < 0x80)
-
-/* A char-table containing information on each character set.
-
- Unlike ordinary char-tables, this doesn't contain any nested tables.
- Only the top level elements are used. Each element is a vector of
- the following information:
- CHARSET-ID, BYTES, DIMENSION, CHARS, WIDTH, DIRECTION,
- LEADING-CODE-BASE, LEADING-CODE-EXT,
- ISO-FINAL-CHAR, ISO-GRAPHIC-PLANE,
- REVERSE-CHARSET, SHORT-NAME, LONG-NAME, DESCRIPTION,
- PLIST.
-
- CHARSET-ID (integer) is the identification number of the charset.
-
- BYTES (integer) is the length of the multi-byte form of a character
- in the charset: one of 1, 2, 3, and 4.
-
- DIMENSION (integer) is the number of bytes to represent a character: 1 or 2.
-
- CHARS (integer) is the number of characters in a dimension: 94 or 96.
-
- WIDTH (integer) is the number of columns a character in the charset
- occupies on the screen: one of 0, 1, and 2..
-
- DIRECTION (integer) is the rendering direction of characters in the
- charset when rendering. If 0, render from left to right, else
- render from right to left.
-
- LEADING-CODE-BASE (integer) is the base leading-code for the
- charset.
-
- LEADING-CODE-EXT (integer) is the extended leading-code for the
- charset. All charsets of less than 0xA0 have the value 0.
-
- ISO-FINAL-CHAR (character) is the final character of the
- corresponding ISO 2022 charset. It is -1 for such a character
- that is used only internally (e.g. `eight-bit-control').
-
- ISO-GRAPHIC-PLANE (integer) is the graphic plane to be invoked
- while encoding to variants of ISO 2022 coding system, one of the
- following: 0/graphic-plane-left(GL), 1/graphic-plane-right(GR). It
- is -1 for such a character that is used only internally
- (e.g. `eight-bit-control').
-
- REVERSE-CHARSET (integer) is the charset which differs only in
- LEFT-TO-RIGHT value from the charset. If there's no such a
- charset, the value is -1.
-
- SHORT-NAME (string) is the short name to refer to the charset.
-
- LONG-NAME (string) is the long name to refer to the charset.
-
- DESCRIPTION (string) is the description string of the charset.
-
- PLIST (property list) may contain any type of information a user
- wants to put and get by functions `put-charset-property' and
- `get-charset-property' respectively. */
-extern Lisp_Object Vcharset_table;
-
-/* Macros to access various information of CHARSET in Vcharset_table.
- We provide these macros for efficiency. No range check of CHARSET. */
-
-/* Return entry of CHARSET (C integer) in Vcharset_table. */
-#define CHARSET_TABLE_ENTRY(charset) \
- XCHAR_TABLE (Vcharset_table)->contents[((charset) == CHARSET_ASCII \
- ? 0 : (charset) + 128)]
-
-/* Return information INFO-IDX of CHARSET. */
-#define CHARSET_TABLE_INFO(charset, info_idx) \
- XVECTOR (CHARSET_TABLE_ENTRY (charset))->contents[info_idx]
-
-#define CHARSET_ID_IDX (0)
-#define CHARSET_BYTES_IDX (1)
-#define CHARSET_DIMENSION_IDX (2)
-#define CHARSET_CHARS_IDX (3)
-#define CHARSET_WIDTH_IDX (4)
-#define CHARSET_DIRECTION_IDX (5)
-#define CHARSET_LEADING_CODE_BASE_IDX (6)
-#define CHARSET_LEADING_CODE_EXT_IDX (7)
-#define CHARSET_ISO_FINAL_CHAR_IDX (8)
-#define CHARSET_ISO_GRAPHIC_PLANE_IDX (9)
-#define CHARSET_REVERSE_CHARSET_IDX (10)
-#define CHARSET_SHORT_NAME_IDX (11)
-#define CHARSET_LONG_NAME_IDX (12)
-#define CHARSET_DESCRIPTION_IDX (13)
-#define CHARSET_PLIST_IDX (14)
-/* Size of a vector of each entry of Vcharset_table. */
-#define CHARSET_MAX_IDX (15)
-
-/* And several more macros to be used frequently. */
-#define CHARSET_BYTES(charset) \
- XFASTINT (CHARSET_TABLE_INFO (charset, CHARSET_BYTES_IDX))
-#define CHARSET_DIMENSION(charset) \
- XFASTINT (CHARSET_TABLE_INFO (charset, CHARSET_DIMENSION_IDX))
-#define CHARSET_CHARS(charset) \
- XFASTINT (CHARSET_TABLE_INFO (charset, CHARSET_CHARS_IDX))
-#define CHARSET_WIDTH(charset) \
- XFASTINT (CHARSET_TABLE_INFO (charset, CHARSET_WIDTH_IDX))
-#define CHARSET_DIRECTION(charset) \
- XFASTINT (CHARSET_TABLE_INFO (charset, CHARSET_DIRECTION_IDX))
-#define CHARSET_LEADING_CODE_BASE(charset) \
- XFASTINT (CHARSET_TABLE_INFO (charset, CHARSET_LEADING_CODE_BASE_IDX))
-#define CHARSET_LEADING_CODE_EXT(charset) \
- XFASTINT (CHARSET_TABLE_INFO (charset, CHARSET_LEADING_CODE_EXT_IDX))
-#define CHARSET_ISO_FINAL_CHAR(charset) \
- XINT (CHARSET_TABLE_INFO (charset, CHARSET_ISO_FINAL_CHAR_IDX))
-#define CHARSET_ISO_GRAPHIC_PLANE(charset) \
- XINT (CHARSET_TABLE_INFO (charset, CHARSET_ISO_GRAPHIC_PLANE_IDX))
-#define CHARSET_REVERSE_CHARSET(charset) \
- XINT (CHARSET_TABLE_INFO (charset, CHARSET_REVERSE_CHARSET_IDX))
-
-/* Macros to specify direction of a charset. */
-#define CHARSET_DIRECTION_LEFT_TO_RIGHT 0
-#define CHARSET_DIRECTION_RIGHT_TO_LEFT 1
-
-/* A vector of charset symbol indexed by charset-id. This is used
- only for returning charset symbol from C functions. */
-extern Lisp_Object Vcharset_symbol_table;
-
-/* Return symbol of CHARSET. */
-#define CHARSET_SYMBOL(charset) \
- XVECTOR (Vcharset_symbol_table)->contents[charset]
-
-/* 1 if CHARSET is in valid value range, else 0. */
-#define CHARSET_VALID_P(charset) \
- ((charset) == 0 \
- || ((charset) > 0x80 && (charset) <= MAX_CHARSET_OFFICIAL_DIMENSION2) \
- || ((charset) >= MIN_CHARSET_PRIVATE_DIMENSION1 \
- && (charset) <= MAX_CHARSET) \
- || ((charset) == CHARSET_8_BIT_CONTROL) \
- || ((charset) == CHARSET_8_BIT_GRAPHIC))
-
-/* 1 if CHARSET is already defined, else 0. */
-#define CHARSET_DEFINED_P(charset) \
- (((charset) >= 0) && ((charset) <= MAX_CHARSET) \
- && !NILP (CHARSET_TABLE_ENTRY (charset)))
-
-/* Since the information CHARSET-BYTES and CHARSET-WIDTH of
- Vcharset_table can be retrieved only by the first byte of
- multi-byte form (an ASCII code or a base leading-code), we provide
- here tables to be used by macros BYTES_BY_CHAR_HEAD and
- WIDTH_BY_CHAR_HEAD for faster information retrieval. */
-extern int bytes_by_char_head[256];
-extern int width_by_char_head[256];
-
-#define BYTES_BY_CHAR_HEAD(char_head) \
- (ASCII_BYTE_P (char_head) ? 1 : bytes_by_char_head[char_head])
-#define WIDTH_BY_CHAR_HEAD(char_head) \
- (ASCII_BYTE_P (char_head) ? 1 : width_by_char_head[char_head])
-
-/* Charset of the character C. */
-#define CHAR_CHARSET(c) \
- (SINGLE_BYTE_CHAR_P (c) \
- ? (ASCII_BYTE_P (c) \
- ? CHARSET_ASCII \
- : (c) < 0xA0 ? CHARSET_8_BIT_CONTROL : CHARSET_8_BIT_GRAPHIC) \
- : ((c) < MIN_CHAR_OFFICIAL_DIMENSION2 \
- ? CHAR_FIELD2 (c) + 0x70 \
- : ((c) < MIN_CHAR_PRIVATE_DIMENSION2 \
- ? CHAR_FIELD1 (c) + 0x8F \
- : CHAR_FIELD1 (c) + 0xE0)))
+/* Index to arguments of Fdefine_charset_internal. */
+
+enum define_charset_arg_index
+ {
+ charset_arg_name,
+ charset_arg_dimension,
+ charset_arg_code_space,
+ charset_arg_min_code,
+ charset_arg_max_code,
+ charset_arg_iso_final,
+ charset_arg_iso_revision,
+ charset_arg_emacs_mule_id,
+ charset_arg_ascii_compatible_p,
+ charset_arg_supplementary_p,
+ charset_arg_invalid_code,
+ charset_arg_code_offset,
+ charset_arg_map,
+ charset_arg_subset,
+ charset_arg_superset,
+ charset_arg_unify_map,
+ charset_arg_plist,
+ charset_arg_max
+ };
+
+
+/* Indices to charset attributes vector. */
+
+enum charset_attr_index
+ {
+ /* ID number of the charset. */
+ charset_id,
+
+ /* Name of the charset (symbol). */
+ charset_name,
+
+ /* Property list of the charset. */
+ charset_plist,
+
+ /* If the method of the charset is `MAP_DEFERRED', the value is a
+ mapping vector or a file name that contains mapping vector.
+ Otherwise, nil. */
+ charset_map,
+
+ /* If the method of the charset is `MAP', the value is a vector
+ that maps code points of the charset to characters. The vector
+ is indexed by a character index. A character index is
+ calculated from a code point and the code-space table of the
+ charset. */
+ charset_decoder,
+
+ /* If the method of the charset is `MAP', the value is a
+ char-table that maps characters of the charset to code
+ points. */
+ charset_encoder,
+
+ /* If the method of the charset is `SUBSET', the value is a vector
+ that has this form:
+
+ [ CHARSET-ID MIN-CODE MAX-CODE OFFSET ]
+
+ CHARSET-ID is an ID number of a parent charset. MIN-CODE and
+ MAX-CODE specify the range of characters inherited from the
+ parent. OFFSET is an integer value to add to a code point of
+ the parent charset to get the corresponding code point of this
+ charset. */
+ charset_subset,
+
+ /* If the method of the charset is `SUPERSET', the value is a list
+ whose elements have this form:
+
+ (CHARSET-ID . OFFSET)
+
+ CHARSET-IDs are ID numbers of parent charsets. OFFSET is an
+ integer value to add to a code point of the parent charset to
+ get the corresponding code point of this charset. */
+ charset_superset,
+
+ /* The value is a mapping vector or a file name that contains the
+ mapping. This defines how characters in the charset should be
+ unified with Unicode. The value of the member
+ `charset_deunifier' is created from this information. */
+ charset_unify_map,
+
+ /* If characters in the charset must be unified Unicode, the value
+ is a char table that maps a unified Unicode character code to
+ the non-unified character code in the charset. */
+ charset_deunifier,
+
+ /* The length of the charset attribute vector. */
+ charset_attr_max
+ };
+
+/* Methods for converting code points and characters of charsets. */
+
+enum charset_method
+ {
+ /* For a charset of this method, a character code is calculated
+ from a character index (which is calculated from a code point)
+ simply by adding an offset value. */
+ CHARSET_METHOD_OFFSET,
+
+ /* For a charset of this method, a decoder vector and an encoder
+ char-table is used for code point <-> character code
+ conversion. */
+ CHARSET_METHOD_MAP,
+
+ /* Same as above but decoder and encoder are loaded from a file on
+ demand. Once loaded, the method is changed to
+ CHARSET_METHOD_MAP. */
+ CHARSET_METHOD_MAP_DEFERRED,
+
+ /* A charset of this method is a subset of another charset. */
+ CHARSET_METHOD_SUBSET,
+
+ /* A charset of this method is a superset of other charsets. */
+ CHARSET_METHOD_SUPERSET
+ };
+
+struct charset
+{
+ /* Index to charset_table. */
+ int id;
-/* Check if two characters C1 and C2 belong to the same charset. */
-#define SAME_CHARSET_P(c1, c2) \
- (c1 < MIN_CHAR_OFFICIAL_DIMENSION2 \
- ? (c1 & CHAR_FIELD2_MASK) == (c2 & CHAR_FIELD2_MASK) \
- : (c1 & CHAR_FIELD1_MASK) == (c2 & CHAR_FIELD1_MASK))
-
-/* Return a character of which charset is CHARSET and position-codes
- are C1 and C2. DIMENSION1 character ignores C2. */
-#define MAKE_CHAR(charset, c1, c2) \
- ((charset) == CHARSET_ASCII \
- ? (c1) & 0x7F \
- : (((charset) == CHARSET_8_BIT_CONTROL \
- || (charset) == CHARSET_8_BIT_GRAPHIC) \
- ? ((c1) & 0x7F) | 0x80 \
- : ((CHARSET_DEFINED_P (charset) \
- ? CHARSET_DIMENSION (charset) == 1 \
- : (charset) < MIN_CHARSET_PRIVATE_DIMENSION2) \
- ? (((charset) - 0x70) << 7) | ((c1) <= 0 ? 0 : ((c1) & 0x7F)) \
- : ((((charset) \
- - ((charset) < MIN_CHARSET_PRIVATE_DIMENSION2 ? 0x8F : 0xE0)) \
- << 14) \
- | ((c2) <= 0 ? 0 : ((c2) & 0x7F)) \
- | ((c1) <= 0 ? 0 : (((c1) & 0x7F) << 7))))))
-
-
-/* If GENERICP is nonzero, return nonzero if C is a valid normal or
- generic character. If GENERICP is zero, return nonzero if C is a
- valid normal character. */
-#define CHAR_VALID_P(c, genericp) \
- ((c) >= 0 \
- && (SINGLE_BYTE_CHAR_P (c) || char_valid_p (c, genericp)))
-
-/* This default value is used when nonascii-translation-table or
- nonascii-insert-offset fail to convert unibyte character to a valid
- multibyte character. This makes a Latin-1 character. */
-
-#define DEFAULT_NONASCII_INSERT_OFFSET 0x800
-
-/* Parse multibyte string STR of length LENGTH and set BYTES to the
- byte length of a character at STR. */
-
-#ifdef BYTE_COMBINING_DEBUG
-
-#define PARSE_MULTIBYTE_SEQ(str, length, bytes) \
+ /* Index to Vcharset_hash_table. */
+ int hash_index;
+
+ /* Dimension of the charset: 1, 2, 3, or 4. */
+ int dimension;
+
+ /* Byte code range of each dimension. <code_space>[4N] is a mininum
+ byte code of the (N+1)th dimension, <code_space>[4N+1] is a
+ maximum byte code of the (N+1)th dimension, <code_space>[4N+2] is
+ (<code_space>[4N+1] - <code_space>[4N] + 1), <code_space>[4N+3]
+ is a number of characters containd in the first to (N+1)th
+ dismesions. We get `char-index' of a `code-point' from this
+ information. */
+ int code_space[16];
+
+ /* If B is a byte of Nth dimension of a code-point, the (N-1)th bit
+ of code_space_mask[B] is set. This array is used to quickly
+ check if a code-point is in a valid range. */
+ unsigned char *code_space_mask;
+
+ /* 1 if there's no gap in code-points. */
+ int code_linear_p;
+
+ /* If the charset is treated as 94-chars in ISO-2022, the value is 0.
+ If the charset is treated as 96-chars in ISO-2022, the value is 1. */
+ int iso_chars_96;
+
+ /* ISO final byte of the charset: 48..127. It may be -1 if the
+ charset doesn't conform to ISO-2022. */
+ int iso_final;
+
+ /* ISO revision number of the charset. */
+ int iso_revision;
+
+ /* If the charset is identical to what supported by Emacs 21 and the
+ priors, the identification number of the charset used in those
+ version. Otherwise, -1. */
+ int emacs_mule_id;
+
+ /* Nonzero if the charset is compatible with ASCII. */
+ int ascii_compatible_p;
+
+ /* Nonzero if the charset is supplementary. */
+ int supplementary_p;
+
+ /* Nonzero if all the code points are representable by Lisp_Int. */
+ int compact_codes_p;
+
+ /* The method for encoding/decoding characters of the charset. */
+ enum charset_method method;
+
+ /* Mininum and Maximum code points of the charset. */
+ unsigned min_code, max_code;
+
+ /* Offset value used by macros CODE_POINT_TO_INDEX and
+ INDEX_TO_CODE_POINT. . */
+ unsigned char_index_offset;
+
+ /* Mininum and Maximum character codes of the charset. If the
+ charset is compatible with ASCII, min_char is a minimum non-ASCII
+ character of the charset. If the method of charset is
+ CHARSET_METHOD_OFFSET, even if the charset is unified, min_char
+ and max_char doesn't change. */
+ int min_char, max_char;
+
+ /* The code returned by ENCODE_CHAR if a character is not encodable
+ by the charset. */
+ unsigned invalid_code;
+
+ /* If the method of the charset is CHARSET_METHOD_MAP, this is a
+ table of bits used to quickly and roughly guess if a character
+ belongs to the charset.
+
+ The first 64 elements are 512 bits for characters less than
+ 0x10000. Each bit corresponds to 128-character block. The last
+ 126 elements are 1008 bits for the greater characters
+ (0x10000..0x3FFFFF). Each bit corresponds to 4096-character
+ block.
+
+ If a bit is 1, at least one character in the corresponding block is
+ in this charset. */
+ unsigned char fast_map[190];
+
+ /* Offset value to calculate a character code from code-point, and
+ visa versa. */
+ int code_offset;
+
+ int unified_p;
+};
+
+/* Hash table of charset symbols vs. the correponding attribute
+ vectors. */
+extern Lisp_Object Vcharset_hash_table;
+
+/* Table of struct charset. */
+extern struct charset *charset_table;
+
+#define CHARSET_FROM_ID(id) (charset_table + (id))
+
+extern Lisp_Object Vcharset_ordered_list;
+
+/* Incremented everytime we change the priority of charsets. */
+extern unsigned short charset_ordered_list_tick;
+
+extern Lisp_Object Vcharset_list;
+extern Lisp_Object Viso_2022_charset_list;
+extern Lisp_Object Vemacs_mule_charset_list;
+
+extern struct charset *emacs_mule_charset[256];
+
+
+/* Macros to access information about charset. */
+
+/* Return the attribute vector of charset whose symbol is SYMBOL. */
+#define CHARSET_SYMBOL_ATTRIBUTES(symbol) \
+ Fgethash ((symbol), Vcharset_hash_table, Qnil)
+
+#define CHARSET_ATTR_ID(attrs) AREF ((attrs), charset_id)
+#define CHARSET_ATTR_NAME(attrs) AREF ((attrs), charset_name)
+#define CHARSET_ATTR_PLIST(attrs) AREF ((attrs), charset_plist)
+#define CHARSET_ATTR_MAP(attrs) AREF ((attrs), charset_map)
+#define CHARSET_ATTR_DECODER(attrs) AREF ((attrs), charset_decoder)
+#define CHARSET_ATTR_ENCODER(attrs) AREF ((attrs), charset_encoder)
+#define CHARSET_ATTR_SUBSET(attrs) AREF ((attrs), charset_subset)
+#define CHARSET_ATTR_SUPERSET(attrs) AREF ((attrs), charset_superset)
+#define CHARSET_ATTR_UNIFY_MAP(attrs) AREF ((attrs), charset_unify_map)
+#define CHARSET_ATTR_DEUNIFIER(attrs) AREF ((attrs), charset_deunifier)
+
+#define CHARSET_SYMBOL_ID(symbol) \
+ CHARSET_ATTR_ID (CHARSET_SYMBOL_ATTRIBUTES (symbol))
+
+/* Return an index to Vcharset_hash_table of the charset whose symbol
+ is SYMBOL. */
+#define CHARSET_SYMBOL_HASH_INDEX(symbol) \
+ hash_lookup (XHASH_TABLE (Vcharset_hash_table), symbol, NULL)
+
+/* Return the attribute vector of CHARSET. */
+#define CHARSET_ATTRIBUTES(charset) \
+ (HASH_VALUE (XHASH_TABLE (Vcharset_hash_table), (charset)->hash_index))
+
+#define CHARSET_ID(charset) ((charset)->id)
+#define CHARSET_HASH_INDEX(charset) ((charset)->hash_index)
+#define CHARSET_DIMENSION(charset) ((charset)->dimension)
+#define CHARSET_CODE_SPACE(charset) ((charset)->code_space)
+#define CHARSET_CODE_LINEAR_P(charset) ((charset)->code_linear_p)
+#define CHARSET_ISO_CHARS_96(charset) ((charset)->iso_chars_96)
+#define CHARSET_ISO_FINAL(charset) ((charset)->iso_final)
+#define CHARSET_ISO_PLANE(charset) ((charset)->iso_plane)
+#define CHARSET_ISO_REVISION(charset) ((charset)->iso_revision)
+#define CHARSET_EMACS_MULE_ID(charset) ((charset)->emacs_mule_id)
+#define CHARSET_ASCII_COMPATIBLE_P(charset) ((charset)->ascii_compatible_p)
+#define CHARSET_COMPACT_CODES_P(charset) ((charset)->compact_codes_p)
+#define CHARSET_METHOD(charset) ((charset)->method)
+#define CHARSET_MIN_CODE(charset) ((charset)->min_code)
+#define CHARSET_MAX_CODE(charset) ((charset)->max_code)
+#define CHARSET_INVALID_CODE(charset) ((charset)->invalid_code)
+#define CHARSET_MIN_CHAR(charset) ((charset)->min_char)
+#define CHARSET_MAX_CHAR(charset) ((charset)->max_char)
+#define CHARSET_CODE_OFFSET(charset) ((charset)->code_offset)
+#define CHARSET_UNIFIED_P(charset) ((charset)->unified_p)
+
+#define CHARSET_NAME(charset) \
+ (CHARSET_ATTR_NAME (CHARSET_ATTRIBUTES (charset)))
+#define CHARSET_MAP(charset) \
+ (CHARSET_ATTR_MAP (CHARSET_ATTRIBUTES (charset)))
+#define CHARSET_DECODER(charset) \
+ (CHARSET_ATTR_DECODER (CHARSET_ATTRIBUTES (charset)))
+#define CHARSET_ENCODER(charset) \
+ (CHARSET_ATTR_ENCODER (CHARSET_ATTRIBUTES (charset)))
+#define CHARSET_SUBSET(charset) \
+ (CHARSET_ATTR_SUBSET (CHARSET_ATTRIBUTES (charset)))
+#define CHARSET_SUPERSET(charset) \
+ (CHARSET_ATTR_SUPERSET (CHARSET_ATTRIBUTES (charset)))
+#define CHARSET_UNIFY_MAP(charset) \
+ (CHARSET_ATTR_UNIFY_MAP (CHARSET_ATTRIBUTES (charset)))
+#define CHARSET_DEUNIFIER(charset) \
+ (CHARSET_ATTR_DEUNIFIER (CHARSET_ATTRIBUTES (charset)))
+
+
+/* Nonzero if OBJ is a valid charset symbol. */
+#define CHARSETP(obj) (CHARSET_SYMBOL_HASH_INDEX (obj) >= 0)
+
+/* Check if X is a valid charset symbol. If not, signal an error. */
+#define CHECK_CHARSET(x) \
do { \
- int i = 1; \
- while (i < (length) && ! CHAR_HEAD_P ((str)[i])) i++; \
- (bytes) = BYTES_BY_CHAR_HEAD ((str)[0]); \
- if ((bytes) > i) \
- abort (); \
+ if (! SYMBOLP (x) || CHARSET_SYMBOL_HASH_INDEX (x) < 0) \
+ x = wrong_type_argument (Qcharsetp, (x)); \
} while (0)
-#else /* not BYTE_COMBINING_DEBUG */
-
-#define PARSE_MULTIBYTE_SEQ(str, length, bytes) \
- ((void)(length), (bytes) = BYTES_BY_CHAR_HEAD ((str)[0]))
-
-#endif /* not BYTE_COMBINING_DEBUG */
-
-#define VALID_LEADING_CODE_P(code) \
- (! NILP (CHARSET_TABLE_ENTRY (code)))
-
-/* Return 1 if the byte sequence at unibyte string STR (LENGTH bytes)
- is valid as a multibyte form. If valid, by a side effect, BYTES is
- set to the byte length of the multibyte form. */
-
-#define UNIBYTE_STR_AS_MULTIBYTE_P(str, length, bytes) \
- (((str)[0] < 0x80 || (str)[0] >= 0xA0) \
- ? ((bytes) = 1) \
- : (((bytes) = BYTES_BY_CHAR_HEAD ((str)[0])), \
- ((bytes) <= (length) \
- && !CHAR_HEAD_P ((str)[1]) \
- && ((bytes) == 2 \
- ? (str)[0] != LEADING_CODE_8_BIT_CONTROL \
- : (!CHAR_HEAD_P ((str)[2]) \
- && ((bytes) == 3 \
- ? (((str)[0] != LEADING_CODE_PRIVATE_11 \
- && (str)[0] != LEADING_CODE_PRIVATE_12) \
- || VALID_LEADING_CODE_P (str[1])) \
- : (!CHAR_HEAD_P ((str)[3]) \
- && VALID_LEADING_CODE_P (str[1]))))))))
-
-
-/* Return 1 if the byte sequence at multibyte string STR is valid as
- a unibyte form. By a side effect, BYTES is set to the byte length
- of one character at STR. */
-
-#define MULTIBYTE_STR_AS_UNIBYTE_P(str, bytes) \
- ((bytes) = BYTES_BY_CHAR_HEAD ((str)[0]), \
- (str)[0] != LEADING_CODE_8_BIT_CONTROL)
-
-/* The charset of character C is stored in CHARSET, and the
- position-codes of C are stored in C1 and C2.
- We store -1 in C2 if the dimension of the charset is 1. */
-
-#define SPLIT_CHAR(c, charset, c1, c2) \
- (SINGLE_BYTE_CHAR_P (c) \
- ? ((charset \
- = (ASCII_BYTE_P (c) \
- ? CHARSET_ASCII \
- : ((c) < 0xA0 ? CHARSET_8_BIT_CONTROL : CHARSET_8_BIT_GRAPHIC))), \
- c1 = (c), c2 = -1) \
- : ((c) & CHAR_FIELD1_MASK \
- ? (charset = (CHAR_FIELD1 (c) \
- + ((c) < MIN_CHAR_PRIVATE_DIMENSION2 ? 0x8F : 0xE0)), \
- c1 = CHAR_FIELD2 (c), \
- c2 = CHAR_FIELD3 (c)) \
- : (charset = CHAR_FIELD2 (c) + 0x70, \
- c1 = CHAR_FIELD3 (c), \
- c2 = -1)))
-
-/* Return 1 if character C has valid printable glyph. */
-#define CHAR_PRINTABLE_P(c) (ASCII_BYTE_P (c) || char_printable_p (c))
-
-/* The charset of the character at STR is stored in CHARSET, and the
- position-codes are stored in C1 and C2.
- We store -1 in C2 if the character is just 2 bytes. */
-
-#define SPLIT_STRING(str, len, charset, c1, c2) \
- ((BYTES_BY_CHAR_HEAD ((unsigned char) *(str)) < 2 \
- || BYTES_BY_CHAR_HEAD ((unsigned char) *(str)) > len \
- || split_string (str, len, &charset, &c1, &c2) < 0) \
- ? c1 = *(str), charset = CHARSET_ASCII \
- : charset)
-/* Mapping table from ISO2022's charset (specified by DIMENSION,
- CHARS, and FINAL_CHAR) to Emacs' charset. Should be accessed by
- macro ISO_CHARSET_TABLE (DIMENSION, CHARS, FINAL_CHAR). */
-extern int iso_charset_table[2][2][128];
-
-#define ISO_CHARSET_TABLE(dimension, chars, final_char) \
- iso_charset_table[XINT (dimension) - 1][XINT (chars) > 94][XINT (final_char)]
-
-#define BASE_LEADING_CODE_P(c) (BYTES_BY_CHAR_HEAD ((unsigned char) (c)) > 1)
-
-/* Return how many bytes C will occupy in a multibyte buffer. */
-#define CHAR_BYTES(c) \
- (SINGLE_BYTE_CHAR_P (c) \
- ? ((ASCII_BYTE_P (c) || (c) >= 0xA0) ? 1 : 2) \
- : char_bytes (c))
-
-/* The following two macros CHAR_STRING and STRING_CHAR are the main
- entry points to convert between Emacs's two types of character
- representations: multi-byte form and single-word form (character
- code). */
-
-/* Store multi-byte form of the character C in STR. The caller should
- allocate at least MAX_MULTIBYTE_LENGTH bytes area at STR in
- advance. Returns the length of the multi-byte form. If C is an
- invalid character code, signal an error. */
-
-#define CHAR_STRING(c, str) \
- (SINGLE_BYTE_CHAR_P (c) \
- ? ((ASCII_BYTE_P (c) || c >= 0xA0) \
- ? (*(str) = (unsigned char)(c), 1) \
- : (*(str) = LEADING_CODE_8_BIT_CONTROL, *((str)+ 1) = c + 0x20, 2)) \
- : char_to_string (c, (unsigned char *) str))
-
-/* Like CHAR_STRING but don't signal an error if C is invalid.
- Value is -1 in this case. */
-
-#define CHAR_STRING_NO_SIGNAL(c, str) \
- (SINGLE_BYTE_CHAR_P (c) \
- ? ((ASCII_BYTE_P (c) || c >= 0xA0) \
- ? (*(str) = (unsigned char)(c), 1) \
- : (*(str) = LEADING_CODE_8_BIT_CONTROL, *((str)+ 1) = c + 0x20, 2)) \
- : char_to_string_1 (c, (unsigned char *) str))
-
-/* Return a character code of the character of which multi-byte form
- is at STR and the length is LEN. If STR doesn't contain valid
- multi-byte form, only the first byte in STR is returned. */
-
-#define STRING_CHAR(str, len) \
- (BYTES_BY_CHAR_HEAD ((unsigned char) *(str)) == 1 \
- ? (unsigned char) *(str) \
- : string_to_char (str, len, 0))
-
-/* This is like STRING_CHAR but the third arg ACTUAL_LEN is set to the
- length of the multi-byte form. Just to know the length, use
- MULTIBYTE_FORM_LENGTH. */
-
-#define STRING_CHAR_AND_LENGTH(str, len, actual_len) \
- (BYTES_BY_CHAR_HEAD ((unsigned char) *(str)) == 1 \
- ? ((actual_len) = 1), (unsigned char) *(str) \
- : string_to_char (str, len, &(actual_len)))
-
-/* Fetch the "next" character from Lisp string STRING at byte position
- BYTEIDX, character position CHARIDX. Store it into OUTPUT.
-
- All the args must be side-effect-free.
- BYTEIDX and CHARIDX must be lvalues;
- we increment them past the character fetched. */
-
-#define FETCH_STRING_CHAR_ADVANCE(OUTPUT, STRING, CHARIDX, BYTEIDX) \
-if (1) \
- { \
- CHARIDX++; \
- if (STRING_MULTIBYTE (STRING)) \
- { \
- const unsigned char *ptr = SDATA (STRING) + BYTEIDX; \
- int space_left = SBYTES (STRING) - BYTEIDX; \
- int actual_len; \
- \
- OUTPUT = STRING_CHAR_AND_LENGTH (ptr, space_left, actual_len); \
- BYTEIDX += actual_len; \
- } \
- else \
- OUTPUT = SREF (STRING, BYTEIDX++); \
- } \
-else
-
-/* Like FETCH_STRING_CHAR_ADVANCE but assume STRING is multibyte. */
-
-#define FETCH_STRING_CHAR_ADVANCE_NO_CHECK(OUTPUT, STRING, CHARIDX, BYTEIDX) \
-if (1) \
- { \
- const unsigned char *fetch_string_char_ptr = SDATA (STRING) + BYTEIDX; \
- int fetch_string_char_space_left = SBYTES (STRING) - BYTEIDX; \
- int actual_len; \
- \
- OUTPUT \
- = STRING_CHAR_AND_LENGTH (fetch_string_char_ptr, \
- fetch_string_char_space_left, actual_len); \
- \
- BYTEIDX += actual_len; \
- CHARIDX++; \
- } \
-else
-
-/* Like FETCH_STRING_CHAR_ADVANCE but fetch character from the current
- buffer. */
-
-#define FETCH_CHAR_ADVANCE(OUTPUT, CHARIDX, BYTEIDX) \
-if (1) \
- { \
- CHARIDX++; \
- if (!NILP (current_buffer->enable_multibyte_characters)) \
- { \
- unsigned char *ptr = BYTE_POS_ADDR (BYTEIDX); \
- int space_left = ((CHARIDX < GPT ? GPT_BYTE : Z_BYTE) - BYTEIDX); \
- int actual_len; \
- \
- OUTPUT= STRING_CHAR_AND_LENGTH (ptr, space_left, actual_len); \
- BYTEIDX += actual_len; \
- } \
- else \
- { \
- OUTPUT = *(BYTE_POS_ADDR (BYTEIDX)); \
- BYTEIDX++; \
- } \
- } \
-else
-
-/* Return the length of the multi-byte form at string STR of length LEN. */
-
-#define MULTIBYTE_FORM_LENGTH(str, len) \
- (BYTES_BY_CHAR_HEAD (*(unsigned char *)(str)) == 1 \
- ? 1 \
- : multibyte_form_length (str, len))
-
-/* If P is before LIMIT, advance P to the next character boundary. It
- assumes that P is already at a character boundary of the sane
- mulitbyte form whose end address is LIMIT. */
-
-#define NEXT_CHAR_BOUNDARY(p, limit) \
- do { \
- if ((p) < (limit)) \
- (p) += BYTES_BY_CHAR_HEAD (*(p)); \
+/* Check if X is a valid charset symbol. If valid, set ID to the id
+ number of the charset. Otherwise, signal an error. */
+#define CHECK_CHARSET_GET_ID(x, id) \
+ do { \
+ int idx; \
+ \
+ if (! SYMBOLP (x) || (idx = CHARSET_SYMBOL_HASH_INDEX (x)) < 0) \
+ x = wrong_type_argument (Qcharsetp, (x)); \
+ id = XINT (AREF (HASH_VALUE (XHASH_TABLE (Vcharset_hash_table), idx), \
+ charset_id)); \
} while (0)
-/* If P is after LIMIT, advance P to the previous character boundary. */
-
-#define PREV_CHAR_BOUNDARY(p, limit) \
+/* Check if X is a valid charset symbol. If valid, set ATTR to the
+ attr vector of the charset. Otherwise, signal an error. */
+#define CHECK_CHARSET_GET_ATTR(x, attr) \
do { \
- if ((p) > (limit)) \
- { \
- const unsigned char *p0 = (p); \
- const unsigned char *p_limit = max (limit, p0 - MAX_MULTIBYTE_LENGTH);\
- do { \
- p0--; \
- } while (p0 >= p_limit && ! CHAR_HEAD_P (*p0)); \
- /* If BBCH(*p0) > p-p0, it means we were not on a boundary. */ \
- (p) = (BYTES_BY_CHAR_HEAD (*p0) >= (p) - p0) ? p0 : (p) - 1; \
- } \
+ if (!SYMBOLP (x) || NILP (attr = CHARSET_SYMBOL_ATTRIBUTES (x))) \
+ x = wrong_type_argument (Qcharsetp, (x)); \
} while (0)
-#define AT_CHAR_BOUNDARY_P(result, p, limit) \
+
+#define CHECK_CHARSET_GET_CHARSET(x, charset) \
do { \
- if (CHAR_HEAD_P (*(p)) || (p) <= limit) \
- /* Optimization for the common case. */ \
- (result) = 1; \
- else \
- { \
- const unsigned char *p_aux = (p)+1; \
- PREV_CHAR_BOUNDARY (p_aux, limit); \
- (result) = (p_aux == (p)); \
- } \
-} while (0)
-
-#ifdef emacs
-
-/* Increase the buffer byte position POS_BYTE of the current buffer to
- the next character boundary. This macro relies on the fact that
- *GPT_ADDR and *Z_ADDR are always accessible and the values are
- '\0'. No range checking of POS. */
-
-#ifdef BYTE_COMBINING_DEBUG
-
-#define INC_POS(pos_byte) \
- do { \
- unsigned char *p = BYTE_POS_ADDR (pos_byte); \
- if (BASE_LEADING_CODE_P (*p)) \
- { \
- int len, bytes; \
- len = Z_BYTE - pos_byte; \
- PARSE_MULTIBYTE_SEQ (p, len, bytes); \
- pos_byte += bytes; \
- } \
- else \
- pos_byte++; \
+ int id; \
+ CHECK_CHARSET_GET_ID (x, id); \
+ charset = CHARSET_FROM_ID (id); \
} while (0)
-#else /* not BYTE_COMBINING_DEBUG */
-#define INC_POS(pos_byte) \
- do { \
- unsigned char *p = BYTE_POS_ADDR (pos_byte); \
- pos_byte += BYTES_BY_CHAR_HEAD (*p); \
- } while (0)
+/* Lookup Vcharset_order_list and return the first charset that
+ contains the character C. */
+#define CHAR_CHARSET(c) \
+ ((c) < 0x80 ? CHARSET_FROM_ID (charset_ascii) \
+ : char_charset ((c), Qnil, NULL))
-#endif /* not BYTE_COMBINING_DEBUG */
+#if 0
+/* Char-table of charset-sets. Each element is a bool vector indexed
+ by a charset ID. */
+extern Lisp_Object Vchar_charset_set;
-/* Decrease the buffer byte position POS_BYTE of the current buffer to
- the previous character boundary. No range checking of POS. */
-#define DEC_POS(pos_byte) \
- do { \
- unsigned char *p, *p_min; \
- \
- pos_byte--; \
- if (pos_byte < GPT_BYTE) \
- p = BEG_ADDR + pos_byte - BEG_BYTE, p_min = BEG_ADDR; \
- else \
- p = BEG_ADDR + GAP_SIZE + pos_byte - BEG_BYTE, p_min = GAP_END_ADDR;\
- if (p > p_min && !CHAR_HEAD_P (*p)) \
- { \
- unsigned char *pend = p--; \
- int len, bytes; \
- if (p_min < p - MAX_MULTIBYTE_LENGTH) \
- p_min = p - MAX_MULTIBYTE_LENGTH; \
- while (p > p_min && !CHAR_HEAD_P (*p)) p--; \
- len = pend + 1 - p; \
- PARSE_MULTIBYTE_SEQ (p, len, bytes); \
- if (bytes == len) \
- pos_byte -= len - 1; \
- } \
- } while (0)
+/* Charset-bag of character C. */
+#define CHAR_CHARSET_SET(c) \
+ CHAR_TABLE_REF (Vchar_charset_set, c)
-/* Increment both CHARPOS and BYTEPOS, each in the appropriate way. */
+/* Check if two characters C1 and C2 belong to the same charset. */
+#define SAME_CHARSET_P(c1, c2) \
+ intersection_p (CHAR_CHARSET_SET (c1), CHAR_CHARSET_SET (c2))
+
+#endif
+
+
+/* Return a character correponding to the code-point CODE of CHARSET.
+ Try some optimization before calling decode_char. */
+
+#define DECODE_CHAR(charset, code) \
+ ((ASCII_BYTE_P (code) && (charset)->ascii_compatible_p) \
+ ? (code) \
+ : ((code) < (charset)->min_code || (code) > (charset)->max_code) \
+ ? -1 \
+ : (charset)->unified_p \
+ ? decode_char ((charset), (code)) \
+ : (charset)->method == CHARSET_METHOD_OFFSET \
+ ? ((charset)->code_linear_p \
+ ? (code) - (charset)->min_code + (charset)->code_offset \
+ : decode_char ((charset), (code))) \
+ : (charset)->method == CHARSET_METHOD_MAP \
+ ? ((charset)->code_linear_p \
+ ? XINT (AREF (CHARSET_DECODER (charset), \
+ (code) - (charset)->min_code)) \
+ : decode_char ((charset), (code))) \
+ : decode_char ((charset), (code)))
+
+
+/* If CHARSET is a simple offset base charset, return it's offset,
+ otherwise return -1. */
+#define CHARSET_OFFSET(charset) \
+ (((charset)->method == CHARSET_METHOD_OFFSET \
+ && (charset)->code_linear_p \
+ && ! (charset)->unified_p) \
+ ? (charset)->code_offset - (charset)->min_code \
+ : -1)
+
+extern Lisp_Object charset_work;
+
+/* Return a code point of CHAR in CHARSET.
+ Try some optimization before calling encode_char. */
+
+#define ENCODE_CHAR(charset, c) \
+ ((ASCII_CHAR_P (c) && (charset)->ascii_compatible_p) \
+ ? (c) \
+ : ((charset)->unified_p \
+ || (charset)->method == CHARSET_METHOD_SUBSET \
+ || (charset)->method == CHARSET_METHOD_SUPERSET) \
+ ? encode_char ((charset), (c)) \
+ : ((c) < (charset)->min_char || (c) > (charset)->max_char) \
+ ? (charset)->invalid_code \
+ : (charset)->method == CHARSET_METHOD_OFFSET \
+ ? ((charset)->code_linear_p \
+ ? (c) - (charset)->code_offset + (charset)->min_code \
+ : encode_char ((charset), (c))) \
+ : (charset)->method == CHARSET_METHOD_MAP \
+ ? ((charset)->compact_codes_p \
+ ? (charset_work = CHAR_TABLE_REF (CHARSET_ENCODER (charset), (c)), \
+ (NILP (charset_work) \
+ ? (charset)->invalid_code \
+ : XFASTINT (charset_work))) \
+ : encode_char ((charset), (c))) \
+ : encode_char ((charset), (c)))
+
+
+/* Set to 1 when a charset map is loaded to warn that a buffer text
+ and a string data may be relocated. */
+extern int charset_map_loaded;
+
+
+/* Set CHARSET to the charset highest priority of C, CODE to the
+ code-point of C in CHARSET. */
+#define SPLIT_CHAR(c, charset, code) \
+ ((charset) = char_charset ((c), Qnil, &(code)))
+
+
+#define ISO_MAX_DIMENSION 3
+#define ISO_MAX_CHARS 2
+#define ISO_MAX_FINAL 0x80 /* only 0x30..0xFF are used */
-#define INC_BOTH(charpos, bytepos) \
-do \
- { \
- (charpos)++; \
- if (NILP (current_buffer->enable_multibyte_characters)) \
- (bytepos)++; \
- else \
- INC_POS ((bytepos)); \
- } \
-while (0)
-
-/* Decrement both CHARPOS and BYTEPOS, each in the appropriate way. */
-
-#define DEC_BOTH(charpos, bytepos) \
-do \
- { \
- (charpos)--; \
- if (NILP (current_buffer->enable_multibyte_characters)) \
- (bytepos)--; \
- else \
- DEC_POS ((bytepos)); \
- } \
-while (0)
+/* Mapping table from ISO2022's charset (specified by DIMENSION,
+ CHARS, and FINAL_CHAR) to Emacs' charset ID. Should be accessed by
+ macro ISO_CHARSET_TABLE (DIMENSION, CHARS, FINAL_CHAR). */
+extern int iso_charset_table[ISO_MAX_DIMENSION][ISO_MAX_CHARS][ISO_MAX_FINAL];
-/* Increase the buffer byte position POS_BYTE of the current buffer to
- the next character boundary. This macro relies on the fact that
- *GPT_ADDR and *Z_ADDR are always accessible and the values are
- '\0'. No range checking of POS_BYTE. */
+/* A charset of type iso2022 who has DIMENSION, CHARS, and FINAL
+ (final character). */
+#define ISO_CHARSET_TABLE(dimension, chars_96, final) \
+ iso_charset_table[(dimension) - 1][(chars_96)][(final)]
-#ifdef BYTE_COMBINING_DEBUG
+/* Nonzero if the charset who has FAST_MAP may contain C. */
+#define CHARSET_FAST_MAP_REF(c, fast_map) \
+ ((c) < 0x10000 \
+ ? fast_map[(c) >> 10] & (1 << (((c) >> 7) & 7)) \
+ : fast_map[((c) >> 15) + 62] & (1 << (((c) >> 12) & 7)))
-#define BUF_INC_POS(buf, pos_byte) \
+#define CHARSET_FAST_MAP_SET(c, fast_map) \
do { \
- unsigned char *p = BUF_BYTE_ADDRESS (buf, pos_byte); \
- if (BASE_LEADING_CODE_P (*p)) \
- { \
- int len, bytes; \
- len = BUF_Z_BYTE (buf) - pos_byte; \
- PARSE_MULTIBYTE_SEQ (p, len, bytes); \
- pos_byte += bytes; \
- } \
+ if ((c) < 0x10000) \
+ (fast_map)[(c) >> 10] |= 1 << (((c) >> 7) & 7); \
else \
- pos_byte++; \
+ (fast_map)[((c) >> 15) + 62] |= 1 << (((c) >> 12) & 7); \
} while (0)
-#else /* not BYTE_COMBINING_DEBUG */
-#define BUF_INC_POS(buf, pos_byte) \
- do { \
- unsigned char *p = BUF_BYTE_ADDRESS (buf, pos_byte); \
- pos_byte += BYTES_BY_CHAR_HEAD (*p); \
- } while (0)
-#endif /* not BYTE_COMBINING_DEBUG */
+/* 1 if CHARSET may contain the character C. */
+#define CHAR_CHARSET_P(c, charset) \
+ ((ASCII_CHAR_P (c) && (charset)->ascii_compatible_p) \
+ || ((CHARSET_UNIFIED_P (charset) \
+ || (charset)->method == CHARSET_METHOD_SUBSET \
+ || (charset)->method == CHARSET_METHOD_SUPERSET) \
+ ? encode_char ((charset), (c)) != (charset)->invalid_code \
+ : (CHARSET_FAST_MAP_REF ((c), (charset)->fast_map) \
+ && ((charset)->method == CHARSET_METHOD_OFFSET \
+ ? (c) >= (charset)->min_char && (c) <= (charset)->max_char \
+ : ((charset)->method == CHARSET_METHOD_MAP \
+ && (charset)->compact_codes_p) \
+ ? ! NILP (CHAR_TABLE_REF (CHARSET_ENCODER (charset), (c))) \
+ : encode_char ((charset), (c)) != (charset)->invalid_code))))
-/* Decrease the buffer byte position POS_BYTE of the current buffer to
- the previous character boundary. No range checking of POS_BYTE. */
-#define BUF_DEC_POS(buf, pos_byte) \
- do { \
- unsigned char *p, *p_min; \
- pos_byte--; \
- if (pos_byte < BUF_GPT_BYTE (buf)) \
- { \
- p = BUF_BEG_ADDR (buf) + pos_byte - BEG_BYTE; \
- p_min = BUF_BEG_ADDR (buf); \
- } \
- else \
- { \
- p = BUF_BEG_ADDR (buf) + BUF_GAP_SIZE (buf) + pos_byte - BEG_BYTE;\
- p_min = BUF_GAP_END_ADDR (buf); \
- } \
- if (p > p_min && !CHAR_HEAD_P (*p)) \
- { \
- unsigned char *pend = p--; \
- int len, bytes; \
- if (p_min < p - MAX_MULTIBYTE_LENGTH) \
- p_min = p - MAX_MULTIBYTE_LENGTH; \
- while (p > p_min && !CHAR_HEAD_P (*p)) p--; \
- len = pend + 1 - p; \
- PARSE_MULTIBYTE_SEQ (p, len, bytes); \
- if (bytes == len) \
- pos_byte -= len - 1; \
- } \
- } while (0)
+\f
+/* Special macros for emacs-mule encoding. */
-#endif /* emacs */
-
-/* This is the maximum byte length of multi-byte sequence. */
-#define MAX_MULTIBYTE_LENGTH 4
-
-extern void invalid_character P_ ((int)) NO_RETURN;
-
-extern int translate_char P_ ((Lisp_Object, int, int, int, int));
-extern int split_string P_ ((const unsigned char *, int, int *,
- unsigned char *, unsigned char *));
-extern int char_to_string P_ ((int, unsigned char *));
-extern int char_to_string_1 P_ ((int, unsigned char *));
-extern int string_to_char P_ ((const unsigned char *, int, int *));
-extern int char_printable_p P_ ((int c));
-extern int multibyte_form_length P_ ((const unsigned char *, int));
-extern void parse_str_as_multibyte P_ ((const unsigned char *, int, int *,
- int *));
-extern int str_as_multibyte P_ ((unsigned char *, int, int, int *));
-extern int parse_str_to_multibyte P_ ((unsigned char *, int));
-extern int str_to_multibyte P_ ((unsigned char *, int, int));
-extern int str_as_unibyte P_ ((unsigned char *, int));
-extern int get_charset_id P_ ((Lisp_Object));
-extern int find_charset_in_text P_ ((const unsigned char *, int, int, int *,
- Lisp_Object));
-extern int strwidth P_ ((unsigned char *, int));
-extern int c_string_width P_ ((const unsigned char *, int, int, int *, int *));
-extern int lisp_string_width P_ ((Lisp_Object, int, int *, int *));
-extern int char_bytes P_ ((int));
-extern int char_valid_p P_ ((int, int));
-
-EXFUN (Funibyte_char_to_multibyte, 1);
-
-extern Lisp_Object Vtranslation_table_vector;
-
-/* Return a translation table of id number ID. */
-#define GET_TRANSLATION_TABLE(id) \
- (XCDR(XVECTOR(Vtranslation_table_vector)->contents[(id)]))
-
-/* A char-table for characters which may invoke auto-filling. */
-extern Lisp_Object Vauto_fill_chars;
-
-/* Copy LEN bytes from FROM to TO. This macro should be used only
- when a caller knows that LEN is short and the obvious copy loop is
- faster than calling bcopy which has some overhead. Copying a
- multibyte sequence of a multibyte character is the typical case. */
-
-#define BCOPY_SHORT(from, to, len) \
- do { \
- int i = len; \
- const unsigned char *from_p = from; \
- unsigned char *to_p = to; \
- while (i--) *to_p++ = *from_p++; \
- } while (0)
+/* Leading-code followed by extended leading-code. DIMENSION/COLUMN */
+#define EMACS_MULE_LEADING_CODE_PRIVATE_11 0x9A /* 1/1 */
+#define EMACS_MULE_LEADING_CODE_PRIVATE_12 0x9B /* 1/2 */
+#define EMACS_MULE_LEADING_CODE_PRIVATE_21 0x9C /* 2/2 */
+#define EMACS_MULE_LEADING_CODE_PRIVATE_22 0x9D /* 2/2 */
+
+extern struct charset *emacs_mule_charset[256];
+
+\f
+
+extern Lisp_Object Qcharsetp;
+
+extern Lisp_Object Qascii, Qunicode;
+extern int charset_ascii, charset_eight_bit;
+extern int charset_iso_8859_1;
+extern int charset_unicode;
+extern int charset_jisx0201_roman;
+extern int charset_jisx0208_1978;
+extern int charset_jisx0208;
+
+extern int charset_unibyte;
+
+extern struct charset *char_charset P_ ((int, Lisp_Object, unsigned *));
+extern Lisp_Object charset_attributes P_ ((int));
+
+extern int decode_char P_ ((struct charset *, unsigned));
+extern unsigned encode_char P_ ((struct charset *, int));
+extern int string_xstring_p P_ ((Lisp_Object));
+
+extern void map_charset_chars P_ ((void (*) (Lisp_Object, Lisp_Object),
+ Lisp_Object, Lisp_Object,
+ struct charset *, unsigned, unsigned));
+
+EXFUN (Funify_charset, 3);
#endif /* EMACS_CHARSET_H */
/* Simple built-in editing commands.
Copyright (C) 1985, 1993, 1994, 1995, 1996, 1997, 1998, 2001, 2002,
- 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ 2003, 2004, 2005, 2006, 2007, 2008
+ Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include "lisp.h"
#include "commands.h"
#include "buffer.h"
-#include "charset.h"
+#include "character.h"
#include "syntax.h"
#include "window.h"
#include "keyboard.h"
CHECK_NUMBER (n);
/* Barf if the key that invoked this was not a character. */
- if (!INTEGERP (last_command_char))
+ if (!CHARACTERP (last_command_char))
bitch_at_user ();
{
int character = translate_char (Vtranslation_table_for_input,
- XINT (last_command_char), 0, 0, 0);
+ XINT (last_command_char));
if (XINT (n) >= 2 && NILP (current_buffer->overwrite_mode))
{
int modified_char = character;
/* At first, get multi-byte form of C in STR. */
if (!NILP (current_buffer->enable_multibyte_characters))
{
- c = unibyte_char_to_multibyte (c);
len = CHAR_STRING (c, str);
if (len == 1)
/* If C has modifier bits, this makes C an appropriate
}
hairy = 2;
}
+
+ if (NILP (current_buffer->enable_multibyte_characters))
+ MAKE_CHAR_MULTIBYTE (c);
+ synt = SYNTAX (c);
+
if (!NILP (current_buffer->abbrev_mode)
- && SYNTAX (c) != Sword
+ && synt != Sword
&& NILP (current_buffer->read_only)
- && PT > BEGV && SYNTAX (XFASTINT (Fprevious_char ())) == Sword)
+ && PT > BEGV
+ && (!NILP (current_buffer->enable_multibyte_characters)
+ ? SYNTAX (XFASTINT (Fprevious_char ())) == Sword
+ : (SYNTAX (unibyte_char_to_multibyte (XFASTINT (Fprevious_char ())))
+ == Sword)))
{
int modiff = MODIFF;
Lisp_Object sym;
Vself_insert_face = Qnil;
}
- synt = SYNTAX (c);
if ((synt == Sclose || synt == Smath)
&& !NILP (Vblink_paren_function) && INTERACTIVE
&& !noautofill)
-/* Coding system handler (conversion, detection, and etc).
+/* Coding system handler (conversion, detection, etc).
Copyright (C) 2001, 2002, 2003, 2004, 2005,
- 2006, 2007 Free Software Foundation, Inc.
+ 2006, 2007, 2008 Free Software Foundation, Inc.
Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- 2005, 2006, 2007
+ 2005, 2006, 2007, 2008
National Institute of Advanced Industrial Science and Technology (AIST)
Registration Number H14PRO021
+ Copyright (C) 2003
+ National Institute of Advanced Industrial Science and Technology (AIST)
+ Registration Number H13PRO009
This file is part of GNU Emacs.
0. General comments
1. Preamble
- 2. Emacs' internal format (emacs-mule) handlers
- 3. ISO2022 handlers
- 4. Shift-JIS and BIG5 handlers
- 5. CCL handlers
- 6. End-of-line handlers
- 7. C library functions
- 8. Emacs Lisp library functions
- 9. Post-amble
+ 2. Emacs' internal format (emacs-utf-8) handlers
+ 3. UTF-8 handlers
+ 4. UTF-16 handlers
+ 5. Charset-base coding systems handlers
+ 6. emacs-mule (old Emacs' internal format) handlers
+ 7. ISO2022 handlers
+ 8. Shift-JIS and BIG5 handlers
+ 9. CCL handlers
+ 10. C library functions
+ 11. Emacs Lisp library functions
+ 12. Postamble
*/
-/*** 0. General comments ***/
+/*** 0. General comments ***
-/*** GENERAL NOTE on CODING SYSTEMS ***
+CODING SYSTEM
- A coding system is an encoding mechanism for one or more character
- sets. Here's a list of coding systems which Emacs can handle. When
- we say "decode", it means converting some other coding system to
- Emacs' internal format (emacs-mule), and when we say "encode",
- it means converting the coding system emacs-mule to some other
+ A coding system is an object for an encoding mechanism that contains
+ information about how to convert byte sequences to character
+ sequences and vice versa. When we say "decode", it means converting
+ a byte sequence of a specific coding system into a character
+ sequence that is represented by Emacs' internal coding system
+ `emacs-utf-8', and when we say "encode", it means converting a
+ character sequence of emacs-utf-8 to a byte sequence of a specific
coding system.
- 0. Emacs' internal format (emacs-mule)
+ In Emacs Lisp, a coding system is represented by a Lisp symbol. In
+ C level, a coding system is represented by a vector of attributes
+ stored in the hash table Vcharset_hash_table. The conversion from
+ coding system symbol to attributes vector is done by looking up
+ Vcharset_hash_table by the symbol.
+
+ Coding systems are classified into the following types depending on
+ the encoding mechanism. Here's a brief description of the types.
+
+ o UTF-8
+
+ o UTF-16
- Emacs itself holds a multi-lingual character in buffers and strings
- in a special format. Details are described in section 2.
+ o Charset-base coding system
- 1. ISO2022
+ A coding system defined by one or more (coded) character sets.
+ Decoding and encoding are done by a code converter defined for each
+ character set.
+
+ o Old Emacs internal format (emacs-mule)
+
+ The coding system adopted by old versions of Emacs (20 and 21).
+
+ o ISO2022-base coding system
The most famous coding system for multiple character sets. X's
- Compound Text, various EUCs (Extended Unix Code), and coding
- systems used in Internet communication such as ISO-2022-JP are
- all variants of ISO2022. Details are described in section 3.
+ Compound Text, various EUCs (Extended Unix Code), and coding systems
+ used in the Internet communication such as ISO-2022-JP are all
+ variants of ISO2022.
- 2. SJIS (or Shift-JIS or MS-Kanji-Code)
+ o SJIS (or Shift-JIS or MS-Kanji-Code)
A coding system to encode character sets: ASCII, JISX0201, and
JISX0208. Widely used for PC's in Japan. Details are described in
- section 4.
+ section 8.
- 3. BIG5
+ o BIG5
- A coding system to encode the character sets ASCII and Big5. Widely
+ A coding system to encode character sets: ASCII and Big5. Widely
used for Chinese (mainly in Taiwan and Hong Kong). Details are
- described in section 4. In this file, when we write "BIG5"
- (all uppercase), we mean the coding system, and when we write
- "Big5" (capitalized), we mean the character set.
+ described in section 8. In this file, when we write "big5" (all
+ lowercase), we mean the coding system, and when we write "Big5"
+ (capitalized), we mean the character set.
- 4. Raw text
+ o CCL
- A coding system for text containing random 8-bit code. Emacs does
- no code conversion on such text except for end-of-line format.
+ If a user wants to decode/encode text encoded in a coding system
+ not listed above, he can supply a decoder and an encoder for it in
+ CCL (Code Conversion Language) programs. Emacs executes the CCL
+ program while decoding/encoding.
- 5. Other
+ o Raw-text
- If a user wants to read/write text encoded in a coding system not
- listed above, he can supply a decoder and an encoder for it as CCL
- (Code Conversion Language) programs. Emacs executes the CCL program
- while reading/writing.
+ A coding system for text containing raw eight-bit data. Emacs
+ treats each byte of source text as a character (except for
+ end-of-line conversion).
- Emacs represents a coding system by a Lisp symbol that has a property
- `coding-system'. But, before actually using the coding system, the
- information about it is set in a structure of type `struct
- coding_system' for rapid processing. See section 6 for more details.
+ o No-conversion
-*/
+ Like raw text, but don't do end-of-line conversion.
-/*** GENERAL NOTES on END-OF-LINE FORMAT ***
- How end-of-line of text is encoded depends on the operating system.
- For instance, Unix's format is just one byte of `line-feed' code,
+END-OF-LINE FORMAT
+
+ How text end-of-line is encoded depends on operating system. For
+ instance, Unix's format is just one byte of LF (line-feed) code,
whereas DOS's format is two-byte sequence of `carriage-return' and
`line-feed' codes. MacOS's format is usually one byte of
`carriage-return'.
Since text character encoding and end-of-line encoding are
- independent, any coding system described above can have any
- end-of-line format. So Emacs has information about end-of-line
- format in each coding-system. See section 6 for more details.
+ independent, any coding system described above can take any format
+ of end-of-line (except for no-conversion).
+
+STRUCT CODING_SYSTEM
+
+ Before using a coding system for code conversion (i.e. decoding and
+ encoding), we setup a structure of type `struct coding_system'.
+ This structure keeps various information about a specific code
+ conversion (e.g. the location of source and destination data).
*/
+/* COMMON MACROS */
+
+
/*** GENERAL NOTES on `detect_coding_XXX ()' functions ***
- These functions check if a text between SRC and SRC_END is encoded
- in the coding system category XXX. Each returns an integer value in
- which appropriate flag bits for the category XXX are set. The flag
- bits are defined in macros CODING_CATEGORY_MASK_XXX. Below is the
- template for these functions. If MULTIBYTEP is nonzero, 8-bit codes
- of the range 0x80..0x9F are in multibyte form. */
+ These functions check if a byte sequence specified as a source in
+ CODING conforms to the format of XXX, and update the members of
+ DETECT_INFO.
+
+ Return 1 if the byte sequence conforms to XXX, otherwise return 0.
+
+ Below is the template of these functions. */
+
#if 0
-int
-detect_coding_emacs_mule (src, src_end, multibytep)
- unsigned char *src, *src_end;
- int multibytep;
+static int
+detect_coding_XXX (coding, detect_info)
+ struct coding_system *coding;
+ struct coding_detection_info *detect_info;
{
- ...
+ const unsigned char *src = coding->source;
+ const unsigned char *src_end = coding->source + coding->src_bytes;
+ int multibytep = coding->src_multibyte;
+ int consumed_chars = 0;
+ int found = 0;
+ ...;
+
+ while (1)
+ {
+ /* Get one byte from the source. If the souce is exausted, jump
+ to no_more_source:. */
+ ONE_MORE_BYTE (c);
+
+ if (! __C_conforms_to_XXX___ (c))
+ break;
+ if (! __C_strongly_suggests_XXX__ (c))
+ found = CATEGORY_MASK_XXX;
+ }
+ /* The byte sequence is invalid for XXX. */
+ detect_info->rejected |= CATEGORY_MASK_XXX;
+ return 0;
+
+ no_more_source:
+ /* The source exausted successfully. */
+ detect_info->found |= found;
+ return 1;
}
#endif
/*** GENERAL NOTES on `decode_coding_XXX ()' functions ***
- These functions decode SRC_BYTES length of unibyte text at SOURCE
- encoded in CODING to Emacs' internal format. The resulting
- multibyte text goes to a place pointed to by DESTINATION, the length
- of which should not exceed DST_BYTES.
+ These functions decode a byte sequence specified as a source by
+ CODING. The resulting multibyte text goes to a place pointed to by
+ CODING->charbuf, the length of which should not exceed
+ CODING->charbuf_size;
- These functions set the information about original and decoded texts
- in the members `produced', `produced_char', `consumed', and
- `consumed_char' of the structure *CODING. They also set the member
- `result' to one of CODING_FINISH_XXX indicating how the decoding
- finished.
+ These functions set the information of original and decoded texts in
+ CODING->consumed, CODING->consumed_char, and CODING->charbuf_used.
+ They also set CODING->result to one of CODING_RESULT_XXX indicating
+ how the decoding is finished.
- DST_BYTES zero means that the source area and destination area are
- overlapped, which means that we can produce a decoded text until it
- reaches the head of the not-yet-decoded source text.
+ Below is the template of these functions. */
- Below is a template for these functions. */
#if 0
static void
-decode_coding_XXX (coding, source, destination, src_bytes, dst_bytes)
+decode_coding_XXXX (coding)
struct coding_system *coding;
- const unsigned char *source;
- unsigned char *destination;
- int src_bytes, dst_bytes;
{
- ...
+ const unsigned char *src = coding->source + coding->consumed;
+ const unsigned char *src_end = coding->source + coding->src_bytes;
+ /* SRC_BASE remembers the start position in source in each loop.
+ The loop will be exited when there's not enough source code, or
+ when there's no room in CHARBUF for a decoded character. */
+ const unsigned char *src_base;
+ /* A buffer to produce decoded characters. */
+ int *charbuf = coding->charbuf + coding->charbuf_used;
+ int *charbuf_end = coding->charbuf + coding->charbuf_size;
+ int multibytep = coding->src_multibyte;
+
+ while (1)
+ {
+ src_base = src;
+ if (charbuf < charbuf_end)
+ /* No more room to produce a decoded character. */
+ break;
+ ONE_MORE_BYTE (c);
+ /* Decode it. */
+ }
+
+ no_more_source:
+ if (src_base < src_end
+ && coding->mode & CODING_MODE_LAST_BLOCK)
+ /* If the source ends by partial bytes to construct a character,
+ treat them as eight-bit raw data. */
+ while (src_base < src_end && charbuf < charbuf_end)
+ *charbuf++ = *src_base++;
+ /* Remember how many bytes and characters we consumed. If the
+ source is multibyte, the bytes and chars are not identical. */
+ coding->consumed = coding->consumed_char = src_base - coding->source;
+ /* Remember how many characters we produced. */
+ coding->charbuf_used = charbuf - coding->charbuf;
}
#endif
/*** GENERAL NOTES on `encode_coding_XXX ()' functions ***
- These functions encode SRC_BYTES length text at SOURCE from Emacs'
- internal multibyte format to CODING. The resulting unibyte text
+ These functions encode SRC_BYTES length text at SOURCE of Emacs'
+ internal multibyte format by CODING. The resulting byte sequence
goes to a place pointed to by DESTINATION, the length of which
should not exceed DST_BYTES.
- These functions set the information about original and encoded texts
- in the members `produced', `produced_char', `consumed', and
- `consumed_char' of the structure *CODING. They also set the member
- `result' to one of CODING_FINISH_XXX indicating how the encoding
- finished.
+ These functions set the information of original and encoded texts in
+ the members produced, produced_char, consumed, and consumed_char of
+ the structure *CODING. They also set the member result to one of
+ CODING_RESULT_XXX indicating how the encoding finished.
- DST_BYTES zero means that the source area and destination area are
- overlapped, which means that we can produce encoded text until it
- reaches at the head of the not-yet-encoded source text.
+ DST_BYTES zero means that source area and destination area are
+ overlapped, which means that we can produce a encoded text until it
+ reaches at the head of not-yet-encoded source text.
- Below is a template for these functions. */
+ Below is a template of these functions. */
#if 0
static void
-encode_coding_XXX (coding, source, destination, src_bytes, dst_bytes)
+encode_coding_XXX (coding)
struct coding_system *coding;
- unsigned char *source, *destination;
- int src_bytes, dst_bytes;
{
- ...
+ int multibytep = coding->dst_multibyte;
+ int *charbuf = coding->charbuf;
+ int *charbuf_end = charbuf->charbuf + coding->charbuf_used;
+ unsigned char *dst = coding->destination + coding->produced;
+ unsigned char *dst_end = coding->destination + coding->dst_bytes;
+ unsigned char *adjusted_dst_end = dst_end - _MAX_BYTES_PRODUCED_IN_LOOP_;
+ int produced_chars = 0;
+
+ for (; charbuf < charbuf_end && dst < adjusted_dst_end; charbuf++)
+ {
+ int c = *charbuf;
+ /* Encode C into DST, and increment DST. */
+ }
+ label_no_more_destination:
+ /* How many chars and bytes we produced. */
+ coding->produced_char += produced_chars;
+ coding->produced = dst - coding->destination;
}
#endif
-/*** COMMONLY USED MACROS ***/
-
-/* The following two macros ONE_MORE_BYTE and TWO_MORE_BYTES safely
- get one, two, and three bytes from the source text respectively.
- If there are not enough bytes in the source, they jump to
- `label_end_of_loop'. The caller should set variables `coding',
- `src' and `src_end' to appropriate pointer in advance. These
- macros are called from decoding routines `decode_coding_XXX', thus
- it is assumed that the source text is unibyte. */
-
-#define ONE_MORE_BYTE(c1) \
- do { \
- if (src >= src_end) \
- { \
- coding->result = CODING_FINISH_INSUFFICIENT_SRC; \
- goto label_end_of_loop; \
- } \
- c1 = *src++; \
- } while (0)
-
-#define TWO_MORE_BYTES(c1, c2) \
- do { \
- if (src + 1 >= src_end) \
- { \
- coding->result = CODING_FINISH_INSUFFICIENT_SRC; \
- goto label_end_of_loop; \
- } \
- c1 = *src++; \
- c2 = *src++; \
- } while (0)
-
-
-/* Like ONE_MORE_BYTE, but 8-bit bytes of data at SRC are in multibyte
- form if MULTIBYTEP is nonzero. In addition, if SRC is not less
- than SRC_END, return with RET. */
-
-#define ONE_MORE_BYTE_CHECK_MULTIBYTE(c1, multibytep, ret) \
- do { \
- if (src >= src_end) \
- { \
- coding->result = CODING_FINISH_INSUFFICIENT_SRC; \
- return ret; \
- } \
- c1 = *src++; \
- if (multibytep && c1 == LEADING_CODE_8_BIT_CONTROL) \
- c1 = *src++ - 0x20; \
- } while (0)
-
-/* Set C to the next character at the source text pointed by `src'.
- If there are not enough characters in the source, jump to
- `label_end_of_loop'. The caller should set variables `coding'
- `src', `src_end', and `translation_table' to appropriate pointers
- in advance. This macro is used in encoding routines
- `encode_coding_XXX', thus it assumes that the source text is in
- multibyte form except for 8-bit characters. 8-bit characters are
- in multibyte form if coding->src_multibyte is nonzero, else they
- are represented by a single byte. */
-
-#define ONE_MORE_CHAR(c) \
- do { \
- int len = src_end - src; \
- int bytes; \
- if (len <= 0) \
- { \
- coding->result = CODING_FINISH_INSUFFICIENT_SRC; \
- goto label_end_of_loop; \
- } \
- if (coding->src_multibyte \
- || UNIBYTE_STR_AS_MULTIBYTE_P (src, len, bytes)) \
- c = STRING_CHAR_AND_LENGTH (src, len, bytes); \
- else \
- c = *src, bytes = 1; \
- if (!NILP (translation_table)) \
- c = translate_char (translation_table, c, -1, 0, 0); \
- src += bytes; \
- } while (0)
-
-
-/* Produce a multibyte form of character C to `dst'. Jump to
- `label_end_of_loop' if there's not enough space at `dst'.
-
- If we are now in the middle of a composition sequence, the decoded
- character may be ALTCHAR (for the current composition). In that
- case, the character goes to coding->cmp_data->data instead of
- `dst'.
-
- This macro is used in decoding routines. */
-
-#define EMIT_CHAR(c) \
- do { \
- if (! COMPOSING_P (coding) \
- || coding->composing == COMPOSITION_RELATIVE \
- || coding->composing == COMPOSITION_WITH_RULE) \
- { \
- int bytes = CHAR_BYTES (c); \
- if ((dst + bytes) > (dst_bytes ? dst_end : src)) \
- { \
- coding->result = CODING_FINISH_INSUFFICIENT_DST; \
- goto label_end_of_loop; \
- } \
- dst += CHAR_STRING (c, dst); \
- coding->produced_char++; \
- } \
- \
- if (COMPOSING_P (coding) \
- && coding->composing != COMPOSITION_RELATIVE) \
- { \
- CODING_ADD_COMPOSITION_COMPONENT (coding, c); \
- coding->composition_rule_follows \
- = coding->composing != COMPOSITION_WITH_ALTCHARS; \
- } \
- } while (0)
-
-
-#define EMIT_ONE_BYTE(c) \
- do { \
- if (dst >= (dst_bytes ? dst_end : src)) \
- { \
- coding->result = CODING_FINISH_INSUFFICIENT_DST; \
- goto label_end_of_loop; \
- } \
- *dst++ = c; \
- } while (0)
-
-#define EMIT_TWO_BYTES(c1, c2) \
- do { \
- if (dst + 2 > (dst_bytes ? dst_end : src)) \
- { \
- coding->result = CODING_FINISH_INSUFFICIENT_DST; \
- goto label_end_of_loop; \
- } \
- *dst++ = c1, *dst++ = c2; \
- } while (0)
-
-#define EMIT_BYTES(from, to) \
- do { \
- if (dst + (to - from) > (dst_bytes ? dst_end : src)) \
- { \
- coding->result = CODING_FINISH_INSUFFICIENT_DST; \
- goto label_end_of_loop; \
- } \
- while (from < to) \
- *dst++ = *from++; \
- } while (0)
-
\f
/*** 1. Preamble ***/
-#ifdef emacs
#include <config.h>
-#endif
-
#include <stdio.h>
-#ifdef emacs
-
#include "lisp.h"
#include "buffer.h"
+#include "character.h"
#include "charset.h"
-#include "composite.h"
#include "ccl.h"
+#include "composite.h"
#include "coding.h"
#include "window.h"
-#include "intervals.h"
#include "frame.h"
#include "termhooks.h"
-#else /* not emacs */
-
-#include "mulelib.h"
+Lisp_Object Vcoding_system_hash_table;
-#endif /* not emacs */
-
-Lisp_Object Qcoding_system, Qeol_type;
+Lisp_Object Qcoding_system, Qcoding_aliases, Qeol_type;
+Lisp_Object Qunix, Qdos;
+extern Lisp_Object Qmac; /* frame.c */
Lisp_Object Qbuffer_file_coding_system;
Lisp_Object Qpost_read_conversion, Qpre_write_conversion;
+Lisp_Object Qdefault_char;
Lisp_Object Qno_conversion, Qundecided;
+Lisp_Object Qcharset, Qiso_2022, Qutf_8, Qutf_16, Qshift_jis, Qbig5;
+Lisp_Object Qbig, Qlittle;
Lisp_Object Qcoding_system_history;
-Lisp_Object Qsafe_chars;
Lisp_Object Qvalid_codes;
-Lisp_Object Qascii_incompatible;
+Lisp_Object QCcategory, QCmnemonic, QCdefalut_char;
+Lisp_Object QCdecode_translation_table, QCencode_translation_table;
+Lisp_Object QCpost_read_conversion, QCpre_write_conversion;
+Lisp_Object QCascii_compatible_p;
extern Lisp_Object Qinsert_file_contents, Qwrite_region;
Lisp_Object Qcall_process, Qcall_process_region;
Lisp_Object Qstart_process, Qopen_network_stream;
Lisp_Object Qtarget_idx;
+Lisp_Object Qinsufficient_source, Qinconsistent_eol, Qinvalid_source;
+Lisp_Object Qinterrupted, Qinsufficient_memory;
+
extern Lisp_Object Qcompletion_ignore_case;
/* If a symbol has this property, evaluate the value to define the
symbol as a coding system. */
-Lisp_Object Qcoding_system_define_form;
-
-Lisp_Object Vselect_safe_coding_system_function;
+static Lisp_Object Qcoding_system_define_form;
int coding_system_require_warning;
+Lisp_Object Vselect_safe_coding_system_function;
+
/* Mnemonic string for each format of end-of-line. */
Lisp_Object eol_mnemonic_unix, eol_mnemonic_dos, eol_mnemonic_mac;
/* Mnemonic string to indicate format of end-of-line is not yet
decided. */
Lisp_Object eol_mnemonic_undecided;
-/* Format of end-of-line decided by system. This is CODING_EOL_LF on
- Unix, CODING_EOL_CRLF on DOS/Windows, and CODING_EOL_CR on Mac.
+/* Format of end-of-line decided by system. This is Qunix on
+ Unix and Mac, Qdos on DOS/Windows.
This has an effect only for external encoding (i.e. for output to
file and process), not for in-buffer or Lisp string encoding. */
-int system_eol_type;
+static Lisp_Object system_eol_type;
#ifdef emacs
-/* Information about which coding system is safe for which chars.
- The value has the form (GENERIC-LIST . NON-GENERIC-ALIST).
-
- GENERIC-LIST is a list of generic coding systems which can encode
- any characters.
-
- NON-GENERIC-ALIST is an alist of non generic coding systems vs the
- corresponding char table that contains safe chars. */
-Lisp_Object Vcoding_system_safe_chars;
-
Lisp_Object Vcoding_system_list, Vcoding_system_alist;
Lisp_Object Qcoding_system_p, Qcoding_system_error;
/* Coding system emacs-mule and raw-text are for converting only
end-of-line format. */
Lisp_Object Qemacs_mule, Qraw_text;
-
-Lisp_Object Qutf_8;
+Lisp_Object Qutf_8_emacs;
/* Coding-systems are handed between Emacs Lisp programs and C internal
routines by the following three variables. */
Lisp_Object Vcoding_system_for_write;
/* Coding-system actually used in the latest I/O. */
Lisp_Object Vlast_coding_system_used;
-
+/* Set to non-nil when an error is detected while code conversion. */
+Lisp_Object Vlast_code_conversion_error;
/* A vector of length 256 which contains information about special
Latin codes (especially for dealing with Microsoft codes). */
Lisp_Object Vlatin_extra_code_table;
terminal coding system is nil. */
struct coding_system safe_terminal_coding;
-/* Default coding system to be used to write a file. */
-struct coding_system default_buffer_file_coding;
-
Lisp_Object Vfile_coding_system_alist;
Lisp_Object Vprocess_coding_system_alist;
Lisp_Object Vnetwork_coding_system_alist;
#endif /* emacs */
-Lisp_Object Qcoding_category, Qcoding_category_index;
-
-/* List of symbols `coding-category-xxx' ordered by priority. */
-Lisp_Object Vcoding_category_list;
-
-/* Table of coding categories (Lisp symbols). */
-Lisp_Object Vcoding_category_table;
-
-/* Table of names of symbol for each coding-category. */
-char *coding_category_name[CODING_CATEGORY_IDX_MAX] = {
- "coding-category-emacs-mule",
- "coding-category-sjis",
- "coding-category-iso-7",
- "coding-category-iso-7-tight",
- "coding-category-iso-8-1",
- "coding-category-iso-8-2",
- "coding-category-iso-7-else",
- "coding-category-iso-8-else",
- "coding-category-ccl",
- "coding-category-big5",
- "coding-category-utf-8",
- "coding-category-utf-16-be",
- "coding-category-utf-16-le",
- "coding-category-raw-text",
- "coding-category-binary"
-};
-
-/* Table of pointers to coding systems corresponding to each coding
- categories. */
-struct coding_system *coding_system_table[CODING_CATEGORY_IDX_MAX];
-
-/* Table of coding category masks. Nth element is a mask for a coding
- category of which priority is Nth. */
-static
-int coding_priorities[CODING_CATEGORY_IDX_MAX];
-
/* Flag to tell if we look up translation table on character code
conversion. */
Lisp_Object Venable_character_translation;
Lisp_Object Qtranslation_table_for_encode;
/* Alist of charsets vs revision number. */
-Lisp_Object Vcharset_revision_alist;
+static Lisp_Object Vcharset_revision_table;
/* Default coding systems used for process I/O. */
Lisp_Object Vdefault_process_coding_system;
/* Char table for translating Quail and self-inserting input. */
Lisp_Object Vtranslation_table_for_input;
-/* Global flag to tell that we can't call post-read-conversion and
- pre-write-conversion functions. Usually the value is zero, but it
- is set to 1 temporarily while such functions are running. This is
- to avoid infinite recursive call. */
-static int inhibit_pre_post_conversion;
+/* Two special coding systems. */
+Lisp_Object Vsjis_coding_system;
+Lisp_Object Vbig5_coding_system;
+
+/* ISO2022 section */
+
+#define CODING_ISO_INITIAL(coding, reg) \
+ (XINT (AREF (AREF (CODING_ID_ATTRS ((coding)->id), \
+ coding_attr_iso_initial), \
+ reg)))
+
+
+#define CODING_ISO_REQUEST(coding, charset_id) \
+ ((charset_id <= (coding)->max_charset_id \
+ ? (coding)->safe_charsets[charset_id] \
+ : -1))
+
+
+#define CODING_ISO_FLAGS(coding) \
+ ((coding)->spec.iso_2022.flags)
+#define CODING_ISO_DESIGNATION(coding, reg) \
+ ((coding)->spec.iso_2022.current_designation[reg])
+#define CODING_ISO_INVOCATION(coding, plane) \
+ ((coding)->spec.iso_2022.current_invocation[plane])
+#define CODING_ISO_SINGLE_SHIFTING(coding) \
+ ((coding)->spec.iso_2022.single_shifting)
+#define CODING_ISO_BOL(coding) \
+ ((coding)->spec.iso_2022.bol)
+#define CODING_ISO_INVOKED_CHARSET(coding, plane) \
+ CODING_ISO_DESIGNATION ((coding), CODING_ISO_INVOCATION ((coding), (plane)))
+
+/* Control characters of ISO2022. */
+ /* code */ /* function */
+#define ISO_CODE_LF 0x0A /* line-feed */
+#define ISO_CODE_CR 0x0D /* carriage-return */
+#define ISO_CODE_SO 0x0E /* shift-out */
+#define ISO_CODE_SI 0x0F /* shift-in */
+#define ISO_CODE_SS2_7 0x19 /* single-shift-2 for 7-bit code */
+#define ISO_CODE_ESC 0x1B /* escape */
+#define ISO_CODE_SS2 0x8E /* single-shift-2 */
+#define ISO_CODE_SS3 0x8F /* single-shift-3 */
+#define ISO_CODE_CSI 0x9B /* control-sequence-introducer */
+
+/* All code (1-byte) of ISO2022 is classified into one of the
+ followings. */
+enum iso_code_class_type
+ {
+ ISO_control_0, /* Control codes in the range
+ 0x00..0x1F and 0x7F, except for the
+ following 5 codes. */
+ ISO_shift_out, /* ISO_CODE_SO (0x0E) */
+ ISO_shift_in, /* ISO_CODE_SI (0x0F) */
+ ISO_single_shift_2_7, /* ISO_CODE_SS2_7 (0x19) */
+ ISO_escape, /* ISO_CODE_SO (0x1B) */
+ ISO_control_1, /* Control codes in the range
+ 0x80..0x9F, except for the
+ following 3 codes. */
+ ISO_single_shift_2, /* ISO_CODE_SS2 (0x8E) */
+ ISO_single_shift_3, /* ISO_CODE_SS3 (0x8F) */
+ ISO_control_sequence_introducer, /* ISO_CODE_CSI (0x9B) */
+ ISO_0x20_or_0x7F, /* Codes of the values 0x20 or 0x7F. */
+ ISO_graphic_plane_0, /* Graphic codes in the range 0x21..0x7E. */
+ ISO_0xA0_or_0xFF, /* Codes of the values 0xA0 or 0xFF. */
+ ISO_graphic_plane_1 /* Graphic codes in the range 0xA1..0xFE. */
+ };
-Lisp_Object Qchar_coding_system;
+/** The macros CODING_ISO_FLAG_XXX defines a flag bit of the
+ `iso-flags' attribute of an iso2022 coding system. */
-/* Return `safe-chars' property of CODING_SYSTEM (symbol). Don't check
- its validity. */
+/* If set, produce long-form designation sequence (e.g. ESC $ ( A)
+ instead of the correct short-form sequence (e.g. ESC $ A). */
+#define CODING_ISO_FLAG_LONG_FORM 0x0001
-Lisp_Object
-coding_safe_chars (coding_system)
- Lisp_Object coding_system;
-{
- Lisp_Object coding_spec, plist, safe_chars;
+/* If set, reset graphic planes and registers at end-of-line to the
+ initial state. */
+#define CODING_ISO_FLAG_RESET_AT_EOL 0x0002
- coding_spec = Fget (coding_system, Qcoding_system);
- plist = XVECTOR (coding_spec)->contents[3];
- safe_chars = Fplist_get (XVECTOR (coding_spec)->contents[3], Qsafe_chars);
- return (CHAR_TABLE_P (safe_chars) ? safe_chars : Qt);
-}
+/* If set, reset graphic planes and registers before any control
+ characters to the initial state. */
+#define CODING_ISO_FLAG_RESET_AT_CNTL 0x0004
-#define CODING_SAFE_CHAR_P(safe_chars, c) \
- (EQ (safe_chars, Qt) || !NILP (CHAR_TABLE_REF (safe_chars, c)))
+/* If set, encode by 7-bit environment. */
+#define CODING_ISO_FLAG_SEVEN_BITS 0x0008
-\f
-/*** 2. Emacs internal format (emacs-mule) handlers ***/
+/* If set, use locking-shift function. */
+#define CODING_ISO_FLAG_LOCKING_SHIFT 0x0010
-/* Emacs' internal format for representation of multiple character
- sets is a kind of multi-byte encoding, i.e. characters are
- represented by variable-length sequences of one-byte codes.
+/* If set, use single-shift function. Overwrite
+ CODING_ISO_FLAG_LOCKING_SHIFT. */
+#define CODING_ISO_FLAG_SINGLE_SHIFT 0x0020
- ASCII characters and control characters (e.g. `tab', `newline') are
- represented by one-byte sequences which are their ASCII codes, in
- the range 0x00 through 0x7F.
+/* If set, use designation escape sequence. */
+#define CODING_ISO_FLAG_DESIGNATION 0x0040
- 8-bit characters of the range 0x80..0x9F are represented by
- two-byte sequences of LEADING_CODE_8_BIT_CONTROL and (their 8-bit
- code + 0x20).
+/* If set, produce revision number sequence. */
+#define CODING_ISO_FLAG_REVISION 0x0080
- 8-bit characters of the range 0xA0..0xFF are represented by
- one-byte sequences which are their 8-bit code.
+/* If set, produce ISO6429's direction specifying sequence. */
+#define CODING_ISO_FLAG_DIRECTION 0x0100
- The other characters are represented by a sequence of `base
- leading-code', optional `extended leading-code', and one or two
- `position-code's. The length of the sequence is determined by the
- base leading-code. Leading-code takes the range 0x81 through 0x9D,
- whereas extended leading-code and position-code take the range 0xA0
- through 0xFF. See `charset.h' for more details about leading-code
- and position-code.
+/* If set, assume designation states are reset at beginning of line on
+ output. */
+#define CODING_ISO_FLAG_INIT_AT_BOL 0x0200
- --- CODE RANGE of Emacs' internal format ---
- character set range
- ------------- -----
- ascii 0x00..0x7F
- eight-bit-control LEADING_CODE_8_BIT_CONTROL + 0xA0..0xBF
- eight-bit-graphic 0xA0..0xBF
- ELSE 0x81..0x9D + [0xA0..0xFF]+
- ---------------------------------------------
+/* If set, designation sequence should be placed at beginning of line
+ on output. */
+#define CODING_ISO_FLAG_DESIGNATE_AT_BOL 0x0400
- As this is the internal character representation, the format is
- usually not used externally (i.e. in a file or in a data sent to a
- process). But, it is possible to have a text externally in this
- format (i.e. by encoding by the coding system `emacs-mule').
+/* If set, do not encode unsafe charactes on output. */
+#define CODING_ISO_FLAG_SAFE 0x0800
- In that case, a sequence of one-byte codes has a slightly different
- form.
+/* If set, extra latin codes (128..159) are accepted as a valid code
+ on input. */
+#define CODING_ISO_FLAG_LATIN_EXTRA 0x1000
- Firstly, all characters in eight-bit-control are represented by
- one-byte sequences which are their 8-bit code.
+#define CODING_ISO_FLAG_COMPOSITION 0x2000
- Next, character composition data are represented by the byte
- sequence of the form: 0x80 METHOD BYTES CHARS COMPONENT ...,
- where,
- METHOD is 0xF0 plus one of composition method (enum
- composition_method),
+#define CODING_ISO_FLAG_EUC_TW_SHIFT 0x4000
- BYTES is 0xA0 plus the byte length of these composition data,
+#define CODING_ISO_FLAG_USE_ROMAN 0x8000
- CHARS is 0xA0 plus the number of characters composed by these
- data,
+#define CODING_ISO_FLAG_USE_OLDJIS 0x10000
- COMPONENTs are characters of multibyte form or composition
- rules encoded by two-byte of ASCII codes.
+#define CODING_ISO_FLAG_FULL_SUPPORT 0x100000
- In addition, for backward compatibility, the following formats are
- also recognized as composition data on decoding.
+/* A character to be produced on output if encoding of the original
+ character is prohibited by CODING_ISO_FLAG_SAFE. */
+#define CODING_INHIBIT_CHARACTER_SUBSTITUTION '?'
- 0x80 MSEQ ...
- 0x80 0xFF MSEQ RULE MSEQ RULE ... MSEQ
- Here,
- MSEQ is a multibyte form but in these special format:
- ASCII: 0xA0 ASCII_CODE+0x80,
- other: LEADING_CODE+0x20 FOLLOWING-BYTE ...,
- RULE is a one byte code of the range 0xA0..0xF0 that
- represents a composition rule.
- */
+/* UTF-16 section */
+#define CODING_UTF_16_BOM(coding) \
+ ((coding)->spec.utf_16.bom)
-enum emacs_code_class_type emacs_code_class[256];
+#define CODING_UTF_16_ENDIAN(coding) \
+ ((coding)->spec.utf_16.endian)
-/* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions".
- Check if a text is encoded in Emacs' internal format. If it is,
- return CODING_CATEGORY_MASK_EMACS_MULE, else return 0. */
+#define CODING_UTF_16_SURROGATE(coding) \
+ ((coding)->spec.utf_16.surrogate)
-static int
-detect_coding_emacs_mule (src, src_end, multibytep)
- unsigned char *src, *src_end;
- int multibytep;
-{
- unsigned char c;
- int composing = 0;
- /* Dummy for ONE_MORE_BYTE. */
- struct coding_system dummy_coding;
- struct coding_system *coding = &dummy_coding;
- while (1)
- {
- ONE_MORE_BYTE_CHECK_MULTIBYTE (c, multibytep,
- CODING_CATEGORY_MASK_EMACS_MULE);
- if (composing)
- {
- if (c < 0xA0)
- composing = 0;
- else if (c == 0xA0)
- {
- ONE_MORE_BYTE_CHECK_MULTIBYTE (c, multibytep, 0);
- c &= 0x7F;
- }
- else
- c -= 0x20;
- }
+/* CCL section */
+#define CODING_CCL_DECODER(coding) \
+ AREF (CODING_ID_ATTRS ((coding)->id), coding_attr_ccl_decoder)
+#define CODING_CCL_ENCODER(coding) \
+ AREF (CODING_ID_ATTRS ((coding)->id), coding_attr_ccl_encoder)
+#define CODING_CCL_VALIDS(coding) \
+ (SDATA (AREF (CODING_ID_ATTRS ((coding)->id), coding_attr_ccl_valids)))
- if (c < 0x20)
- {
- if (c == ISO_CODE_ESC || c == ISO_CODE_SI || c == ISO_CODE_SO)
- return 0;
- }
- else if (c >= 0x80 && c < 0xA0)
- {
- if (c == 0x80)
- /* Old leading code for a composite character. */
- composing = 1;
- else
- {
- unsigned char *src_base = src - 1;
- int bytes;
+/* Index for each coding category in `coding_categories' */
- if (!UNIBYTE_STR_AS_MULTIBYTE_P (src_base, src_end - src_base,
- bytes))
- return 0;
- src = src_base + bytes;
- }
- }
- }
-}
+enum coding_category
+ {
+ coding_category_iso_7,
+ coding_category_iso_7_tight,
+ coding_category_iso_8_1,
+ coding_category_iso_8_2,
+ coding_category_iso_7_else,
+ coding_category_iso_8_else,
+ coding_category_utf_8,
+ coding_category_utf_16_auto,
+ coding_category_utf_16_be,
+ coding_category_utf_16_le,
+ coding_category_utf_16_be_nosig,
+ coding_category_utf_16_le_nosig,
+ coding_category_charset,
+ coding_category_sjis,
+ coding_category_big5,
+ coding_category_ccl,
+ coding_category_emacs_mule,
+ /* All above are targets of code detection. */
+ coding_category_raw_text,
+ coding_category_undecided,
+ coding_category_max
+ };
+
+/* Definitions of flag bits used in detect_coding_XXXX. */
+#define CATEGORY_MASK_ISO_7 (1 << coding_category_iso_7)
+#define CATEGORY_MASK_ISO_7_TIGHT (1 << coding_category_iso_7_tight)
+#define CATEGORY_MASK_ISO_8_1 (1 << coding_category_iso_8_1)
+#define CATEGORY_MASK_ISO_8_2 (1 << coding_category_iso_8_2)
+#define CATEGORY_MASK_ISO_7_ELSE (1 << coding_category_iso_7_else)
+#define CATEGORY_MASK_ISO_8_ELSE (1 << coding_category_iso_8_else)
+#define CATEGORY_MASK_UTF_8 (1 << coding_category_utf_8)
+#define CATEGORY_MASK_UTF_16_AUTO (1 << coding_category_utf_16_auto)
+#define CATEGORY_MASK_UTF_16_BE (1 << coding_category_utf_16_be)
+#define CATEGORY_MASK_UTF_16_LE (1 << coding_category_utf_16_le)
+#define CATEGORY_MASK_UTF_16_BE_NOSIG (1 << coding_category_utf_16_be_nosig)
+#define CATEGORY_MASK_UTF_16_LE_NOSIG (1 << coding_category_utf_16_le_nosig)
+#define CATEGORY_MASK_CHARSET (1 << coding_category_charset)
+#define CATEGORY_MASK_SJIS (1 << coding_category_sjis)
+#define CATEGORY_MASK_BIG5 (1 << coding_category_big5)
+#define CATEGORY_MASK_CCL (1 << coding_category_ccl)
+#define CATEGORY_MASK_EMACS_MULE (1 << coding_category_emacs_mule)
+#define CATEGORY_MASK_RAW_TEXT (1 << coding_category_raw_text)
+
+/* This value is returned if detect_coding_mask () find nothing other
+ than ASCII characters. */
+#define CATEGORY_MASK_ANY \
+ (CATEGORY_MASK_ISO_7 \
+ | CATEGORY_MASK_ISO_7_TIGHT \
+ | CATEGORY_MASK_ISO_8_1 \
+ | CATEGORY_MASK_ISO_8_2 \
+ | CATEGORY_MASK_ISO_7_ELSE \
+ | CATEGORY_MASK_ISO_8_ELSE \
+ | CATEGORY_MASK_UTF_8 \
+ | CATEGORY_MASK_UTF_16_BE \
+ | CATEGORY_MASK_UTF_16_LE \
+ | CATEGORY_MASK_UTF_16_BE_NOSIG \
+ | CATEGORY_MASK_UTF_16_LE_NOSIG \
+ | CATEGORY_MASK_CHARSET \
+ | CATEGORY_MASK_SJIS \
+ | CATEGORY_MASK_BIG5 \
+ | CATEGORY_MASK_CCL \
+ | CATEGORY_MASK_EMACS_MULE)
+
+
+#define CATEGORY_MASK_ISO_7BIT \
+ (CATEGORY_MASK_ISO_7 | CATEGORY_MASK_ISO_7_TIGHT)
+
+#define CATEGORY_MASK_ISO_8BIT \
+ (CATEGORY_MASK_ISO_8_1 | CATEGORY_MASK_ISO_8_2)
+
+#define CATEGORY_MASK_ISO_ELSE \
+ (CATEGORY_MASK_ISO_7_ELSE | CATEGORY_MASK_ISO_8_ELSE)
+
+#define CATEGORY_MASK_ISO_ESCAPE \
+ (CATEGORY_MASK_ISO_7 \
+ | CATEGORY_MASK_ISO_7_TIGHT \
+ | CATEGORY_MASK_ISO_7_ELSE \
+ | CATEGORY_MASK_ISO_8_ELSE)
+
+#define CATEGORY_MASK_ISO \
+ ( CATEGORY_MASK_ISO_7BIT \
+ | CATEGORY_MASK_ISO_8BIT \
+ | CATEGORY_MASK_ISO_ELSE)
+
+#define CATEGORY_MASK_UTF_16 \
+ (CATEGORY_MASK_UTF_16_BE \
+ | CATEGORY_MASK_UTF_16_LE \
+ | CATEGORY_MASK_UTF_16_BE_NOSIG \
+ | CATEGORY_MASK_UTF_16_LE_NOSIG)
+
+
+/* List of symbols `coding-category-xxx' ordered by priority. This
+ variable is exposed to Emacs Lisp. */
+static Lisp_Object Vcoding_category_list;
+
+/* Table of coding categories (Lisp symbols). This variable is for
+ internal use oly. */
+static Lisp_Object Vcoding_category_table;
+
+/* Table of coding-categories ordered by priority. */
+static enum coding_category coding_priorities[coding_category_max];
+
+/* Nth element is a coding context for the coding system bound to the
+ Nth coding category. */
+static struct coding_system coding_categories[coding_category_max];
+
+/*** Commonly used macros and functions ***/
+
+#ifndef min
+#define min(a, b) ((a) < (b) ? (a) : (b))
+#endif
+#ifndef max
+#define max(a, b) ((a) > (b) ? (a) : (b))
+#endif
+
+#define CODING_GET_INFO(coding, attrs, charset_list) \
+ do { \
+ (attrs) = CODING_ID_ATTRS ((coding)->id); \
+ (charset_list) = CODING_ATTR_CHARSET_LIST (attrs); \
+ } while (0)
-/* Record the starting position START and METHOD of one composition. */
+/* Safely get one byte from the source text pointed by SRC which ends
+ at SRC_END, and set C to that byte. If there are not enough bytes
+ in the source, it jumps to `no_more_source'. If multibytep is
+ nonzero, and a multibyte character is found at SRC, set C to the
+ negative value of the character code. The caller should declare
+ and set these variables appropriately in advance:
+ src, src_end, multibytep */
-#define CODING_ADD_COMPOSITION_START(coding, start, method) \
- do { \
- struct composition_data *cmp_data = coding->cmp_data; \
- int *data = cmp_data->data + cmp_data->used; \
- coding->cmp_data_start = cmp_data->used; \
- data[0] = -1; \
- data[1] = cmp_data->char_offset + start; \
- data[3] = (int) method; \
- cmp_data->used += 4; \
+#define ONE_MORE_BYTE(c) \
+ do { \
+ if (src == src_end) \
+ { \
+ if (src_base < src) \
+ record_conversion_result \
+ (coding, CODING_RESULT_INSUFFICIENT_SRC); \
+ goto no_more_source; \
+ } \
+ c = *src++; \
+ if (multibytep && (c & 0x80)) \
+ { \
+ if ((c & 0xFE) == 0xC0) \
+ c = ((c & 1) << 6) | *src++; \
+ else \
+ { \
+ src--; \
+ c = - string_char (src, &src, NULL); \
+ record_conversion_result \
+ (coding, CODING_RESULT_INVALID_SRC); \
+ } \
+ } \
+ consumed_chars++; \
} while (0)
-/* Record the ending position END of the current composition. */
-#define CODING_ADD_COMPOSITION_END(coding, end) \
- do { \
- struct composition_data *cmp_data = coding->cmp_data; \
- int *data = cmp_data->data + coding->cmp_data_start; \
- data[0] = cmp_data->used - coding->cmp_data_start; \
- data[2] = cmp_data->char_offset + end; \
+#define ONE_MORE_BYTE_NO_CHECK(c) \
+ do { \
+ c = *src++; \
+ if (multibytep && (c & 0x80)) \
+ { \
+ if ((c & 0xFE) == 0xC0) \
+ c = ((c & 1) << 6) | *src++; \
+ else \
+ { \
+ src--; \
+ c = - string_char (src, &src, NULL); \
+ record_conversion_result \
+ (coding, CODING_RESULT_INVALID_SRC); \
+ } \
+ } \
+ consumed_chars++; \
} while (0)
-/* Record one COMPONENT (alternate character or composition rule). */
-#define CODING_ADD_COMPOSITION_COMPONENT(coding, component) \
- do { \
- coding->cmp_data->data[coding->cmp_data->used++] = component; \
- if (coding->cmp_data->used - coding->cmp_data_start \
- == COMPOSITION_DATA_MAX_BUNCH_LENGTH) \
- { \
- CODING_ADD_COMPOSITION_END (coding, coding->produced_char); \
- coding->composing = COMPOSITION_NO; \
- } \
- } while (0)
+/* Store a byte C in the place pointed by DST and increment DST to the
+ next free point, and increment PRODUCED_CHARS. The caller should
+ assure that C is 0..127, and declare and set the variable `dst'
+ appropriately in advance.
+*/
-/* Get one byte from a data pointed by SRC and increment SRC. If SRC
- is not less than SRC_END, return -1 without incrementing Src. */
+#define EMIT_ONE_ASCII_BYTE(c) \
+ do { \
+ produced_chars++; \
+ *dst++ = (c); \
+ } while (0)
-#define SAFE_ONE_MORE_BYTE() (src >= src_end ? -1 : *src++)
+/* Like EMIT_ONE_ASCII_BYTE byt store two bytes; C1 and C2. */
-/* Decode a character represented as a component of composition
- sequence of Emacs 20 style at SRC. Set C to that character, store
- its multibyte form sequence at P, and set P to the end of that
- sequence. If no valid character is found, set C to -1. */
+#define EMIT_TWO_ASCII_BYTES(c1, c2) \
+ do { \
+ produced_chars += 2; \
+ *dst++ = (c1), *dst++ = (c2); \
+ } while (0)
-#define DECODE_EMACS_MULE_COMPOSITION_CHAR(c, p) \
- do { \
- int bytes; \
- \
- c = SAFE_ONE_MORE_BYTE (); \
- if (c < 0) \
- break; \
- if (CHAR_HEAD_P (c)) \
- c = -1; \
- else if (c == 0xA0) \
- { \
- c = SAFE_ONE_MORE_BYTE (); \
- if (c < 0xA0) \
- c = -1; \
- else \
- { \
- c -= 0x80; \
- *p++ = c; \
- } \
- } \
- else if (BASE_LEADING_CODE_P (c - 0x20)) \
- { \
- unsigned char *p0 = p; \
- \
- c -= 0x20; \
- *p++ = c; \
- bytes = BYTES_BY_CHAR_HEAD (c); \
- while (--bytes) \
- { \
- c = SAFE_ONE_MORE_BYTE (); \
- if (c < 0) \
- break; \
- *p++ = c; \
- } \
- if (UNIBYTE_STR_AS_MULTIBYTE_P (p0, p - p0, bytes) \
- || (coding->flags /* We are recovering a file. */ \
- && p0[0] == LEADING_CODE_8_BIT_CONTROL \
- && ! CHAR_HEAD_P (p0[1]))) \
- c = STRING_CHAR (p0, bytes); \
- else \
- c = -1; \
- } \
- else \
- c = -1; \
+
+/* Store a byte C in the place pointed by DST and increment DST to the
+ next free point, and increment PRODUCED_CHARS. If MULTIBYTEP is
+ nonzero, store in an appropriate multibyte from. The caller should
+ declare and set the variables `dst' and `multibytep' appropriately
+ in advance. */
+
+#define EMIT_ONE_BYTE(c) \
+ do { \
+ produced_chars++; \
+ if (multibytep) \
+ { \
+ int ch = (c); \
+ if (ch >= 0x80) \
+ ch = BYTE8_TO_CHAR (ch); \
+ CHAR_STRING_ADVANCE (ch, dst); \
+ } \
+ else \
+ *dst++ = (c); \
} while (0)
-/* Decode a composition rule represented as a component of composition
- sequence of Emacs 20 style at SRC. Set C to the rule. If not
- valid rule is found, set C to -1. */
+/* Like EMIT_ONE_BYTE, but emit two bytes; C1 and C2. */
+
+#define EMIT_TWO_BYTES(c1, c2) \
+ do { \
+ produced_chars += 2; \
+ if (multibytep) \
+ { \
+ int ch; \
+ \
+ ch = (c1); \
+ if (ch >= 0x80) \
+ ch = BYTE8_TO_CHAR (ch); \
+ CHAR_STRING_ADVANCE (ch, dst); \
+ ch = (c2); \
+ if (ch >= 0x80) \
+ ch = BYTE8_TO_CHAR (ch); \
+ CHAR_STRING_ADVANCE (ch, dst); \
+ } \
+ else \
+ { \
+ *dst++ = (c1); \
+ *dst++ = (c2); \
+ } \
+ } while (0)
-#define DECODE_EMACS_MULE_COMPOSITION_RULE(c) \
- do { \
- c = SAFE_ONE_MORE_BYTE (); \
- c -= 0xA0; \
- if (c < 0 || c >= 81) \
- c = -1; \
- else \
- { \
- gref = c / 9, nref = c % 9; \
- c = COMPOSITION_ENCODE_RULE (gref, nref); \
- } \
+
+#define EMIT_THREE_BYTES(c1, c2, c3) \
+ do { \
+ EMIT_ONE_BYTE (c1); \
+ EMIT_TWO_BYTES (c2, c3); \
} while (0)
-/* Decode composition sequence encoded by `emacs-mule' at the source
- pointed by SRC. SRC_END is the end of source. Store information
- of the composition in CODING->cmp_data.
+#define EMIT_FOUR_BYTES(c1, c2, c3, c4) \
+ do { \
+ EMIT_TWO_BYTES (c1, c2); \
+ EMIT_TWO_BYTES (c3, c4); \
+ } while (0)
- For backward compatibility, decode also a composition sequence of
- Emacs 20 style. In that case, the composition sequence contains
- characters that should be extracted into a buffer or string. Store
- those characters at *DESTINATION in multibyte form.
- If we encounter an invalid byte sequence, return 0.
- If we encounter an insufficient source or destination, or
- insufficient space in CODING->cmp_data, return 1.
- Otherwise, return consumed bytes in the source.
+/* Prototypes for static functions. */
+static void record_conversion_result P_ ((struct coding_system *coding,
+ enum coding_result_code result));
+static int detect_coding_utf_8 P_ ((struct coding_system *,
+ struct coding_detection_info *info));
+static void decode_coding_utf_8 P_ ((struct coding_system *));
+static int encode_coding_utf_8 P_ ((struct coding_system *));
+
+static int detect_coding_utf_16 P_ ((struct coding_system *,
+ struct coding_detection_info *info));
+static void decode_coding_utf_16 P_ ((struct coding_system *));
+static int encode_coding_utf_16 P_ ((struct coding_system *));
+
+static int detect_coding_iso_2022 P_ ((struct coding_system *,
+ struct coding_detection_info *info));
+static void decode_coding_iso_2022 P_ ((struct coding_system *));
+static int encode_coding_iso_2022 P_ ((struct coding_system *));
+
+static int detect_coding_emacs_mule P_ ((struct coding_system *,
+ struct coding_detection_info *info));
+static void decode_coding_emacs_mule P_ ((struct coding_system *));
+static int encode_coding_emacs_mule P_ ((struct coding_system *));
+
+static int detect_coding_sjis P_ ((struct coding_system *,
+ struct coding_detection_info *info));
+static void decode_coding_sjis P_ ((struct coding_system *));
+static int encode_coding_sjis P_ ((struct coding_system *));
+
+static int detect_coding_big5 P_ ((struct coding_system *,
+ struct coding_detection_info *info));
+static void decode_coding_big5 P_ ((struct coding_system *));
+static int encode_coding_big5 P_ ((struct coding_system *));
+
+static int detect_coding_ccl P_ ((struct coding_system *,
+ struct coding_detection_info *info));
+static void decode_coding_ccl P_ ((struct coding_system *));
+static int encode_coding_ccl P_ ((struct coding_system *));
+
+static void decode_coding_raw_text P_ ((struct coding_system *));
+static int encode_coding_raw_text P_ ((struct coding_system *));
+
+static void coding_set_source P_ ((struct coding_system *));
+static void coding_set_destination P_ ((struct coding_system *));
+static void coding_alloc_by_realloc P_ ((struct coding_system *, EMACS_INT));
+static void coding_alloc_by_making_gap P_ ((struct coding_system *,
+ EMACS_INT, EMACS_INT));
+static unsigned char *alloc_destination P_ ((struct coding_system *,
+ EMACS_INT, unsigned char *));
+static void setup_iso_safe_charsets P_ ((Lisp_Object));
+static unsigned char *encode_designation_at_bol P_ ((struct coding_system *,
+ int *, int *,
+ unsigned char *));
+static int detect_eol P_ ((const unsigned char *,
+ EMACS_INT, enum coding_category));
+static Lisp_Object adjust_coding_eol_type P_ ((struct coding_system *, int));
+static void decode_eol P_ ((struct coding_system *));
+static Lisp_Object get_translation_table P_ ((Lisp_Object, int, int *));
+static Lisp_Object get_translation P_ ((Lisp_Object, int *, int *,
+ int, int *, int *));
+static int produce_chars P_ ((struct coding_system *, Lisp_Object, int));
+static INLINE void produce_composition P_ ((struct coding_system *, int *,
+ EMACS_INT));
+static INLINE void produce_charset P_ ((struct coding_system *, int *,
+ EMACS_INT));
+static void produce_annotation P_ ((struct coding_system *, EMACS_INT));
+static int decode_coding P_ ((struct coding_system *));
+static INLINE int *handle_composition_annotation P_ ((EMACS_INT, EMACS_INT,
+ struct coding_system *,
+ int *, EMACS_INT *));
+static INLINE int *handle_charset_annotation P_ ((EMACS_INT, EMACS_INT,
+ struct coding_system *,
+ int *, EMACS_INT *));
+static void consume_chars P_ ((struct coding_system *, Lisp_Object, int));
+static int encode_coding P_ ((struct coding_system *));
+static Lisp_Object make_conversion_work_buffer P_ ((int));
+static Lisp_Object code_conversion_restore P_ ((Lisp_Object));
+static INLINE int char_encodable_p P_ ((int, Lisp_Object));
+static Lisp_Object make_subsidiaries P_ ((Lisp_Object));
-*/
-static INLINE int
-decode_composition_emacs_mule (coding, src, src_end,
- destination, dst_end, dst_bytes)
- struct coding_system *coding;
- const unsigned char *src, *src_end;
- unsigned char **destination, *dst_end;
- int dst_bytes;
+static void
+record_conversion_result (struct coding_system *coding,
+ enum coding_result_code result)
{
- unsigned char *dst = *destination;
- int method, data_len, nchars;
- const unsigned char *src_base = src++;
- /* Store components of composition. */
- int component[COMPOSITION_DATA_MAX_BUNCH_LENGTH];
- int ncomponent;
- /* Store multibyte form of characters to be composed. This is for
- Emacs 20 style composition sequence. */
- unsigned char buf[MAX_COMPOSITION_COMPONENTS * MAX_MULTIBYTE_LENGTH];
- unsigned char *bufp = buf;
- int c, i, gref, nref;
-
- if (coding->cmp_data->used + COMPOSITION_DATA_MAX_BUNCH_LENGTH
- >= COMPOSITION_DATA_SIZE)
+ coding->result = result;
+ switch (result)
{
- coding->result = CODING_FINISH_INSUFFICIENT_CMP;
- return -1;
+ case CODING_RESULT_INSUFFICIENT_SRC:
+ Vlast_code_conversion_error = Qinsufficient_source;
+ break;
+ case CODING_RESULT_INCONSISTENT_EOL:
+ Vlast_code_conversion_error = Qinconsistent_eol;
+ break;
+ case CODING_RESULT_INVALID_SRC:
+ Vlast_code_conversion_error = Qinvalid_source;
+ break;
+ case CODING_RESULT_INTERRUPT:
+ Vlast_code_conversion_error = Qinterrupted;
+ break;
+ case CODING_RESULT_INSUFFICIENT_MEM:
+ Vlast_code_conversion_error = Qinsufficient_memory;
+ break;
+ default:
+ Vlast_code_conversion_error = intern ("Unknown error");
}
+}
- ONE_MORE_BYTE (c);
- if (c - 0xF0 >= COMPOSITION_RELATIVE
- && c - 0xF0 <= COMPOSITION_WITH_RULE_ALTCHARS)
- {
- int with_rule;
+#define CODING_DECODE_CHAR(coding, src, src_base, src_end, charset, code, c) \
+ do { \
+ charset_map_loaded = 0; \
+ c = DECODE_CHAR (charset, code); \
+ if (charset_map_loaded) \
+ { \
+ const unsigned char *orig = coding->source; \
+ EMACS_INT offset; \
+ \
+ coding_set_source (coding); \
+ offset = coding->source - orig; \
+ src += offset; \
+ src_base += offset; \
+ src_end += offset; \
+ } \
+ } while (0)
- method = c - 0xF0;
- with_rule = (method == COMPOSITION_WITH_RULE
- || method == COMPOSITION_WITH_RULE_ALTCHARS);
- ONE_MORE_BYTE (c);
- data_len = c - 0xA0;
- if (data_len < 4
- || src_base + data_len > src_end)
- return 0;
+
+#define ASSURE_DESTINATION(bytes) \
+ do { \
+ if (dst + (bytes) >= dst_end) \
+ { \
+ int more_bytes = charbuf_end - charbuf + (bytes); \
+ \
+ dst = alloc_destination (coding, more_bytes, dst); \
+ dst_end = coding->destination + coding->dst_bytes; \
+ } \
+ } while (0)
+
+
+
+static void
+coding_set_source (coding)
+ struct coding_system *coding;
+{
+ if (BUFFERP (coding->src_object))
+ {
+ struct buffer *buf = XBUFFER (coding->src_object);
+
+ if (coding->src_pos < 0)
+ coding->source = BUF_GAP_END_ADDR (buf) + coding->src_pos_byte;
+ else
+ coding->source = BUF_BYTE_ADDRESS (buf, coding->src_pos_byte);
+ }
+ else if (STRINGP (coding->src_object))
+ {
+ coding->source = SDATA (coding->src_object) + coding->src_pos_byte;
+ }
+ else
+ /* Otherwise, the source is C string and is never relocated
+ automatically. Thus we don't have to update anything. */
+ ;
+}
+
+static void
+coding_set_destination (coding)
+ struct coding_system *coding;
+{
+ if (BUFFERP (coding->dst_object))
+ {
+ if (coding->src_pos < 0)
+ {
+ coding->destination = BEG_ADDR + coding->dst_pos_byte - 1;
+ coding->dst_bytes = (GAP_END_ADDR
+ - (coding->src_bytes - coding->consumed)
+ - coding->destination);
+ }
+ else
+ {
+ /* We are sure that coding->dst_pos_byte is before the gap
+ of the buffer. */
+ coding->destination = (BUF_BEG_ADDR (XBUFFER (coding->dst_object))
+ + coding->dst_pos_byte - 1);
+ coding->dst_bytes = (BUF_GAP_END_ADDR (XBUFFER (coding->dst_object))
+ - coding->destination);
+ }
+ }
+ else
+ /* Otherwise, the destination is C string and is never relocated
+ automatically. Thus we don't have to update anything. */
+ ;
+}
+
+
+static void
+coding_alloc_by_realloc (coding, bytes)
+ struct coding_system *coding;
+ EMACS_INT bytes;
+{
+ coding->destination = (unsigned char *) xrealloc (coding->destination,
+ coding->dst_bytes + bytes);
+ coding->dst_bytes += bytes;
+}
+
+static void
+coding_alloc_by_making_gap (coding, offset, bytes)
+ struct coding_system *coding;
+ EMACS_INT offset, bytes;
+{
+ if (BUFFERP (coding->dst_object)
+ && EQ (coding->src_object, coding->dst_object))
+ {
+ EMACS_INT add = offset + (coding->src_bytes - coding->consumed);
+
+ GPT += offset, GPT_BYTE += offset;
+ GAP_SIZE -= add; ZV += add; Z += add; ZV_BYTE += add; Z_BYTE += add;
+ make_gap (bytes);
+ GAP_SIZE += add; ZV -= add; Z -= add; ZV_BYTE -= add; Z_BYTE -= add;
+ GPT -= offset, GPT_BYTE -= offset;
+ }
+ else
+ {
+ Lisp_Object this_buffer;
+
+ this_buffer = Fcurrent_buffer ();
+ set_buffer_internal (XBUFFER (coding->dst_object));
+ make_gap (bytes);
+ set_buffer_internal (XBUFFER (this_buffer));
+ }
+}
+
+
+static unsigned char *
+alloc_destination (coding, nbytes, dst)
+ struct coding_system *coding;
+ EMACS_INT nbytes;
+ unsigned char *dst;
+{
+ EMACS_INT offset = dst - coding->destination;
+
+ if (BUFFERP (coding->dst_object))
+ coding_alloc_by_making_gap (coding, offset, nbytes);
+ else
+ coding_alloc_by_realloc (coding, nbytes);
+ record_conversion_result (coding, CODING_RESULT_SUCCESS);
+ coding_set_destination (coding);
+ dst = coding->destination + offset;
+ return dst;
+}
+
+/** Macros for annotations. */
+
+/* Maximum length of annotation data (sum of annotations for
+ composition and charset). */
+#define MAX_ANNOTATION_LENGTH (4 + (MAX_COMPOSITION_COMPONENTS * 2) - 1 + 4)
+
+/* An annotation data is stored in the array coding->charbuf in this
+ format:
+ [ -LENGTH ANNOTATION_MASK NCHARS ... ]
+ LENGTH is the number of elements in the annotation.
+ ANNOTATION_MASK is one of CODING_ANNOTATE_XXX_MASK.
+ NCHARS is the number of characters in the text annotated.
+
+ The format of the following elements depend on ANNOTATION_MASK.
+
+ In the case of CODING_ANNOTATE_COMPOSITION_MASK, these elements
+ follows:
+ ... METHOD [ COMPOSITION-COMPONENTS ... ]
+ METHOD is one of enum composition_method.
+ Optionnal COMPOSITION-COMPONENTS are characters and composition
+ rules.
+
+ In the case of CODING_ANNOTATE_CHARSET_MASK, one element CHARSET-ID
+ follows. */
+
+#define ADD_ANNOTATION_DATA(buf, len, mask, nchars) \
+ do { \
+ *(buf)++ = -(len); \
+ *(buf)++ = (mask); \
+ *(buf)++ = (nchars); \
+ coding->annotated = 1; \
+ } while (0);
+
+#define ADD_COMPOSITION_DATA(buf, nchars, method) \
+ do { \
+ ADD_ANNOTATION_DATA (buf, 4, CODING_ANNOTATE_COMPOSITION_MASK, nchars); \
+ *buf++ = method; \
+ } while (0)
+
+
+#define ADD_CHARSET_DATA(buf, nchars, id) \
+ do { \
+ ADD_ANNOTATION_DATA (buf, 4, CODING_ANNOTATE_CHARSET_MASK, nchars); \
+ *buf++ = id; \
+ } while (0)
+
+\f
+/*** 2. Emacs' internal format (emacs-utf-8) ***/
+
+
+
+\f
+/*** 3. UTF-8 ***/
+
+/* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions".
+ Check if a text is encoded in UTF-8. If it is, return 1, else
+ return 0. */
+
+#define UTF_8_1_OCTET_P(c) ((c) < 0x80)
+#define UTF_8_EXTRA_OCTET_P(c) (((c) & 0xC0) == 0x80)
+#define UTF_8_2_OCTET_LEADING_P(c) (((c) & 0xE0) == 0xC0)
+#define UTF_8_3_OCTET_LEADING_P(c) (((c) & 0xF0) == 0xE0)
+#define UTF_8_4_OCTET_LEADING_P(c) (((c) & 0xF8) == 0xF0)
+#define UTF_8_5_OCTET_LEADING_P(c) (((c) & 0xFC) == 0xF8)
+
+static int
+detect_coding_utf_8 (coding, detect_info)
+ struct coding_system *coding;
+ struct coding_detection_info *detect_info;
+{
+ const unsigned char *src = coding->source, *src_base;
+ const unsigned char *src_end = coding->source + coding->src_bytes;
+ int multibytep = coding->src_multibyte;
+ int consumed_chars = 0;
+ int found = 0;
+
+ detect_info->checked |= CATEGORY_MASK_UTF_8;
+ /* A coding system of this category is always ASCII compatible. */
+ src += coding->head_ascii;
+
+ while (1)
+ {
+ int c, c1, c2, c3, c4;
+
+ src_base = src;
+ ONE_MORE_BYTE (c);
+ if (c < 0 || UTF_8_1_OCTET_P (c))
+ continue;
+ ONE_MORE_BYTE (c1);
+ if (c1 < 0 || ! UTF_8_EXTRA_OCTET_P (c1))
+ break;
+ if (UTF_8_2_OCTET_LEADING_P (c))
+ {
+ found = CATEGORY_MASK_UTF_8;
+ continue;
+ }
+ ONE_MORE_BYTE (c2);
+ if (c2 < 0 || ! UTF_8_EXTRA_OCTET_P (c2))
+ break;
+ if (UTF_8_3_OCTET_LEADING_P (c))
+ {
+ found = CATEGORY_MASK_UTF_8;
+ continue;
+ }
+ ONE_MORE_BYTE (c3);
+ if (c3 < 0 || ! UTF_8_EXTRA_OCTET_P (c3))
+ break;
+ if (UTF_8_4_OCTET_LEADING_P (c))
+ {
+ found = CATEGORY_MASK_UTF_8;
+ continue;
+ }
+ ONE_MORE_BYTE (c4);
+ if (c4 < 0 || ! UTF_8_EXTRA_OCTET_P (c4))
+ break;
+ if (UTF_8_5_OCTET_LEADING_P (c))
+ {
+ found = CATEGORY_MASK_UTF_8;
+ continue;
+ }
+ break;
+ }
+ detect_info->rejected |= CATEGORY_MASK_UTF_8;
+ return 0;
+
+ no_more_source:
+ if (src_base < src && coding->mode & CODING_MODE_LAST_BLOCK)
+ {
+ detect_info->rejected |= CATEGORY_MASK_UTF_8;
+ return 0;
+ }
+ detect_info->found |= found;
+ return 1;
+}
+
+
+static void
+decode_coding_utf_8 (coding)
+ struct coding_system *coding;
+{
+ const unsigned char *src = coding->source + coding->consumed;
+ const unsigned char *src_end = coding->source + coding->src_bytes;
+ const unsigned char *src_base;
+ int *charbuf = coding->charbuf + coding->charbuf_used;
+ int *charbuf_end = coding->charbuf + coding->charbuf_size;
+ int consumed_chars = 0, consumed_chars_base;
+ int multibytep = coding->src_multibyte;
+ Lisp_Object attr, charset_list;
+
+ CODING_GET_INFO (coding, attr, charset_list);
+
+ while (1)
+ {
+ int c, c1, c2, c3, c4, c5;
+
+ src_base = src;
+ consumed_chars_base = consumed_chars;
+
+ if (charbuf >= charbuf_end)
+ break;
+
+ ONE_MORE_BYTE (c1);
+ if (c1 < 0)
+ {
+ c = - c1;
+ }
+ else if (UTF_8_1_OCTET_P(c1))
+ {
+ c = c1;
+ }
+ else
+ {
+ ONE_MORE_BYTE (c2);
+ if (c2 < 0 || ! UTF_8_EXTRA_OCTET_P (c2))
+ goto invalid_code;
+ if (UTF_8_2_OCTET_LEADING_P (c1))
+ {
+ c = ((c1 & 0x1F) << 6) | (c2 & 0x3F);
+ /* Reject overlong sequences here and below. Encoders
+ producing them are incorrect, they can be misleading,
+ and they mess up read/write invariance. */
+ if (c < 128)
+ goto invalid_code;
+ }
+ else
+ {
+ ONE_MORE_BYTE (c3);
+ if (c3 < 0 || ! UTF_8_EXTRA_OCTET_P (c3))
+ goto invalid_code;
+ if (UTF_8_3_OCTET_LEADING_P (c1))
+ {
+ c = (((c1 & 0xF) << 12)
+ | ((c2 & 0x3F) << 6) | (c3 & 0x3F));
+ if (c < 0x800
+ || (c >= 0xd800 && c < 0xe000)) /* surrogates (invalid) */
+ goto invalid_code;
+ }
+ else
+ {
+ ONE_MORE_BYTE (c4);
+ if (c4 < 0 || ! UTF_8_EXTRA_OCTET_P (c4))
+ goto invalid_code;
+ if (UTF_8_4_OCTET_LEADING_P (c1))
+ {
+ c = (((c1 & 0x7) << 18) | ((c2 & 0x3F) << 12)
+ | ((c3 & 0x3F) << 6) | (c4 & 0x3F));
+ if (c < 0x10000)
+ goto invalid_code;
+ }
+ else
+ {
+ ONE_MORE_BYTE (c5);
+ if (c5 < 0 || ! UTF_8_EXTRA_OCTET_P (c5))
+ goto invalid_code;
+ if (UTF_8_5_OCTET_LEADING_P (c1))
+ {
+ c = (((c1 & 0x3) << 24) | ((c2 & 0x3F) << 18)
+ | ((c3 & 0x3F) << 12) | ((c4 & 0x3F) << 6)
+ | (c5 & 0x3F));
+ if ((c > MAX_CHAR) || (c < 0x200000))
+ goto invalid_code;
+ }
+ else
+ goto invalid_code;
+ }
+ }
+ }
+ }
+
+ *charbuf++ = c;
+ continue;
+
+ invalid_code:
+ src = src_base;
+ consumed_chars = consumed_chars_base;
ONE_MORE_BYTE (c);
- nchars = c - 0xA0;
- if (c < 1)
- return 0;
- for (ncomponent = 0; src < src_base + data_len; ncomponent++)
+ *charbuf++ = ASCII_BYTE_P (c) ? c : BYTE8_TO_CHAR (c);
+ coding->errors++;
+ }
+
+ no_more_source:
+ coding->consumed_char += consumed_chars_base;
+ coding->consumed = src_base - coding->source;
+ coding->charbuf_used = charbuf - coding->charbuf;
+}
+
+
+static int
+encode_coding_utf_8 (coding)
+ struct coding_system *coding;
+{
+ int multibytep = coding->dst_multibyte;
+ int *charbuf = coding->charbuf;
+ int *charbuf_end = charbuf + coding->charbuf_used;
+ unsigned char *dst = coding->destination + coding->produced;
+ unsigned char *dst_end = coding->destination + coding->dst_bytes;
+ int produced_chars = 0;
+ int c;
+
+ if (multibytep)
+ {
+ int safe_room = MAX_MULTIBYTE_LENGTH * 2;
+
+ while (charbuf < charbuf_end)
+ {
+ unsigned char str[MAX_MULTIBYTE_LENGTH], *p, *pend = str;
+
+ ASSURE_DESTINATION (safe_room);
+ c = *charbuf++;
+ if (CHAR_BYTE8_P (c))
+ {
+ c = CHAR_TO_BYTE8 (c);
+ EMIT_ONE_BYTE (c);
+ }
+ else
+ {
+ CHAR_STRING_ADVANCE (c, pend);
+ for (p = str; p < pend; p++)
+ EMIT_ONE_BYTE (*p);
+ }
+ }
+ }
+ else
+ {
+ int safe_room = MAX_MULTIBYTE_LENGTH;
+
+ while (charbuf < charbuf_end)
+ {
+ ASSURE_DESTINATION (safe_room);
+ c = *charbuf++;
+ if (CHAR_BYTE8_P (c))
+ *dst++ = CHAR_TO_BYTE8 (c);
+ else
+ dst += CHAR_STRING (c, dst);
+ produced_chars++;
+ }
+ }
+ record_conversion_result (coding, CODING_RESULT_SUCCESS);
+ coding->produced_char += produced_chars;
+ coding->produced = dst - coding->destination;
+ return 0;
+}
+
+
+/* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions".
+ Check if a text is encoded in one of UTF-16 based coding systems.
+ If it is, return 1, else return 0. */
+
+#define UTF_16_HIGH_SURROGATE_P(val) \
+ (((val) & 0xFC00) == 0xD800)
+
+#define UTF_16_LOW_SURROGATE_P(val) \
+ (((val) & 0xFC00) == 0xDC00)
+
+#define UTF_16_INVALID_P(val) \
+ (((val) == 0xFFFE) \
+ || ((val) == 0xFFFF) \
+ || UTF_16_LOW_SURROGATE_P (val))
+
+
+static int
+detect_coding_utf_16 (coding, detect_info)
+ struct coding_system *coding;
+ struct coding_detection_info *detect_info;
+{
+ const unsigned char *src = coding->source, *src_base = src;
+ const unsigned char *src_end = coding->source + coding->src_bytes;
+ int multibytep = coding->src_multibyte;
+ int consumed_chars = 0;
+ int c1, c2;
+
+ detect_info->checked |= CATEGORY_MASK_UTF_16;
+ if (coding->mode & CODING_MODE_LAST_BLOCK
+ && (coding->src_chars & 1))
+ {
+ detect_info->rejected |= CATEGORY_MASK_UTF_16;
+ return 0;
+ }
+
+ ONE_MORE_BYTE (c1);
+ ONE_MORE_BYTE (c2);
+ if ((c1 == 0xFF) && (c2 == 0xFE))
+ {
+ detect_info->found |= (CATEGORY_MASK_UTF_16_LE
+ | CATEGORY_MASK_UTF_16_AUTO);
+ detect_info->rejected |= (CATEGORY_MASK_UTF_16_BE
+ | CATEGORY_MASK_UTF_16_BE_NOSIG
+ | CATEGORY_MASK_UTF_16_LE_NOSIG);
+ }
+ else if ((c1 == 0xFE) && (c2 == 0xFF))
+ {
+ detect_info->found |= (CATEGORY_MASK_UTF_16_BE
+ | CATEGORY_MASK_UTF_16_AUTO);
+ detect_info->rejected |= (CATEGORY_MASK_UTF_16_LE
+ | CATEGORY_MASK_UTF_16_BE_NOSIG
+ | CATEGORY_MASK_UTF_16_LE_NOSIG);
+ }
+ else if (c1 >= 0 && c2 >= 0)
+ {
+ detect_info->rejected
+ |= (CATEGORY_MASK_UTF_16_BE | CATEGORY_MASK_UTF_16_LE);
+ }
+ no_more_source:
+ return 1;
+}
+
+static void
+decode_coding_utf_16 (coding)
+ struct coding_system *coding;
+{
+ const unsigned char *src = coding->source + coding->consumed;
+ const unsigned char *src_end = coding->source + coding->src_bytes;
+ const unsigned char *src_base;
+ int *charbuf = coding->charbuf + coding->charbuf_used;
+ int *charbuf_end = coding->charbuf + coding->charbuf_size;
+ int consumed_chars = 0, consumed_chars_base;
+ int multibytep = coding->src_multibyte;
+ enum utf_16_bom_type bom = CODING_UTF_16_BOM (coding);
+ enum utf_16_endian_type endian = CODING_UTF_16_ENDIAN (coding);
+ int surrogate = CODING_UTF_16_SURROGATE (coding);
+ Lisp_Object attr, charset_list;
+
+ CODING_GET_INFO (coding, attr, charset_list);
+
+ if (bom == utf_16_with_bom)
+ {
+ int c, c1, c2;
+
+ src_base = src;
+ ONE_MORE_BYTE (c1);
+ ONE_MORE_BYTE (c2);
+ c = (c1 << 8) | c2;
+
+ if (endian == utf_16_big_endian
+ ? c != 0xFEFF : c != 0xFFFE)
+ {
+ /* The first two bytes are not BOM. Treat them as bytes
+ for a normal character. */
+ src = src_base;
+ coding->errors++;
+ }
+ CODING_UTF_16_BOM (coding) = utf_16_without_bom;
+ }
+ else if (bom == utf_16_detect_bom)
+ {
+ /* We have already tried to detect BOM and failed in
+ detect_coding. */
+ CODING_UTF_16_BOM (coding) = utf_16_without_bom;
+ }
+
+ while (1)
+ {
+ int c, c1, c2;
+
+ src_base = src;
+ consumed_chars_base = consumed_chars;
+
+ if (charbuf + 2 >= charbuf_end)
+ break;
+
+ ONE_MORE_BYTE (c1);
+ if (c1 < 0)
+ {
+ *charbuf++ = -c1;
+ continue;
+ }
+ ONE_MORE_BYTE (c2);
+ if (c2 < 0)
+ {
+ *charbuf++ = ASCII_BYTE_P (c1) ? c1 : BYTE8_TO_CHAR (c1);
+ *charbuf++ = -c2;
+ continue;
+ }
+ c = (endian == utf_16_big_endian
+ ? ((c1 << 8) | c2) : ((c2 << 8) | c1));
+ if (surrogate)
+ {
+ if (! UTF_16_LOW_SURROGATE_P (c))
+ {
+ if (endian == utf_16_big_endian)
+ c1 = surrogate >> 8, c2 = surrogate & 0xFF;
+ else
+ c1 = surrogate & 0xFF, c2 = surrogate >> 8;
+ *charbuf++ = c1;
+ *charbuf++ = c2;
+ coding->errors++;
+ if (UTF_16_HIGH_SURROGATE_P (c))
+ CODING_UTF_16_SURROGATE (coding) = surrogate = c;
+ else
+ *charbuf++ = c;
+ }
+ else
+ {
+ c = ((surrogate - 0xD800) << 10) | (c - 0xDC00);
+ CODING_UTF_16_SURROGATE (coding) = surrogate = 0;
+ *charbuf++ = 0x10000 + c;
+ }
+ }
+ else
+ {
+ if (UTF_16_HIGH_SURROGATE_P (c))
+ CODING_UTF_16_SURROGATE (coding) = surrogate = c;
+ else
+ *charbuf++ = c;
+ }
+ }
+
+ no_more_source:
+ coding->consumed_char += consumed_chars_base;
+ coding->consumed = src_base - coding->source;
+ coding->charbuf_used = charbuf - coding->charbuf;
+}
+
+static int
+encode_coding_utf_16 (coding)
+ struct coding_system *coding;
+{
+ int multibytep = coding->dst_multibyte;
+ int *charbuf = coding->charbuf;
+ int *charbuf_end = charbuf + coding->charbuf_used;
+ unsigned char *dst = coding->destination + coding->produced;
+ unsigned char *dst_end = coding->destination + coding->dst_bytes;
+ int safe_room = 8;
+ enum utf_16_bom_type bom = CODING_UTF_16_BOM (coding);
+ int big_endian = CODING_UTF_16_ENDIAN (coding) == utf_16_big_endian;
+ int produced_chars = 0;
+ Lisp_Object attrs, charset_list;
+ int c;
+
+ CODING_GET_INFO (coding, attrs, charset_list);
+
+ if (bom != utf_16_without_bom)
+ {
+ ASSURE_DESTINATION (safe_room);
+ if (big_endian)
+ EMIT_TWO_BYTES (0xFE, 0xFF);
+ else
+ EMIT_TWO_BYTES (0xFF, 0xFE);
+ CODING_UTF_16_BOM (coding) = utf_16_without_bom;
+ }
+
+ while (charbuf < charbuf_end)
+ {
+ ASSURE_DESTINATION (safe_room);
+ c = *charbuf++;
+ if (c >= MAX_UNICODE_CHAR)
+ c = coding->default_char;
+
+ if (c < 0x10000)
+ {
+ if (big_endian)
+ EMIT_TWO_BYTES (c >> 8, c & 0xFF);
+ else
+ EMIT_TWO_BYTES (c & 0xFF, c >> 8);
+ }
+ else
+ {
+ int c1, c2;
+
+ c -= 0x10000;
+ c1 = (c >> 10) + 0xD800;
+ c2 = (c & 0x3FF) + 0xDC00;
+ if (big_endian)
+ EMIT_FOUR_BYTES (c1 >> 8, c1 & 0xFF, c2 >> 8, c2 & 0xFF);
+ else
+ EMIT_FOUR_BYTES (c1 & 0xFF, c1 >> 8, c2 & 0xFF, c2 >> 8);
+ }
+ }
+ record_conversion_result (coding, CODING_RESULT_SUCCESS);
+ coding->produced = dst - coding->destination;
+ coding->produced_char += produced_chars;
+ return 0;
+}
+
+\f
+/*** 6. Old Emacs' internal format (emacs-mule) ***/
+
+/* Emacs' internal format for representation of multiple character
+ sets is a kind of multi-byte encoding, i.e. characters are
+ represented by variable-length sequences of one-byte codes.
+
+ ASCII characters and control characters (e.g. `tab', `newline') are
+ represented by one-byte sequences which are their ASCII codes, in
+ the range 0x00 through 0x7F.
+
+ 8-bit characters of the range 0x80..0x9F are represented by
+ two-byte sequences of LEADING_CODE_8_BIT_CONTROL and (their 8-bit
+ code + 0x20).
+
+ 8-bit characters of the range 0xA0..0xFF are represented by
+ one-byte sequences which are their 8-bit code.
+
+ The other characters are represented by a sequence of `base
+ leading-code', optional `extended leading-code', and one or two
+ `position-code's. The length of the sequence is determined by the
+ base leading-code. Leading-code takes the range 0x81 through 0x9D,
+ whereas extended leading-code and position-code take the range 0xA0
+ through 0xFF. See `charset.h' for more details about leading-code
+ and position-code.
+
+ --- CODE RANGE of Emacs' internal format ---
+ character set range
+ ------------- -----
+ ascii 0x00..0x7F
+ eight-bit-control LEADING_CODE_8_BIT_CONTROL + 0xA0..0xBF
+ eight-bit-graphic 0xA0..0xBF
+ ELSE 0x81..0x9D + [0xA0..0xFF]+
+ ---------------------------------------------
+
+ As this is the internal character representation, the format is
+ usually not used externally (i.e. in a file or in a data sent to a
+ process). But, it is possible to have a text externally in this
+ format (i.e. by encoding by the coding system `emacs-mule').
+
+ In that case, a sequence of one-byte codes has a slightly different
+ form.
+
+ At first, all characters in eight-bit-control are represented by
+ one-byte sequences which are their 8-bit code.
+
+ Next, character composition data are represented by the byte
+ sequence of the form: 0x80 METHOD BYTES CHARS COMPONENT ...,
+ where,
+ METHOD is 0xF0 plus one of composition method (enum
+ composition_method),
+
+ BYTES is 0xA0 plus a byte length of this composition data,
+
+ CHARS is 0x20 plus a number of characters composed by this
+ data,
+
+ COMPONENTs are characters of multibye form or composition
+ rules encoded by two-byte of ASCII codes.
+
+ In addition, for backward compatibility, the following formats are
+ also recognized as composition data on decoding.
+
+ 0x80 MSEQ ...
+ 0x80 0xFF MSEQ RULE MSEQ RULE ... MSEQ
+
+ Here,
+ MSEQ is a multibyte form but in these special format:
+ ASCII: 0xA0 ASCII_CODE+0x80,
+ other: LEADING_CODE+0x20 FOLLOWING-BYTE ...,
+ RULE is a one byte code of the range 0xA0..0xF0 that
+ represents a composition rule.
+ */
+
+char emacs_mule_bytes[256];
+
+int
+emacs_mule_char (coding, src, nbytes, nchars, id)
+ struct coding_system *coding;
+ const unsigned char *src;
+ int *nbytes, *nchars, *id;
+{
+ const unsigned char *src_end = coding->source + coding->src_bytes;
+ const unsigned char *src_base = src;
+ int multibytep = coding->src_multibyte;
+ struct charset *charset;
+ unsigned code;
+ int c;
+ int consumed_chars = 0;
+
+ ONE_MORE_BYTE (c);
+ if (c < 0)
+ {
+ c = -c;
+ charset = emacs_mule_charset[0];
+ }
+ else
+ {
+ if (c >= 0xA0)
+ {
+ /* Old style component character of a compostion. */
+ if (c == 0xA0)
+ {
+ ONE_MORE_BYTE (c);
+ c -= 0x80;
+ }
+ else
+ c -= 0x20;
+ }
+
+ switch (emacs_mule_bytes[c])
{
- /* If it is longer than this, it can't be valid. */
- if (ncomponent >= COMPOSITION_DATA_MAX_BUNCH_LENGTH)
- return 0;
+ case 2:
+ if (! (charset = emacs_mule_charset[c]))
+ goto invalid_code;
+ ONE_MORE_BYTE (c);
+ if (c < 0xA0)
+ goto invalid_code;
+ code = c & 0x7F;
+ break;
- if (ncomponent % 2 && with_rule)
+ case 3:
+ if (c == EMACS_MULE_LEADING_CODE_PRIVATE_11
+ || c == EMACS_MULE_LEADING_CODE_PRIVATE_12)
{
- ONE_MORE_BYTE (gref);
- gref -= 32;
- ONE_MORE_BYTE (nref);
- nref -= 32;
- c = COMPOSITION_ENCODE_RULE (gref, nref);
+ ONE_MORE_BYTE (c);
+ if (c < 0xA0 || ! (charset = emacs_mule_charset[c]))
+ goto invalid_code;
+ ONE_MORE_BYTE (c);
+ if (c < 0xA0)
+ goto invalid_code;
+ code = c & 0x7F;
}
else
{
- int bytes;
- if (UNIBYTE_STR_AS_MULTIBYTE_P (src, src_end - src, bytes)
- || (coding->flags /* We are recovering a file. */
- && src[0] == LEADING_CODE_8_BIT_CONTROL
- && ! CHAR_HEAD_P (src[1])))
- c = STRING_CHAR (src, bytes);
- else
- c = *src, bytes = 1;
- src += bytes;
+ if (! (charset = emacs_mule_charset[c]))
+ goto invalid_code;
+ ONE_MORE_BYTE (c);
+ if (c < 0xA0)
+ goto invalid_code;
+ code = (c & 0x7F) << 8;
+ ONE_MORE_BYTE (c);
+ if (c < 0xA0)
+ goto invalid_code;
+ code |= c & 0x7F;
}
- component[ncomponent] = c;
+ break;
+
+ case 4:
+ ONE_MORE_BYTE (c);
+ if (c < 0 || ! (charset = emacs_mule_charset[c]))
+ goto invalid_code;
+ ONE_MORE_BYTE (c);
+ if (c < 0xA0)
+ goto invalid_code;
+ code = (c & 0x7F) << 8;
+ ONE_MORE_BYTE (c);
+ if (c < 0xA0)
+ goto invalid_code;
+ code |= c & 0x7F;
+ break;
+
+ case 1:
+ code = c;
+ charset = CHARSET_FROM_ID (ASCII_BYTE_P (code)
+ ? charset_ascii : charset_eight_bit);
+ break;
+
+ default:
+ abort ();
}
+ c = DECODE_CHAR (charset, code);
+ if (c < 0)
+ goto invalid_code;
}
- else if (c >= 0x80)
- {
- /* This may be an old Emacs 20 style format. See the comment at
- the section 2 of this file. */
- while (src < src_end && !CHAR_HEAD_P (*src)) src++;
- if (src == src_end
- && !(coding->mode & CODING_MODE_LAST_BLOCK))
- goto label_end_of_loop;
+ *nbytes = src - src_base;
+ *nchars = consumed_chars;
+ if (id)
+ *id = charset->id;
+ return c;
+
+ no_more_source:
+ return -2;
+
+ invalid_code:
+ return -1;
+}
+
+
+/* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions".
+ Check if a text is encoded in `emacs-mule'. If it is, return 1,
+ else return 0. */
+
+static int
+detect_coding_emacs_mule (coding, detect_info)
+ struct coding_system *coding;
+ struct coding_detection_info *detect_info;
+{
+ const unsigned char *src = coding->source, *src_base;
+ const unsigned char *src_end = coding->source + coding->src_bytes;
+ int multibytep = coding->src_multibyte;
+ int consumed_chars = 0;
+ int c;
+ int found = 0;
- src_end = src;
- src = src_base + 1;
- if (c < 0xC0)
+ detect_info->checked |= CATEGORY_MASK_EMACS_MULE;
+ /* A coding system of this category is always ASCII compatible. */
+ src += coding->head_ascii;
+
+ while (1)
+ {
+ src_base = src;
+ ONE_MORE_BYTE (c);
+ if (c < 0)
+ continue;
+ if (c == 0x80)
{
- method = COMPOSITION_RELATIVE;
- for (ncomponent = 0; ncomponent < MAX_COMPOSITION_COMPONENTS;)
+ /* Perhaps the start of composite character. We simple skip
+ it because analyzing it is too heavy for detecting. But,
+ at least, we check that the composite character
+ constitues of more than 4 bytes. */
+ const unsigned char *src_base;
+
+ repeat:
+ src_base = src;
+ do
{
- DECODE_EMACS_MULE_COMPOSITION_CHAR (c, bufp);
- if (c < 0)
- break;
- component[ncomponent++] = c;
+ ONE_MORE_BYTE (c);
}
- if (ncomponent < 2)
- return 0;
- nchars = ncomponent;
+ while (c >= 0xA0);
+
+ if (src - src_base <= 4)
+ break;
+ found = CATEGORY_MASK_EMACS_MULE;
+ if (c == 0x80)
+ goto repeat;
}
- else if (c == 0xFF)
+
+ if (c < 0x80)
{
- method = COMPOSITION_WITH_RULE;
- src++;
- DECODE_EMACS_MULE_COMPOSITION_CHAR (c, bufp);
- if (c < 0)
- return 0;
- component[0] = c;
- for (ncomponent = 1;
- ncomponent < MAX_COMPOSITION_COMPONENTS * 2 - 1;)
+ if (c < 0x20
+ && (c == ISO_CODE_ESC || c == ISO_CODE_SI || c == ISO_CODE_SO))
+ break;
+ }
+ else
+ {
+ int more_bytes = emacs_mule_bytes[*src_base] - 1;
+
+ while (more_bytes > 0)
{
- DECODE_EMACS_MULE_COMPOSITION_RULE (c);
- if (c < 0)
- break;
- component[ncomponent++] = c;
- DECODE_EMACS_MULE_COMPOSITION_CHAR (c, bufp);
- if (c < 0)
- break;
- component[ncomponent++] = c;
+ ONE_MORE_BYTE (c);
+ if (c < 0xA0)
+ {
+ src--; /* Unread the last byte. */
+ break;
+ }
+ more_bytes--;
}
- if (ncomponent < 3)
- return 0;
- nchars = (ncomponent + 1) / 2;
+ if (more_bytes != 0)
+ break;
+ found = CATEGORY_MASK_EMACS_MULE;
}
- else
- return 0;
}
- else
- return 0;
+ detect_info->rejected |= CATEGORY_MASK_EMACS_MULE;
+ return 0;
- if (buf == bufp || dst + (bufp - buf) <= (dst_bytes ? dst_end : src))
+ no_more_source:
+ if (src_base < src && coding->mode & CODING_MODE_LAST_BLOCK)
{
- CODING_ADD_COMPOSITION_START (coding, coding->produced_char, method);
- for (i = 0; i < ncomponent; i++)
- CODING_ADD_COMPOSITION_COMPONENT (coding, component[i]);
- CODING_ADD_COMPOSITION_END (coding, coding->produced_char + nchars);
- if (buf < bufp)
- {
- unsigned char *p = buf;
- EMIT_BYTES (p, bufp);
- *destination += bufp - buf;
- coding->produced_char += nchars;
- }
- return (src - src_base);
+ detect_info->rejected |= CATEGORY_MASK_EMACS_MULE;
+ return 0;
}
- label_end_of_loop:
- return -1;
+ detect_info->found |= found;
+ return 1;
}
+
/* See the above "GENERAL NOTES on `decode_coding_XXX ()' functions". */
+/* Decode a character represented as a component of composition
+ sequence of Emacs 20/21 style at SRC. Set C to that character and
+ update SRC to the head of next character (or an encoded composition
+ rule). If SRC doesn't points a composition component, set C to -1.
+ If SRC points an invalid byte sequence, global exit by a return
+ value 0. */
+
+#define DECODE_EMACS_MULE_COMPOSITION_CHAR(buf) \
+ if (1) \
+ { \
+ int c; \
+ int nbytes, nchars; \
+ \
+ if (src == src_end) \
+ break; \
+ c = emacs_mule_char (coding, src, &nbytes, &nchars, NULL);\
+ if (c < 0) \
+ { \
+ if (c == -2) \
+ break; \
+ goto invalid_code; \
+ } \
+ *buf++ = c; \
+ src += nbytes; \
+ consumed_chars += nchars; \
+ } \
+ else
+
+
+/* Decode a composition rule represented as a component of composition
+ sequence of Emacs 20 style at SRC. Store the decoded rule in *BUF,
+ and increment BUF. If SRC points an invalid byte sequence, set C
+ to -1. */
+
+#define DECODE_EMACS_MULE_COMPOSITION_RULE_20(buf) \
+ do { \
+ int c, gref, nref; \
+ \
+ if (src >= src_end) \
+ goto invalid_code; \
+ ONE_MORE_BYTE_NO_CHECK (c); \
+ c -= 0xA0; \
+ if (c < 0 || c >= 81) \
+ goto invalid_code; \
+ \
+ gref = c / 9, nref = c % 9; \
+ *buf++ = COMPOSITION_ENCODE_RULE (gref, nref); \
+ } while (0)
+
+
+/* Decode a composition rule represented as a component of composition
+ sequence of Emacs 21 style at SRC. Store the decoded rule in *BUF,
+ and increment BUF. If SRC points an invalid byte sequence, set C
+ to -1. */
+
+#define DECODE_EMACS_MULE_COMPOSITION_RULE_21(buf) \
+ do { \
+ int gref, nref; \
+ \
+ if (src + 1>= src_end) \
+ goto invalid_code; \
+ ONE_MORE_BYTE_NO_CHECK (gref); \
+ gref -= 0x20; \
+ ONE_MORE_BYTE_NO_CHECK (nref); \
+ nref -= 0x20; \
+ if (gref < 0 || gref >= 81 \
+ || nref < 0 || nref >= 81) \
+ goto invalid_code; \
+ *buf++ = COMPOSITION_ENCODE_RULE (gref, nref); \
+ } while (0)
+
+
+#define DECODE_EMACS_MULE_21_COMPOSITION(c) \
+ do { \
+ /* Emacs 21 style format. The first three bytes at SRC are \
+ (METHOD - 0xF2), (BYTES - 0xA0), (CHARS - 0xA0), where BYTES is \
+ the byte length of this composition information, CHARS is the \
+ number of characters composed by this composition. */ \
+ enum composition_method method = c - 0xF2; \
+ int *charbuf_base = charbuf; \
+ int consumed_chars_limit; \
+ int nbytes, nchars; \
+ \
+ ONE_MORE_BYTE (c); \
+ if (c < 0) \
+ goto invalid_code; \
+ nbytes = c - 0xA0; \
+ if (nbytes < 3) \
+ goto invalid_code; \
+ ONE_MORE_BYTE (c); \
+ if (c < 0) \
+ goto invalid_code; \
+ nchars = c - 0xA0; \
+ ADD_COMPOSITION_DATA (charbuf, nchars, method); \
+ consumed_chars_limit = consumed_chars_base + nbytes; \
+ if (method != COMPOSITION_RELATIVE) \
+ { \
+ int i = 0; \
+ while (consumed_chars < consumed_chars_limit) \
+ { \
+ if (i % 2 && method != COMPOSITION_WITH_ALTCHARS) \
+ DECODE_EMACS_MULE_COMPOSITION_RULE_21 (charbuf); \
+ else \
+ DECODE_EMACS_MULE_COMPOSITION_CHAR (charbuf); \
+ i++; \
+ } \
+ if (consumed_chars < consumed_chars_limit) \
+ goto invalid_code; \
+ charbuf_base[0] -= i; \
+ } \
+ } while (0)
+
+
+#define DECODE_EMACS_MULE_20_RELATIVE_COMPOSITION(c) \
+ do { \
+ /* Emacs 20 style format for relative composition. */ \
+ /* Store multibyte form of characters to be composed. */ \
+ enum composition_method method = COMPOSITION_RELATIVE; \
+ int components[MAX_COMPOSITION_COMPONENTS * 2 - 1]; \
+ int *buf = components; \
+ int i, j; \
+ \
+ src = src_base; \
+ ONE_MORE_BYTE (c); /* skip 0x80 */ \
+ for (i = 0; *src >= 0xA0 && i < MAX_COMPOSITION_COMPONENTS; i++) \
+ DECODE_EMACS_MULE_COMPOSITION_CHAR (buf); \
+ if (i < 2) \
+ goto invalid_code; \
+ ADD_COMPOSITION_DATA (charbuf, i, method); \
+ for (j = 0; j < i; j++) \
+ *charbuf++ = components[j]; \
+ } while (0)
+
+
+#define DECODE_EMACS_MULE_20_RULEBASE_COMPOSITION(c) \
+ do { \
+ /* Emacs 20 style format for rule-base composition. */ \
+ /* Store multibyte form of characters to be composed. */ \
+ enum composition_method method = COMPOSITION_WITH_RULE; \
+ int *charbuf_base = charbuf; \
+ int components[MAX_COMPOSITION_COMPONENTS * 2 - 1]; \
+ int *buf = components; \
+ int i, j; \
+ \
+ DECODE_EMACS_MULE_COMPOSITION_CHAR (buf); \
+ for (i = 1; i < MAX_COMPOSITION_COMPONENTS; i++) \
+ { \
+ if (*src < 0xA0) \
+ break; \
+ DECODE_EMACS_MULE_COMPOSITION_RULE_20 (buf); \
+ DECODE_EMACS_MULE_COMPOSITION_CHAR (buf); \
+ } \
+ if (i <= 1 || (buf - components) % 2 == 0) \
+ goto invalid_code; \
+ if (charbuf + i + (i / 2) + 1 >= charbuf_end) \
+ goto no_more_source; \
+ ADD_COMPOSITION_DATA (charbuf, i, method); \
+ i = i * 2 - 1; \
+ for (j = 0; j < i; j++) \
+ *charbuf++ = components[j]; \
+ charbuf_base[0] -= i; \
+ for (j = 0; j < i; j += 2) \
+ *charbuf++ = components[j]; \
+ } while (0)
+
+
static void
-decode_coding_emacs_mule (coding, source, destination, src_bytes, dst_bytes)
+decode_coding_emacs_mule (coding)
struct coding_system *coding;
- const unsigned char *source;
- unsigned char *destination;
- int src_bytes, dst_bytes;
{
- const unsigned char *src = source;
- const unsigned char *src_end = source + src_bytes;
- unsigned char *dst = destination;
- unsigned char *dst_end = destination + dst_bytes;
- /* SRC_BASE remembers the start position in source in each loop.
- The loop will be exited when there's not enough source code, or
- when there's not enough destination area to produce a
- character. */
+ const unsigned char *src = coding->source + coding->consumed;
+ const unsigned char *src_end = coding->source + coding->src_bytes;
const unsigned char *src_base;
+ int *charbuf = coding->charbuf + coding->charbuf_used;
+ int *charbuf_end
+ = coding->charbuf + coding->charbuf_size - MAX_ANNOTATION_LENGTH;
+ int consumed_chars = 0, consumed_chars_base;
+ int multibytep = coding->src_multibyte;
+ Lisp_Object attrs, charset_list;
+ int char_offset = coding->produced_char;
+ int last_offset = char_offset;
+ int last_id = charset_ascii;
+
+ CODING_GET_INFO (coding, attrs, charset_list);
- coding->produced_char = 0;
- while ((src_base = src) < src_end)
+ while (1)
{
- unsigned char tmp[MAX_MULTIBYTE_LENGTH];
- const unsigned char *p;
- int bytes;
+ int c;
- if (*src == '\r')
- {
- int c = *src++;
+ src_base = src;
+ consumed_chars_base = consumed_chars;
- if (coding->eol_type == CODING_EOL_CR)
- c = '\n';
- else if (coding->eol_type == CODING_EOL_CRLF)
- {
- ONE_MORE_BYTE (c);
- if (c != '\n')
- {
- src--;
- c = '\r';
- }
- }
- *dst++ = c;
- coding->produced_char++;
- continue;
- }
- else if (*src == '\n')
+ if (charbuf >= charbuf_end)
+ break;
+
+ ONE_MORE_BYTE (c);
+ if (c < 0)
{
- if ((coding->eol_type == CODING_EOL_CR
- || coding->eol_type == CODING_EOL_CRLF)
- && coding->mode & CODING_MODE_INHIBIT_INCONSISTENT_EOL)
- {
- coding->result = CODING_FINISH_INCONSISTENT_EOL;
- goto label_end_of_loop;
- }
- *dst++ = *src++;
- coding->produced_char++;
- continue;
+ *charbuf++ = -c;
+ char_offset++;
}
- else if (*src == 0x80 && coding->cmp_data)
+ else if (c < 0x80)
{
- /* Start of composition data. */
- int consumed = decode_composition_emacs_mule (coding, src, src_end,
- &dst, dst_end,
- dst_bytes);
- if (consumed < 0)
- goto label_end_of_loop;
- else if (consumed > 0)
- {
- src += consumed;
- continue;
- }
- bytes = CHAR_STRING (*src, tmp);
- p = tmp;
- src++;
+ *charbuf++ = c;
+ char_offset++;
}
- else if (UNIBYTE_STR_AS_MULTIBYTE_P (src, src_end - src, bytes)
- || (coding->flags /* We are recovering a file. */
- && src[0] == LEADING_CODE_8_BIT_CONTROL
- && ! CHAR_HEAD_P (src[1])))
+ else if (c == 0x80)
{
- p = src;
- src += bytes;
+ ONE_MORE_BYTE (c);
+ if (c < 0)
+ goto invalid_code;
+ if (c - 0xF2 >= COMPOSITION_RELATIVE
+ && c - 0xF2 <= COMPOSITION_WITH_RULE_ALTCHARS)
+ DECODE_EMACS_MULE_21_COMPOSITION (c);
+ else if (c < 0xC0)
+ DECODE_EMACS_MULE_20_RELATIVE_COMPOSITION (c);
+ else if (c == 0xFF)
+ DECODE_EMACS_MULE_20_RULEBASE_COMPOSITION (c);
+ else
+ goto invalid_code;
}
- else
+ else if (c < 0xA0 && emacs_mule_bytes[c] > 1)
{
- int i, c;
+ int nbytes, nchars;
+ int id;
- bytes = BYTES_BY_CHAR_HEAD (*src);
- src++;
- for (i = 1; i < bytes; i++)
+ src = src_base;
+ consumed_chars = consumed_chars_base;
+ c = emacs_mule_char (coding, src, &nbytes, &nchars, &id);
+ if (c < 0)
{
- ONE_MORE_BYTE (c);
- if (CHAR_HEAD_P (c))
+ if (c == -2)
break;
+ goto invalid_code;
}
- if (i < bytes)
- {
- bytes = CHAR_STRING (*src_base, tmp);
- p = tmp;
- src = src_base + 1;
- }
- else
+ if (last_id != id)
{
- p = src_base;
+ if (last_id != charset_ascii)
+ ADD_CHARSET_DATA (charbuf, char_offset - last_offset, last_id);
+ last_id = id;
+ last_offset = char_offset;
}
+ *charbuf++ = c;
+ src += nbytes;
+ consumed_chars += nchars;
+ char_offset++;
}
- if (dst + bytes >= (dst_bytes ? dst_end : src))
- {
- coding->result = CODING_FINISH_INSUFFICIENT_DST;
- break;
- }
- while (bytes--) *dst++ = *p++;
- coding->produced_char++;
- }
- label_end_of_loop:
- coding->consumed = coding->consumed_char = src_base - source;
- coding->produced = dst - destination;
-}
+ else
+ goto invalid_code;
+ continue;
+ invalid_code:
+ src = src_base;
+ consumed_chars = consumed_chars_base;
+ ONE_MORE_BYTE (c);
+ *charbuf++ = ASCII_BYTE_P (c) ? c : BYTE8_TO_CHAR (c);
+ char_offset++;
+ coding->errors++;
+ }
-/* Encode composition data stored at DATA into a special byte sequence
- starting by 0x80. Update CODING->cmp_data_start and maybe
- CODING->cmp_data for the next call. */
+ no_more_source:
+ if (last_id != charset_ascii)
+ ADD_CHARSET_DATA (charbuf, char_offset - last_offset, last_id);
+ coding->consumed_char += consumed_chars_base;
+ coding->consumed = src_base - coding->source;
+ coding->charbuf_used = charbuf - coding->charbuf;
+}
-#define ENCODE_COMPOSITION_EMACS_MULE(coding, data) \
- do { \
- unsigned char buf[1024], *p0 = buf, *p; \
- int len = data[0]; \
- int i; \
- \
- buf[0] = 0x80; \
- buf[1] = 0xF0 + data[3]; /* METHOD */ \
- buf[3] = 0xA0 + (data[2] - data[1]); /* COMPOSED-CHARS */ \
- p = buf + 4; \
- if (data[3] == COMPOSITION_WITH_RULE \
- || data[3] == COMPOSITION_WITH_RULE_ALTCHARS) \
- { \
- p += CHAR_STRING (data[4], p); \
- for (i = 5; i < len; i += 2) \
- { \
- int gref, nref; \
- COMPOSITION_DECODE_RULE (data[i], gref, nref); \
- *p++ = 0x20 + gref; \
- *p++ = 0x20 + nref; \
- p += CHAR_STRING (data[i + 1], p); \
- } \
- } \
- else \
- { \
- for (i = 4; i < len; i++) \
- p += CHAR_STRING (data[i], p); \
- } \
- buf[2] = 0xA0 + (p - buf); /* COMPONENTS-BYTES */ \
- \
- if (dst + (p - buf) + 4 > (dst_bytes ? dst_end : src)) \
- { \
- coding->result = CODING_FINISH_INSUFFICIENT_DST; \
- goto label_end_of_loop; \
- } \
- while (p0 < p) \
- *dst++ = *p0++; \
- coding->cmp_data_start += data[0]; \
- if (coding->cmp_data_start == coding->cmp_data->used \
- && coding->cmp_data->next) \
- { \
- coding->cmp_data = coding->cmp_data->next; \
- coding->cmp_data_start = 0; \
- } \
- } while (0)
+#define EMACS_MULE_LEADING_CODES(id, codes) \
+ do { \
+ if (id < 0xA0) \
+ codes[0] = id, codes[1] = 0; \
+ else if (id < 0xE0) \
+ codes[0] = 0x9A, codes[1] = id; \
+ else if (id < 0xF0) \
+ codes[0] = 0x9B, codes[1] = id; \
+ else if (id < 0xF5) \
+ codes[0] = 0x9C, codes[1] = id; \
+ else \
+ codes[0] = 0x9D, codes[1] = id; \
+ } while (0);
-static void encode_eol P_ ((struct coding_system *, const unsigned char *,
- unsigned char *, int, int));
-static void
-encode_coding_emacs_mule (coding, source, destination, src_bytes, dst_bytes)
+static int
+encode_coding_emacs_mule (coding)
struct coding_system *coding;
- const unsigned char *source;
- unsigned char *destination;
- int src_bytes, dst_bytes;
{
- const unsigned char *src = source;
- const unsigned char *src_end = source + src_bytes;
- unsigned char *dst = destination;
- unsigned char *dst_end = destination + dst_bytes;
- const unsigned char *src_base;
+ int multibytep = coding->dst_multibyte;
+ int *charbuf = coding->charbuf;
+ int *charbuf_end = charbuf + coding->charbuf_used;
+ unsigned char *dst = coding->destination + coding->produced;
+ unsigned char *dst_end = coding->destination + coding->dst_bytes;
+ int safe_room = 8;
+ int produced_chars = 0;
+ Lisp_Object attrs, charset_list;
int c;
- int char_offset;
- int *data;
-
- Lisp_Object translation_table;
+ int preferred_charset_id = -1;
- translation_table = Qnil;
-
- /* Optimization for the case that there's no composition. */
- if (!coding->cmp_data || coding->cmp_data->used == 0)
+ CODING_GET_INFO (coding, attrs, charset_list);
+ if (! EQ (charset_list, Vemacs_mule_charset_list))
{
- encode_eol (coding, source, destination, src_bytes, dst_bytes);
- return;
+ CODING_ATTR_CHARSET_LIST (attrs)
+ = charset_list = Vemacs_mule_charset_list;
}
- char_offset = coding->cmp_data->char_offset;
- data = coding->cmp_data->data + coding->cmp_data_start;
- while (1)
+ while (charbuf < charbuf_end)
{
- src_base = src;
+ ASSURE_DESTINATION (safe_room);
+ c = *charbuf++;
- /* If SRC starts a composition, encode the information about the
- composition in advance. */
- if (coding->cmp_data_start < coding->cmp_data->used
- && char_offset + coding->consumed_char == data[1])
+ if (c < 0)
{
- ENCODE_COMPOSITION_EMACS_MULE (coding, data);
- char_offset = coding->cmp_data->char_offset;
- data = coding->cmp_data->data + coding->cmp_data_start;
+ /* Handle an annotation. */
+ switch (*charbuf)
+ {
+ case CODING_ANNOTATE_COMPOSITION_MASK:
+ /* Not yet implemented. */
+ break;
+ case CODING_ANNOTATE_CHARSET_MASK:
+ preferred_charset_id = charbuf[3];
+ if (preferred_charset_id >= 0
+ && NILP (Fmemq (make_number (preferred_charset_id),
+ charset_list)))
+ preferred_charset_id = -1;
+ break;
+ default:
+ abort ();
+ }
+ charbuf += -c - 1;
+ continue;
}
- ONE_MORE_CHAR (c);
- if (c == '\n' && (coding->eol_type == CODING_EOL_CRLF
- || coding->eol_type == CODING_EOL_CR))
+ if (ASCII_CHAR_P (c))
+ EMIT_ONE_ASCII_BYTE (c);
+ else if (CHAR_BYTE8_P (c))
{
- if (coding->eol_type == CODING_EOL_CRLF)
- EMIT_TWO_BYTES ('\r', c);
- else
- EMIT_ONE_BYTE ('\r');
+ c = CHAR_TO_BYTE8 (c);
+ EMIT_ONE_BYTE (c);
}
- else if (SINGLE_BYTE_CHAR_P (c))
+ else
{
- if (coding->flags && ! ASCII_BYTE_P (c))
- {
- /* As we are auto saving, retain the multibyte form for
- 8-bit chars. */
- unsigned char buf[MAX_MULTIBYTE_LENGTH];
- int bytes = CHAR_STRING (c, buf);
+ struct charset *charset;
+ unsigned code;
+ int dimension;
+ int emacs_mule_id;
+ unsigned char leading_codes[2];
- if (bytes == 1)
- EMIT_ONE_BYTE (buf[0]);
- else
- EMIT_TWO_BYTES (buf[0], buf[1]);
+ if (preferred_charset_id >= 0)
+ {
+ charset = CHARSET_FROM_ID (preferred_charset_id);
+ if (! CHAR_CHARSET_P (c, charset))
+ charset = char_charset (c, charset_list, NULL);
}
else
- EMIT_ONE_BYTE (c);
+ charset = char_charset (c, charset_list, &code);
+ if (! charset)
+ {
+ c = coding->default_char;
+ if (ASCII_CHAR_P (c))
+ {
+ EMIT_ONE_ASCII_BYTE (c);
+ continue;
+ }
+ charset = char_charset (c, charset_list, &code);
+ }
+ dimension = CHARSET_DIMENSION (charset);
+ emacs_mule_id = CHARSET_EMACS_MULE_ID (charset);
+ EMACS_MULE_LEADING_CODES (emacs_mule_id, leading_codes);
+ EMIT_ONE_BYTE (leading_codes[0]);
+ if (leading_codes[1])
+ EMIT_ONE_BYTE (leading_codes[1]);
+ if (dimension == 1)
+ EMIT_ONE_BYTE (code | 0x80);
+ else
+ {
+ code |= 0x8080;
+ EMIT_ONE_BYTE (code >> 8);
+ EMIT_ONE_BYTE (code & 0xFF);
+ }
}
- else
- EMIT_BYTES (src_base, src);
- coding->consumed_char++;
}
- label_end_of_loop:
- coding->consumed = src_base - source;
- coding->produced = coding->produced_char = dst - destination;
- return;
+ record_conversion_result (coding, CODING_RESULT_SUCCESS);
+ coding->produced_char += produced_chars;
+ coding->produced = dst - coding->destination;
+ return 0;
}
\f
-/*** 3. ISO2022 handlers ***/
+/*** 7. ISO2022 handlers ***/
/* The following note describes the coding system ISO2022 briefly.
Since the intention of this note is to help understand the
7-bit environment, non-locking-shift, and non-single-shift.
Note (**): If <F> is '@', 'A', or 'B', the intermediate character
- '(' can be omitted. We refer to this as "short-form" hereafter.
+ '(' must be omitted. We refer to this as "short-form" hereafter.
Now you may notice that there are a lot of ways of encoding the
same multilingual text in ISO2022. Actually, there exist many
Since these are not standard escape sequences of any ISO standard,
the use of them with these meanings is restricted to Emacs only.
- (*) This form is used only in Emacs 20.5 and older versions,
- but the newer versions can safely decode it.
+ (*) This form is used only in Emacs 20.7 and older versions,
+ but newer versions can safely decode it.
(**) This form is used only in Emacs 21.1 and newer versions,
- and the older versions can't decode it.
+ and older versions can't decode it.
Here's a list of example usages of these composition escape
sequences (categorized by `enum composition_method').
enum iso_code_class_type iso_code_class[256];
-#define CHARSET_OK(idx, charset, c) \
- (coding_system_table[idx] \
- && (charset == CHARSET_ASCII \
- || (safe_chars = coding_safe_chars (coding_system_table[idx]->symbol), \
- CODING_SAFE_CHAR_P (safe_chars, c))) \
- && (CODING_SPEC_ISO_REQUESTED_DESIGNATION (coding_system_table[idx], \
- charset) \
- != CODING_SPEC_ISO_NO_REQUESTED_DESIGNATION))
+#define SAFE_CHARSET_P(coding, id) \
+ ((id) <= (coding)->max_charset_id \
+ && (coding)->safe_charsets[id] >= 0)
+
+
+#define SHIFT_OUT_OK(category) \
+ (CODING_ISO_INITIAL (&coding_categories[category], 1) >= 0)
-#define SHIFT_OUT_OK(idx) \
- (CODING_SPEC_ISO_INITIAL_DESIGNATION (coding_system_table[idx], 1) >= 0)
+static void
+setup_iso_safe_charsets (attrs)
+ Lisp_Object attrs;
+{
+ Lisp_Object charset_list, safe_charsets;
+ Lisp_Object request;
+ Lisp_Object reg_usage;
+ Lisp_Object tail;
+ int reg94, reg96;
+ int flags = XINT (AREF (attrs, coding_attr_iso_flags));
+ int max_charset_id;
+
+ charset_list = CODING_ATTR_CHARSET_LIST (attrs);
+ if ((flags & CODING_ISO_FLAG_FULL_SUPPORT)
+ && ! EQ (charset_list, Viso_2022_charset_list))
+ {
+ CODING_ATTR_CHARSET_LIST (attrs)
+ = charset_list = Viso_2022_charset_list;
+ ASET (attrs, coding_attr_safe_charsets, Qnil);
+ }
+
+ if (STRINGP (AREF (attrs, coding_attr_safe_charsets)))
+ return;
+
+ max_charset_id = 0;
+ for (tail = charset_list; CONSP (tail); tail = XCDR (tail))
+ {
+ int id = XINT (XCAR (tail));
+ if (max_charset_id < id)
+ max_charset_id = id;
+ }
+
+ safe_charsets = Fmake_string (make_number (max_charset_id + 1),
+ make_number (255));
+ request = AREF (attrs, coding_attr_iso_request);
+ reg_usage = AREF (attrs, coding_attr_iso_usage);
+ reg94 = XINT (XCAR (reg_usage));
+ reg96 = XINT (XCDR (reg_usage));
+
+ for (tail = charset_list; CONSP (tail); tail = XCDR (tail))
+ {
+ Lisp_Object id;
+ Lisp_Object reg;
+ struct charset *charset;
+
+ id = XCAR (tail);
+ charset = CHARSET_FROM_ID (XINT (id));
+ reg = Fcdr (Fassq (id, request));
+ if (! NILP (reg))
+ SSET (safe_charsets, XINT (id), XINT (reg));
+ else if (charset->iso_chars_96)
+ {
+ if (reg96 < 4)
+ SSET (safe_charsets, XINT (id), reg96);
+ }
+ else
+ {
+ if (reg94 < 4)
+ SSET (safe_charsets, XINT (id), reg94);
+ }
+ }
+ ASET (attrs, coding_attr_safe_charsets, safe_charsets);
+}
-#define COMPOSITION_OK(idx) \
- (coding_system_table[idx]->composing != COMPOSITION_DISABLED)
/* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions".
- Check if a text is encoded in ISO2022. If it is, return an
- integer in which appropriate flag bits any of:
- CODING_CATEGORY_MASK_ISO_7
- CODING_CATEGORY_MASK_ISO_7_TIGHT
- CODING_CATEGORY_MASK_ISO_8_1
- CODING_CATEGORY_MASK_ISO_8_2
- CODING_CATEGORY_MASK_ISO_7_ELSE
- CODING_CATEGORY_MASK_ISO_8_ELSE
- are set. If a code which should never appear in ISO2022 is found,
- returns 0. */
+ Check if a text is encoded in one of ISO-2022 based codig systems.
+ If it is, return 1, else return 0. */
static int
-detect_coding_iso2022 (src, src_end, multibytep)
- unsigned char *src, *src_end;
- int multibytep;
+detect_coding_iso_2022 (coding, detect_info)
+ struct coding_system *coding;
+ struct coding_detection_info *detect_info;
{
- int mask = CODING_CATEGORY_MASK_ISO;
- int mask_found = 0;
- int reg[4], shift_out = 0, single_shifting = 0;
- int c, c1, charset;
- /* Dummy for ONE_MORE_BYTE. */
- struct coding_system dummy_coding;
- struct coding_system *coding = &dummy_coding;
- Lisp_Object safe_chars;
-
- reg[0] = CHARSET_ASCII, reg[1] = reg[2] = reg[3] = -1;
- while (mask)
- {
- ONE_MORE_BYTE_CHECK_MULTIBYTE (c, multibytep, mask & mask_found);
- retry:
+ const unsigned char *src = coding->source, *src_base = src;
+ const unsigned char *src_end = coding->source + coding->src_bytes;
+ int multibytep = coding->src_multibyte;
+ int single_shifting = 0;
+ int id;
+ int c, c1;
+ int consumed_chars = 0;
+ int i;
+ int rejected = 0;
+ int found = 0;
+
+ detect_info->checked |= CATEGORY_MASK_ISO;
+
+ for (i = coding_category_iso_7; i <= coding_category_iso_8_else; i++)
+ {
+ struct coding_system *this = &(coding_categories[i]);
+ Lisp_Object attrs, val;
+
+ attrs = CODING_ID_ATTRS (this->id);
+ if (CODING_ISO_FLAGS (this) & CODING_ISO_FLAG_FULL_SUPPORT
+ && ! EQ (CODING_ATTR_SAFE_CHARSETS (attrs), Viso_2022_charset_list))
+ setup_iso_safe_charsets (attrs);
+ val = CODING_ATTR_SAFE_CHARSETS (attrs);
+ this->max_charset_id = SCHARS (val) - 1;
+ this->safe_charsets = (char *) SDATA (val);
+ }
+
+ /* A coding system of this category is always ASCII compatible. */
+ src += coding->head_ascii;
+
+ while (rejected != CATEGORY_MASK_ISO)
+ {
+ src_base = src;
+ ONE_MORE_BYTE (c);
switch (c)
{
case ISO_CODE_ESC:
if (inhibit_iso_escape_detection)
break;
single_shifting = 0;
- ONE_MORE_BYTE_CHECK_MULTIBYTE (c, multibytep, mask & mask_found);
+ ONE_MORE_BYTE (c);
if (c >= '(' && c <= '/')
{
/* Designation sequence for a charset of dimension 1. */
- ONE_MORE_BYTE_CHECK_MULTIBYTE (c1, multibytep, mask & mask_found);
+ ONE_MORE_BYTE (c1);
if (c1 < ' ' || c1 >= 0x80
- || (charset = iso_charset_table[0][c >= ','][c1]) < 0)
+ || (id = iso_charset_table[0][c >= ','][c1]) < 0)
/* Invalid designation sequence. Just ignore. */
break;
- reg[(c - '(') % 4] = charset;
}
else if (c == '$')
{
/* Designation sequence for a charset of dimension 2. */
- ONE_MORE_BYTE_CHECK_MULTIBYTE (c, multibytep, mask & mask_found);
+ ONE_MORE_BYTE (c);
if (c >= '@' && c <= 'B')
/* Designation for JISX0208.1978, GB2312, or JISX0208. */
- reg[0] = charset = iso_charset_table[1][0][c];
+ id = iso_charset_table[1][0][c];
else if (c >= '(' && c <= '/')
{
- ONE_MORE_BYTE_CHECK_MULTIBYTE (c1, multibytep,
- mask & mask_found);
+ ONE_MORE_BYTE (c1);
if (c1 < ' ' || c1 >= 0x80
- || (charset = iso_charset_table[1][c >= ','][c1]) < 0)
+ || (id = iso_charset_table[1][c >= ','][c1]) < 0)
/* Invalid designation sequence. Just ignore. */
break;
- reg[(c - '(') % 4] = charset;
}
else
- /* Invalid designation sequence. Just ignore. */
+ /* Invalid designation sequence. Just ignore it. */
break;
}
else if (c == 'N' || c == 'O')
{
/* ESC <Fe> for SS2 or SS3. */
- mask &= CODING_CATEGORY_MASK_ISO_7_ELSE;
+ single_shifting = 1;
+ rejected |= CATEGORY_MASK_ISO_7BIT | CATEGORY_MASK_ISO_8BIT;
break;
}
else if (c >= '0' && c <= '4')
{
/* ESC <Fp> for start/end composition. */
- if (COMPOSITION_OK (CODING_CATEGORY_IDX_ISO_7))
- mask_found |= CODING_CATEGORY_MASK_ISO_7;
- else
- mask &= ~CODING_CATEGORY_MASK_ISO_7;
- if (COMPOSITION_OK (CODING_CATEGORY_IDX_ISO_7_TIGHT))
- mask_found |= CODING_CATEGORY_MASK_ISO_7_TIGHT;
- else
- mask &= ~CODING_CATEGORY_MASK_ISO_7_TIGHT;
- if (COMPOSITION_OK (CODING_CATEGORY_IDX_ISO_8_1))
- mask_found |= CODING_CATEGORY_MASK_ISO_8_1;
- else
- mask &= ~CODING_CATEGORY_MASK_ISO_8_1;
- if (COMPOSITION_OK (CODING_CATEGORY_IDX_ISO_8_2))
- mask_found |= CODING_CATEGORY_MASK_ISO_8_2;
- else
- mask &= ~CODING_CATEGORY_MASK_ISO_8_2;
- if (COMPOSITION_OK (CODING_CATEGORY_IDX_ISO_7_ELSE))
- mask_found |= CODING_CATEGORY_MASK_ISO_7_ELSE;
- else
- mask &= ~CODING_CATEGORY_MASK_ISO_7_ELSE;
- if (COMPOSITION_OK (CODING_CATEGORY_IDX_ISO_8_ELSE))
- mask_found |= CODING_CATEGORY_MASK_ISO_8_ELSE;
- else
- mask &= ~CODING_CATEGORY_MASK_ISO_8_ELSE;
+ found |= CATEGORY_MASK_ISO;
break;
}
else
- /* Invalid escape sequence. Just ignore. */
- break;
+ {
+ /* Invalid escape sequence. Just ignore it. */
+ break;
+ }
/* We found a valid designation sequence for CHARSET. */
- mask &= ~CODING_CATEGORY_MASK_ISO_8BIT;
- c = MAKE_CHAR (charset, 0, 0);
- if (CHARSET_OK (CODING_CATEGORY_IDX_ISO_7, charset, c))
- mask_found |= CODING_CATEGORY_MASK_ISO_7;
+ rejected |= CATEGORY_MASK_ISO_8BIT;
+ if (SAFE_CHARSET_P (&coding_categories[coding_category_iso_7],
+ id))
+ found |= CATEGORY_MASK_ISO_7;
else
- mask &= ~CODING_CATEGORY_MASK_ISO_7;
- if (CHARSET_OK (CODING_CATEGORY_IDX_ISO_7_TIGHT, charset, c))
- mask_found |= CODING_CATEGORY_MASK_ISO_7_TIGHT;
+ rejected |= CATEGORY_MASK_ISO_7;
+ if (SAFE_CHARSET_P (&coding_categories[coding_category_iso_7_tight],
+ id))
+ found |= CATEGORY_MASK_ISO_7_TIGHT;
else
- mask &= ~CODING_CATEGORY_MASK_ISO_7_TIGHT;
- if (CHARSET_OK (CODING_CATEGORY_IDX_ISO_7_ELSE, charset, c))
- mask_found |= CODING_CATEGORY_MASK_ISO_7_ELSE;
+ rejected |= CATEGORY_MASK_ISO_7_TIGHT;
+ if (SAFE_CHARSET_P (&coding_categories[coding_category_iso_7_else],
+ id))
+ found |= CATEGORY_MASK_ISO_7_ELSE;
else
- mask &= ~CODING_CATEGORY_MASK_ISO_7_ELSE;
- if (CHARSET_OK (CODING_CATEGORY_IDX_ISO_8_ELSE, charset, c))
- mask_found |= CODING_CATEGORY_MASK_ISO_8_ELSE;
+ rejected |= CATEGORY_MASK_ISO_7_ELSE;
+ if (SAFE_CHARSET_P (&coding_categories[coding_category_iso_8_else],
+ id))
+ found |= CATEGORY_MASK_ISO_8_ELSE;
else
- mask &= ~CODING_CATEGORY_MASK_ISO_8_ELSE;
+ rejected |= CATEGORY_MASK_ISO_8_ELSE;
break;
case ISO_CODE_SO:
- if (inhibit_iso_escape_detection)
- break;
- single_shifting = 0;
- if (shift_out == 0
- && (reg[1] >= 0
- || SHIFT_OUT_OK (CODING_CATEGORY_IDX_ISO_7_ELSE)
- || SHIFT_OUT_OK (CODING_CATEGORY_IDX_ISO_8_ELSE)))
- {
- /* Locking shift out. */
- mask &= ~CODING_CATEGORY_MASK_ISO_7BIT;
- mask_found |= CODING_CATEGORY_MASK_ISO_SHIFT;
- }
- break;
-
case ISO_CODE_SI:
+ /* Locking shift out/in. */
if (inhibit_iso_escape_detection)
break;
single_shifting = 0;
- if (shift_out == 1)
- {
- /* Locking shift in. */
- mask &= ~CODING_CATEGORY_MASK_ISO_7BIT;
- mask_found |= CODING_CATEGORY_MASK_ISO_SHIFT;
- }
+ rejected |= CATEGORY_MASK_ISO_7BIT | CATEGORY_MASK_ISO_8BIT;
break;
case ISO_CODE_CSI:
+ /* Control sequence introducer. */
single_shifting = 0;
+ rejected |= CATEGORY_MASK_ISO_7BIT | CATEGORY_MASK_ISO_7_ELSE;
+ found |= CATEGORY_MASK_ISO_8_ELSE;
+ goto check_extra_latin;
+
case ISO_CODE_SS2:
case ISO_CODE_SS3:
- {
- int newmask = CODING_CATEGORY_MASK_ISO_8_ELSE;
-
- if (inhibit_iso_escape_detection)
- break;
- if (c != ISO_CODE_CSI)
- {
- if (coding_system_table[CODING_CATEGORY_IDX_ISO_8_1]->flags
- & CODING_FLAG_ISO_SINGLE_SHIFT)
- newmask |= CODING_CATEGORY_MASK_ISO_8_1;
- if (coding_system_table[CODING_CATEGORY_IDX_ISO_8_2]->flags
- & CODING_FLAG_ISO_SINGLE_SHIFT)
- newmask |= CODING_CATEGORY_MASK_ISO_8_2;
- single_shifting = 1;
- }
- if (VECTORP (Vlatin_extra_code_table)
- && !NILP (XVECTOR (Vlatin_extra_code_table)->contents[c]))
- {
- if (coding_system_table[CODING_CATEGORY_IDX_ISO_8_1]->flags
- & CODING_FLAG_ISO_LATIN_EXTRA)
- newmask |= CODING_CATEGORY_MASK_ISO_8_1;
- if (coding_system_table[CODING_CATEGORY_IDX_ISO_8_2]->flags
- & CODING_FLAG_ISO_LATIN_EXTRA)
- newmask |= CODING_CATEGORY_MASK_ISO_8_2;
- }
- mask &= newmask;
- mask_found |= newmask;
- }
- break;
+ /* Single shift. */
+ if (inhibit_iso_escape_detection)
+ break;
+ single_shifting = 0;
+ rejected |= CATEGORY_MASK_ISO_7BIT;
+ if (CODING_ISO_FLAGS (&coding_categories[coding_category_iso_8_1])
+ & CODING_ISO_FLAG_SINGLE_SHIFT)
+ found |= CATEGORY_MASK_ISO_8_1, single_shifting = 1;
+ if (CODING_ISO_FLAGS (&coding_categories[coding_category_iso_8_2])
+ & CODING_ISO_FLAG_SINGLE_SHIFT)
+ found |= CATEGORY_MASK_ISO_8_2, single_shifting = 1;
+ if (single_shifting)
+ break;
+ goto check_extra_latin;
default:
+ if (c < 0)
+ continue;
if (c < 0x80)
{
single_shifting = 0;
break;
}
- else if (c < 0xA0)
- {
- single_shifting = 0;
- if (VECTORP (Vlatin_extra_code_table)
- && !NILP (XVECTOR (Vlatin_extra_code_table)->contents[c]))
- {
- int newmask = 0;
-
- if (coding_system_table[CODING_CATEGORY_IDX_ISO_8_1]->flags
- & CODING_FLAG_ISO_LATIN_EXTRA)
- newmask |= CODING_CATEGORY_MASK_ISO_8_1;
- if (coding_system_table[CODING_CATEGORY_IDX_ISO_8_2]->flags
- & CODING_FLAG_ISO_LATIN_EXTRA)
- newmask |= CODING_CATEGORY_MASK_ISO_8_2;
- mask &= newmask;
- mask_found |= newmask;
- }
- else
- return 0;
- }
- else
+ if (c >= 0xA0)
{
- mask &= ~(CODING_CATEGORY_MASK_ISO_7BIT
- | CODING_CATEGORY_MASK_ISO_7_ELSE);
- mask_found |= CODING_CATEGORY_MASK_ISO_8_1;
+ rejected |= CATEGORY_MASK_ISO_7BIT | CATEGORY_MASK_ISO_7_ELSE;
+ found |= CATEGORY_MASK_ISO_8_1;
/* Check the length of succeeding codes of the range
- 0xA0..0FF. If the byte length is odd, we exclude
- CODING_CATEGORY_MASK_ISO_8_2. We can check this only
- when we are not single shifting. */
- if (!single_shifting
- && mask & CODING_CATEGORY_MASK_ISO_8_2)
+ 0xA0..0FF. If the byte length is even, we include
+ CATEGORY_MASK_ISO_8_2 in `found'. We can check this
+ only when we are not single shifting. */
+ if (! single_shifting
+ && ! (rejected & CATEGORY_MASK_ISO_8_2))
{
int i = 1;
-
- c = -1;
while (src < src_end)
{
- ONE_MORE_BYTE_CHECK_MULTIBYTE (c, multibytep,
- mask & mask_found);
+ ONE_MORE_BYTE (c);
if (c < 0xA0)
break;
i++;
}
if (i & 1 && src < src_end)
- mask &= ~CODING_CATEGORY_MASK_ISO_8_2;
+ rejected |= CATEGORY_MASK_ISO_8_2;
else
- mask_found |= CODING_CATEGORY_MASK_ISO_8_2;
- if (c >= 0)
- /* This means that we have read one extra byte. */
- goto retry;
+ found |= CATEGORY_MASK_ISO_8_2;
}
+ break;
}
- break;
+ check_extra_latin:
+ single_shifting = 0;
+ if (! VECTORP (Vlatin_extra_code_table)
+ || NILP (XVECTOR (Vlatin_extra_code_table)->contents[c]))
+ {
+ rejected = CATEGORY_MASK_ISO;
+ break;
+ }
+ if (CODING_ISO_FLAGS (&coding_categories[coding_category_iso_8_1])
+ & CODING_ISO_FLAG_LATIN_EXTRA)
+ found |= CATEGORY_MASK_ISO_8_1;
+ else
+ rejected |= CATEGORY_MASK_ISO_8_1;
+ rejected |= CATEGORY_MASK_ISO_8_2;
}
}
- return (mask & mask_found);
-}
+ detect_info->rejected |= CATEGORY_MASK_ISO;
+ return 0;
-/* Decode a character of which charset is CHARSET, the 1st position
- code is C1, the 2nd position code is C2, and return the decoded
- character code. If the variable `translation_table' is non-nil,
- returned the translated code. */
+ no_more_source:
+ detect_info->rejected |= rejected;
+ detect_info->found |= (found & ~rejected);
+ return 1;
+}
-#define DECODE_ISO_CHARACTER(charset, c1, c2) \
- (NILP (translation_table) \
- ? MAKE_CHAR (charset, c1, c2) \
- : translate_char (translation_table, -1, charset, c1, c2))
-/* Set designation state into CODING. */
-#define DECODE_DESIGNATION(reg, dimension, chars, final_char) \
- do { \
- int charset, c; \
- \
- if (final_char < '0' || final_char >= 128) \
- goto label_invalid_code; \
- charset = ISO_CHARSET_TABLE (make_number (dimension), \
- make_number (chars), \
- make_number (final_char)); \
- c = MAKE_CHAR (charset, 0, 0); \
- if (charset >= 0 \
- && (CODING_SPEC_ISO_REQUESTED_DESIGNATION (coding, charset) == reg \
- || CODING_SAFE_CHAR_P (safe_chars, c))) \
- { \
- if (coding->spec.iso2022.last_invalid_designation_register == 0 \
- && reg == 0 \
- && charset == CHARSET_ASCII) \
- { \
- /* We should insert this designation sequence as is so \
- that it is surely written back to a file. */ \
- coding->spec.iso2022.last_invalid_designation_register = -1; \
- goto label_invalid_code; \
- } \
- coding->spec.iso2022.last_invalid_designation_register = -1; \
- if ((coding->mode & CODING_MODE_DIRECTION) \
- && CHARSET_REVERSE_CHARSET (charset) >= 0) \
- charset = CHARSET_REVERSE_CHARSET (charset); \
- CODING_SPEC_ISO_DESIGNATION (coding, reg) = charset; \
- } \
- else \
- { \
- coding->spec.iso2022.last_invalid_designation_register = reg; \
- goto label_invalid_code; \
- } \
+/* Set designation state into CODING. Set CHARS_96 to -1 if the
+ escape sequence should be kept. */
+#define DECODE_DESIGNATION(reg, dim, chars_96, final) \
+ do { \
+ int id, prev; \
+ \
+ if (final < '0' || final >= 128 \
+ || ((id = ISO_CHARSET_TABLE (dim, chars_96, final)) < 0) \
+ || !SAFE_CHARSET_P (coding, id)) \
+ { \
+ CODING_ISO_DESIGNATION (coding, reg) = -2; \
+ chars_96 = -1; \
+ break; \
+ } \
+ prev = CODING_ISO_DESIGNATION (coding, reg); \
+ if (id == charset_jisx0201_roman) \
+ { \
+ if (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_USE_ROMAN) \
+ id = charset_ascii; \
+ } \
+ else if (id == charset_jisx0208_1978) \
+ { \
+ if (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_USE_OLDJIS) \
+ id = charset_jisx0208; \
+ } \
+ CODING_ISO_DESIGNATION (coding, reg) = id; \
+ /* If there was an invalid designation to REG previously, and this \
+ designation is ASCII to REG, we should keep this designation \
+ sequence. */ \
+ if (prev == -2 && id == charset_ascii) \
+ chars_96 = -1; \
} while (0)
-/* Allocate a memory block for storing information about compositions.
- The block is chained to the already allocated blocks. */
-void
-coding_allocate_composition_data (coding, char_offset)
- struct coding_system *coding;
- int char_offset;
-{
- struct composition_data *cmp_data
- = (struct composition_data *) xmalloc (sizeof *cmp_data);
-
- cmp_data->char_offset = char_offset;
- cmp_data->used = 0;
- cmp_data->prev = coding->cmp_data;
- cmp_data->next = NULL;
- if (coding->cmp_data)
- coding->cmp_data->next = cmp_data;
- coding->cmp_data = cmp_data;
- coding->cmp_data_start = 0;
- coding->composing = COMPOSITION_NO;
-}
+#define MAYBE_FINISH_COMPOSITION() \
+ do { \
+ int i; \
+ if (composition_state == COMPOSING_NO) \
+ break; \
+ /* It is assured that we have enough room for producing \
+ characters stored in the table `components'. */ \
+ if (charbuf + component_idx > charbuf_end) \
+ goto no_more_source; \
+ composition_state = COMPOSING_NO; \
+ if (method == COMPOSITION_RELATIVE \
+ || method == COMPOSITION_WITH_ALTCHARS) \
+ { \
+ for (i = 0; i < component_idx; i++) \
+ *charbuf++ = components[i]; \
+ char_offset += component_idx; \
+ } \
+ else \
+ { \
+ for (i = 0; i < component_idx; i += 2) \
+ *charbuf++ = components[i]; \
+ char_offset += (component_idx / 2) + 1; \
+ } \
+ } while (0)
+
/* Handle composition start sequence ESC 0, ESC 2, ESC 3, or ESC 4.
ESC 0 : relative composition : ESC 0 CHAR ... ESC 1
ESC 2 : rulebase composition : ESC 2 CHAR RULE CHAR RULE ... CHAR ESC 1
- ESC 3 : altchar composition : ESC 3 ALT ... ESC 0 CHAR ... ESC 1
- ESC 4 : alt&rule composition : ESC 4 ALT RULE .. ALT ESC 0 CHAR ... ESC 1
+ ESC 3 : altchar composition : ESC 3 CHAR ... ESC 0 CHAR ... ESC 1
+ ESC 4 : alt&rule composition : ESC 4 CHAR RULE ... CHAR ESC 0 CHAR ... ESC 1
*/
-#define DECODE_COMPOSITION_START(c1) \
- do { \
- if (coding->composing == COMPOSITION_DISABLED) \
- { \
- *dst++ = ISO_CODE_ESC; \
- *dst++ = c1 & 0x7f; \
- coding->produced_char += 2; \
- } \
- else if (!COMPOSING_P (coding)) \
- { \
- /* This is surely the start of a composition. We must be sure \
- that coding->cmp_data has enough space to store the \
- information about the composition. If not, terminate the \
- current decoding loop, allocate one more memory block for \
- coding->cmp_data in the caller, then start the decoding \
- loop again. We can't allocate memory here directly because \
- it may cause buffer/string relocation. */ \
- if (!coding->cmp_data \
- || (coding->cmp_data->used + COMPOSITION_DATA_MAX_BUNCH_LENGTH \
- >= COMPOSITION_DATA_SIZE)) \
- { \
- coding->result = CODING_FINISH_INSUFFICIENT_CMP; \
- goto label_end_of_loop; \
- } \
- coding->composing = (c1 == '0' ? COMPOSITION_RELATIVE \
- : c1 == '2' ? COMPOSITION_WITH_RULE \
- : c1 == '3' ? COMPOSITION_WITH_ALTCHARS \
- : COMPOSITION_WITH_RULE_ALTCHARS); \
- CODING_ADD_COMPOSITION_START (coding, coding->produced_char, \
- coding->composing); \
- coding->composition_rule_follows = 0; \
- } \
- else \
- { \
- /* We are already handling a composition. If the method is \
- the following two, the codes following the current escape \
- sequence are actual characters stored in a buffer. */ \
- if (coding->composing == COMPOSITION_WITH_ALTCHARS \
- || coding->composing == COMPOSITION_WITH_RULE_ALTCHARS) \
- { \
- coding->composing = COMPOSITION_RELATIVE; \
- coding->composition_rule_follows = 0; \
- } \
- } \
+#define DECODE_COMPOSITION_START(c1) \
+ do { \
+ if (c1 == '0' \
+ && composition_state == COMPOSING_COMPONENT_RULE) \
+ { \
+ component_len = component_idx; \
+ composition_state = COMPOSING_CHAR; \
+ } \
+ else \
+ { \
+ const unsigned char *p; \
+ \
+ MAYBE_FINISH_COMPOSITION (); \
+ if (charbuf + MAX_COMPOSITION_COMPONENTS > charbuf_end) \
+ goto no_more_source; \
+ for (p = src; p < src_end - 1; p++) \
+ if (*p == ISO_CODE_ESC && p[1] == '1') \
+ break; \
+ if (p == src_end - 1) \
+ { \
+ /* The current composition doesn't end in the current \
+ source. */ \
+ record_conversion_result \
+ (coding, CODING_RESULT_INSUFFICIENT_SRC); \
+ goto no_more_source; \
+ } \
+ \
+ /* This is surely the start of a composition. */ \
+ method = (c1 == '0' ? COMPOSITION_RELATIVE \
+ : c1 == '2' ? COMPOSITION_WITH_RULE \
+ : c1 == '3' ? COMPOSITION_WITH_ALTCHARS \
+ : COMPOSITION_WITH_RULE_ALTCHARS); \
+ composition_state = (c1 <= '2' ? COMPOSING_CHAR \
+ : COMPOSING_COMPONENT_CHAR); \
+ component_idx = component_len = 0; \
+ } \
} while (0)
-/* Handle composition end sequence ESC 1. */
-#define DECODE_COMPOSITION_END(c1) \
+/* Handle compositoin end sequence ESC 1. */
+
+#define DECODE_COMPOSITION_END() \
do { \
- if (! COMPOSING_P (coding)) \
+ int nchars = (component_len > 0 ? component_idx - component_len \
+ : method == COMPOSITION_RELATIVE ? component_idx \
+ : (component_idx + 1) / 2); \
+ int i; \
+ int *saved_charbuf = charbuf; \
+ \
+ ADD_COMPOSITION_DATA (charbuf, nchars, method); \
+ if (method != COMPOSITION_RELATIVE) \
{ \
- *dst++ = ISO_CODE_ESC; \
- *dst++ = c1; \
- coding->produced_char += 2; \
+ if (component_len == 0) \
+ for (i = 0; i < component_idx; i++) \
+ *charbuf++ = components[i]; \
+ else \
+ for (i = 0; i < component_len; i++) \
+ *charbuf++ = components[i]; \
+ *saved_charbuf = saved_charbuf - charbuf; \
} \
+ if (method == COMPOSITION_WITH_RULE) \
+ for (i = 0; i < component_idx; i += 2, char_offset++) \
+ *charbuf++ = components[i]; \
else \
- { \
- CODING_ADD_COMPOSITION_END (coding, coding->produced_char); \
- coding->composing = COMPOSITION_NO; \
- } \
+ for (i = component_len; i < component_idx; i++, char_offset++) \
+ *charbuf++ = components[i]; \
+ coding->annotated = 1; \
+ composition_state = COMPOSING_NO; \
} while (0)
+
/* Decode a composition rule from the byte C1 (and maybe one more byte
from SRC) and store one encoded composition rule in
coding->cmp_data. */
#define DECODE_COMPOSITION_RULE(c1) \
do { \
- int rule = 0; \
(c1) -= 32; \
if (c1 < 81) /* old format (before ver.21) */ \
{ \
int nref = (c1) % 9; \
if (gref == 4) gref = 10; \
if (nref == 4) nref = 10; \
- rule = COMPOSITION_ENCODE_RULE (gref, nref); \
+ c1 = COMPOSITION_ENCODE_RULE (gref, nref); \
} \
else if (c1 < 93) /* new format (after ver.21) */ \
{ \
ONE_MORE_BYTE (c2); \
- rule = COMPOSITION_ENCODE_RULE (c1 - 81, c2 - 32); \
+ c1 = COMPOSITION_ENCODE_RULE (c1 - 81, c2 - 32); \
} \
- CODING_ADD_COMPOSITION_COMPONENT (coding, rule); \
- coding->composition_rule_follows = 0; \
+ else \
+ c1 = 0; \
} while (0)
/* See the above "GENERAL NOTES on `decode_coding_XXX ()' functions". */
static void
-decode_coding_iso2022 (coding, source, destination, src_bytes, dst_bytes)
+decode_coding_iso_2022 (coding)
struct coding_system *coding;
- const unsigned char *source;
- unsigned char *destination;
- int src_bytes, dst_bytes;
{
- const unsigned char *src = source;
- const unsigned char *src_end = source + src_bytes;
- unsigned char *dst = destination;
- unsigned char *dst_end = destination + dst_bytes;
- /* Charsets invoked to graphic plane 0 and 1 respectively. */
- int charset0 = CODING_SPEC_ISO_PLANE_CHARSET (coding, 0);
- int charset1 = CODING_SPEC_ISO_PLANE_CHARSET (coding, 1);
- /* SRC_BASE remembers the start position in source in each loop.
- The loop will be exited when there's not enough source code
- (within macro ONE_MORE_BYTE), or when there's not enough
- destination area to produce a character (within macro
- EMIT_CHAR). */
+ const unsigned char *src = coding->source + coding->consumed;
+ const unsigned char *src_end = coding->source + coding->src_bytes;
const unsigned char *src_base;
- int c, charset;
- Lisp_Object translation_table;
- Lisp_Object safe_chars;
-
- safe_chars = coding_safe_chars (coding->symbol);
-
- if (NILP (Venable_character_translation))
- translation_table = Qnil;
- else
- {
- translation_table = coding->translation_table_for_decode;
- if (NILP (translation_table))
- translation_table = Vstandard_translation_table_for_decode;
- }
-
- coding->result = CODING_FINISH_NORMAL;
+ int *charbuf = coding->charbuf + coding->charbuf_used;
+ int *charbuf_end
+ = coding->charbuf + coding->charbuf_size - 4 - MAX_ANNOTATION_LENGTH;
+ int consumed_chars = 0, consumed_chars_base;
+ int multibytep = coding->src_multibyte;
+ /* Charsets invoked to graphic plane 0 and 1 respectively. */
+ int charset_id_0 = CODING_ISO_INVOKED_CHARSET (coding, 0);
+ int charset_id_1 = CODING_ISO_INVOKED_CHARSET (coding, 1);
+ int charset_id_2, charset_id_3;
+ struct charset *charset;
+ int c;
+ /* For handling composition sequence. */
+#define COMPOSING_NO 0
+#define COMPOSING_CHAR 1
+#define COMPOSING_RULE 2
+#define COMPOSING_COMPONENT_CHAR 3
+#define COMPOSING_COMPONENT_RULE 4
+
+ int composition_state = COMPOSING_NO;
+ enum composition_method method;
+ int components[MAX_COMPOSITION_COMPONENTS * 2 + 1];
+ int component_idx;
+ int component_len;
+ Lisp_Object attrs, charset_list;
+ int char_offset = coding->produced_char;
+ int last_offset = char_offset;
+ int last_id = charset_ascii;
+
+ CODING_GET_INFO (coding, attrs, charset_list);
+ setup_iso_safe_charsets (attrs);
+ /* Charset list may have been changed. */
+ charset_list = CODING_ATTR_CHARSET_LIST (attrs);
+ coding->safe_charsets = (char *) SDATA (CODING_ATTR_SAFE_CHARSETS(attrs));
while (1)
{
- int c1, c2 = 0;
+ int c1, c2;
src_base = src;
+ consumed_chars_base = consumed_chars;
+
+ if (charbuf >= charbuf_end)
+ break;
+
ONE_MORE_BYTE (c1);
+ if (c1 < 0)
+ goto invalid_code;
- /* We produce no character or one character. */
+ /* We produce at most one character. */
switch (iso_code_class [c1])
{
case ISO_0x20_or_0x7F:
- if (COMPOSING_P (coding) && coding->composition_rule_follows)
- {
- DECODE_COMPOSITION_RULE (c1);
- continue;
- }
- if (charset0 < 0 || CHARSET_CHARS (charset0) == 94)
+ if (composition_state != COMPOSING_NO)
{
- /* This is SPACE or DEL. */
- charset = CHARSET_ASCII;
- break;
+ if (composition_state == COMPOSING_RULE
+ || composition_state == COMPOSING_COMPONENT_RULE)
+ {
+ DECODE_COMPOSITION_RULE (c1);
+ components[component_idx++] = c1;
+ composition_state--;
+ continue;
+ }
}
- /* This is a graphic character, we fall down ... */
+ if (charset_id_0 < 0
+ || ! CHARSET_ISO_CHARS_96 (CHARSET_FROM_ID (charset_id_0)))
+ /* This is SPACE or DEL. */
+ charset = CHARSET_FROM_ID (charset_ascii);
+ else
+ charset = CHARSET_FROM_ID (charset_id_0);
+ break;
case ISO_graphic_plane_0:
- if (COMPOSING_P (coding) && coding->composition_rule_follows)
+ if (composition_state != COMPOSING_NO)
{
- DECODE_COMPOSITION_RULE (c1);
- continue;
+ if (composition_state == COMPOSING_RULE
+ || composition_state == COMPOSING_COMPONENT_RULE)
+ {
+ DECODE_COMPOSITION_RULE (c1);
+ components[component_idx++] = c1;
+ composition_state--;
+ continue;
+ }
}
- charset = charset0;
+ if (charset_id_0 < 0)
+ charset = CHARSET_FROM_ID (charset_ascii);
+ else
+ charset = CHARSET_FROM_ID (charset_id_0);
break;
case ISO_0xA0_or_0xFF:
- if (charset1 < 0 || CHARSET_CHARS (charset1) == 94
- || coding->flags & CODING_FLAG_ISO_SEVEN_BITS)
- goto label_invalid_code;
+ if (charset_id_1 < 0
+ || ! CHARSET_ISO_CHARS_96 (CHARSET_FROM_ID (charset_id_1))
+ || CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_SEVEN_BITS)
+ goto invalid_code;
/* This is a graphic character, we fall down ... */
case ISO_graphic_plane_1:
- if (charset1 < 0)
- goto label_invalid_code;
- charset = charset1;
+ if (charset_id_1 < 0)
+ goto invalid_code;
+ charset = CHARSET_FROM_ID (charset_id_1);
break;
case ISO_control_0:
- if (COMPOSING_P (coding))
- DECODE_COMPOSITION_END ('1');
-
- /* All ISO2022 control characters in this class have the
- same representation in Emacs internal format. */
- if (c1 == '\n'
- && (coding->mode & CODING_MODE_INHIBIT_INCONSISTENT_EOL)
- && (coding->eol_type == CODING_EOL_CR
- || coding->eol_type == CODING_EOL_CRLF))
- {
- coding->result = CODING_FINISH_INCONSISTENT_EOL;
- goto label_end_of_loop;
- }
- charset = CHARSET_ASCII;
+ MAYBE_FINISH_COMPOSITION ();
+ charset = CHARSET_FROM_ID (charset_ascii);
break;
case ISO_control_1:
- if (COMPOSING_P (coding))
- DECODE_COMPOSITION_END ('1');
- goto label_invalid_code;
-
- case ISO_carriage_return:
- if (COMPOSING_P (coding))
- DECODE_COMPOSITION_END ('1');
-
- if (coding->eol_type == CODING_EOL_CR)
- c1 = '\n';
- else if (coding->eol_type == CODING_EOL_CRLF)
- {
- ONE_MORE_BYTE (c1);
- if (c1 != ISO_CODE_LF)
- {
- src--;
- c1 = '\r';
- }
- }
- charset = CHARSET_ASCII;
- break;
+ MAYBE_FINISH_COMPOSITION ();
+ goto invalid_code;
case ISO_shift_out:
- if (! (coding->flags & CODING_FLAG_ISO_LOCKING_SHIFT)
- || CODING_SPEC_ISO_DESIGNATION (coding, 1) < 0)
- goto label_invalid_code;
- CODING_SPEC_ISO_INVOCATION (coding, 0) = 1;
- charset0 = CODING_SPEC_ISO_PLANE_CHARSET (coding, 0);
+ if (! (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_LOCKING_SHIFT)
+ || CODING_ISO_DESIGNATION (coding, 1) < 0)
+ goto invalid_code;
+ CODING_ISO_INVOCATION (coding, 0) = 1;
+ charset_id_0 = CODING_ISO_INVOKED_CHARSET (coding, 0);
continue;
case ISO_shift_in:
- if (! (coding->flags & CODING_FLAG_ISO_LOCKING_SHIFT))
- goto label_invalid_code;
- CODING_SPEC_ISO_INVOCATION (coding, 0) = 0;
- charset0 = CODING_SPEC_ISO_PLANE_CHARSET (coding, 0);
+ if (! (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_LOCKING_SHIFT))
+ goto invalid_code;
+ CODING_ISO_INVOCATION (coding, 0) = 0;
+ charset_id_0 = CODING_ISO_INVOKED_CHARSET (coding, 0);
continue;
case ISO_single_shift_2_7:
case ISO_single_shift_2:
- if (! (coding->flags & CODING_FLAG_ISO_SINGLE_SHIFT))
- goto label_invalid_code;
+ if (! (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_SINGLE_SHIFT))
+ goto invalid_code;
/* SS2 is handled as an escape sequence of ESC 'N' */
c1 = 'N';
goto label_escape_sequence;
case ISO_single_shift_3:
- if (! (coding->flags & CODING_FLAG_ISO_SINGLE_SHIFT))
- goto label_invalid_code;
+ if (! (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_SINGLE_SHIFT))
+ goto invalid_code;
/* SS2 is handled as an escape sequence of ESC 'O' */
c1 = 'O';
goto label_escape_sequence;
case ISO_escape:
ONE_MORE_BYTE (c1);
label_escape_sequence:
- /* Escape sequences handled by Emacs are invocation,
+ /* Escape sequences handled here are invocation,
designation, direction specification, and character
composition specification. */
switch (c1)
case '&': /* revision of following character set */
ONE_MORE_BYTE (c1);
if (!(c1 >= '@' && c1 <= '~'))
- goto label_invalid_code;
+ goto invalid_code;
ONE_MORE_BYTE (c1);
if (c1 != ISO_CODE_ESC)
- goto label_invalid_code;
+ goto invalid_code;
ONE_MORE_BYTE (c1);
goto label_escape_sequence;
case '$': /* designation of 2-byte character set */
- if (! (coding->flags & CODING_FLAG_ISO_DESIGNATION))
- goto label_invalid_code;
- ONE_MORE_BYTE (c1);
- if (c1 >= '@' && c1 <= 'B')
- { /* designation of JISX0208.1978, GB2312.1980,
+ if (! (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_DESIGNATION))
+ goto invalid_code;
+ {
+ int reg, chars96;
+
+ ONE_MORE_BYTE (c1);
+ if (c1 >= '@' && c1 <= 'B')
+ { /* designation of JISX0208.1978, GB2312.1980,
or JISX0208.1980 */
- DECODE_DESIGNATION (0, 2, 94, c1);
- }
- else if (c1 >= 0x28 && c1 <= 0x2B)
- { /* designation of DIMENSION2_CHARS94 character set */
- ONE_MORE_BYTE (c2);
- DECODE_DESIGNATION (c1 - 0x28, 2, 94, c2);
- }
- else if (c1 >= 0x2C && c1 <= 0x2F)
- { /* designation of DIMENSION2_CHARS96 character set */
- ONE_MORE_BYTE (c2);
- DECODE_DESIGNATION (c1 - 0x2C, 2, 96, c2);
- }
- else
- goto label_invalid_code;
- /* We must update these variables now. */
- charset0 = CODING_SPEC_ISO_PLANE_CHARSET (coding, 0);
- charset1 = CODING_SPEC_ISO_PLANE_CHARSET (coding, 1);
+ reg = 0, chars96 = 0;
+ }
+ else if (c1 >= 0x28 && c1 <= 0x2B)
+ { /* designation of DIMENSION2_CHARS94 character set */
+ reg = c1 - 0x28, chars96 = 0;
+ ONE_MORE_BYTE (c1);
+ }
+ else if (c1 >= 0x2C && c1 <= 0x2F)
+ { /* designation of DIMENSION2_CHARS96 character set */
+ reg = c1 - 0x2C, chars96 = 1;
+ ONE_MORE_BYTE (c1);
+ }
+ else
+ goto invalid_code;
+ DECODE_DESIGNATION (reg, 2, chars96, c1);
+ /* We must update these variables now. */
+ if (reg == 0)
+ charset_id_0 = CODING_ISO_INVOKED_CHARSET (coding, 0);
+ else if (reg == 1)
+ charset_id_1 = CODING_ISO_INVOKED_CHARSET (coding, 1);
+ if (chars96 < 0)
+ goto invalid_code;
+ }
continue;
case 'n': /* invocation of locking-shift-2 */
- if (! (coding->flags & CODING_FLAG_ISO_LOCKING_SHIFT)
- || CODING_SPEC_ISO_DESIGNATION (coding, 2) < 0)
- goto label_invalid_code;
- CODING_SPEC_ISO_INVOCATION (coding, 0) = 2;
- charset0 = CODING_SPEC_ISO_PLANE_CHARSET (coding, 0);
+ if (! (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_LOCKING_SHIFT)
+ || CODING_ISO_DESIGNATION (coding, 2) < 0)
+ goto invalid_code;
+ CODING_ISO_INVOCATION (coding, 0) = 2;
+ charset_id_0 = CODING_ISO_INVOKED_CHARSET (coding, 0);
continue;
case 'o': /* invocation of locking-shift-3 */
- if (! (coding->flags & CODING_FLAG_ISO_LOCKING_SHIFT)
- || CODING_SPEC_ISO_DESIGNATION (coding, 3) < 0)
- goto label_invalid_code;
- CODING_SPEC_ISO_INVOCATION (coding, 0) = 3;
- charset0 = CODING_SPEC_ISO_PLANE_CHARSET (coding, 0);
+ if (! (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_LOCKING_SHIFT)
+ || CODING_ISO_DESIGNATION (coding, 3) < 0)
+ goto invalid_code;
+ CODING_ISO_INVOCATION (coding, 0) = 3;
+ charset_id_0 = CODING_ISO_INVOKED_CHARSET (coding, 0);
continue;
case 'N': /* invocation of single-shift-2 */
- if (! (coding->flags & CODING_FLAG_ISO_SINGLE_SHIFT)
- || CODING_SPEC_ISO_DESIGNATION (coding, 2) < 0)
- goto label_invalid_code;
- charset = CODING_SPEC_ISO_DESIGNATION (coding, 2);
+ if (! (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_SINGLE_SHIFT)
+ || CODING_ISO_DESIGNATION (coding, 2) < 0)
+ goto invalid_code;
+ charset_id_2 = CODING_ISO_DESIGNATION (coding, 2);
+ if (charset_id_2 < 0)
+ charset = CHARSET_FROM_ID (charset_ascii);
+ else
+ charset = CHARSET_FROM_ID (charset_id_2);
ONE_MORE_BYTE (c1);
if (c1 < 0x20 || (c1 >= 0x80 && c1 < 0xA0))
- goto label_invalid_code;
+ goto invalid_code;
break;
case 'O': /* invocation of single-shift-3 */
- if (! (coding->flags & CODING_FLAG_ISO_SINGLE_SHIFT)
- || CODING_SPEC_ISO_DESIGNATION (coding, 3) < 0)
- goto label_invalid_code;
- charset = CODING_SPEC_ISO_DESIGNATION (coding, 3);
+ if (! (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_SINGLE_SHIFT)
+ || CODING_ISO_DESIGNATION (coding, 3) < 0)
+ goto invalid_code;
+ charset_id_3 = CODING_ISO_DESIGNATION (coding, 3);
+ if (charset_id_3 < 0)
+ charset = CHARSET_FROM_ID (charset_ascii);
+ else
+ charset = CHARSET_FROM_ID (charset_id_3);
ONE_MORE_BYTE (c1);
if (c1 < 0x20 || (c1 >= 0x80 && c1 < 0xA0))
- goto label_invalid_code;
+ goto invalid_code;
break;
case '0': case '2': case '3': case '4': /* start composition */
+ if (! (coding->common_flags & CODING_ANNOTATE_COMPOSITION_MASK))
+ goto invalid_code;
DECODE_COMPOSITION_START (c1);
continue;
case '1': /* end composition */
- DECODE_COMPOSITION_END (c1);
+ if (composition_state == COMPOSING_NO)
+ goto invalid_code;
+ DECODE_COMPOSITION_END ();
continue;
case '[': /* specification of direction */
- if (coding->flags & CODING_FLAG_ISO_NO_DIRECTION)
- goto label_invalid_code;
+ if (! CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_DIRECTION)
+ goto invalid_code;
/* For the moment, nested direction is not supported.
So, `coding->mode & CODING_MODE_DIRECTION' zero means
- left-to-right, and nonzero means right-to-left. */
+ left-to-right, and nozero means right-to-left. */
ONE_MORE_BYTE (c1);
switch (c1)
{
if (c1 == ']')
coding->mode &= ~CODING_MODE_DIRECTION;
else
- goto label_invalid_code;
+ goto invalid_code;
break;
case '2': /* start of right-to-left direction */
if (c1 == ']')
coding->mode |= CODING_MODE_DIRECTION;
else
- goto label_invalid_code;
+ goto invalid_code;
break;
default:
- goto label_invalid_code;
+ goto invalid_code;
}
continue;
case '%':
- if (COMPOSING_P (coding))
- DECODE_COMPOSITION_END ('1');
ONE_MORE_BYTE (c1);
if (c1 == '/')
{
We keep these bytes as is for the moment.
They may be decoded by post-read-conversion. */
int dim, M, L;
- int size, required;
- int produced_chars;
+ int size;
ONE_MORE_BYTE (dim);
ONE_MORE_BYTE (M);
ONE_MORE_BYTE (L);
size = ((M - 128) * 128) + (L - 128);
- required = 8 + size * 2;
- if (dst + required > (dst_bytes ? dst_end : src))
- goto label_end_of_loop;
- *dst++ = ISO_CODE_ESC;
- *dst++ = '%';
- *dst++ = '/';
- *dst++ = dim;
- produced_chars = 4;
- dst += CHAR_STRING (M, dst), produced_chars++;
- dst += CHAR_STRING (L, dst), produced_chars++;
+ if (charbuf + 8 + size > charbuf_end)
+ goto break_loop;
+ *charbuf++ = ISO_CODE_ESC;
+ *charbuf++ = '%';
+ *charbuf++ = '/';
+ *charbuf++ = dim;
+ *charbuf++ = BYTE8_TO_CHAR (M);
+ *charbuf++ = BYTE8_TO_CHAR (L);
while (size-- > 0)
{
ONE_MORE_BYTE (c1);
- dst += CHAR_STRING (c1, dst), produced_chars++;
+ *charbuf++ = ASCII_BYTE_P (c1) ? c1 : BYTE8_TO_CHAR (c1);
}
- coding->produced_char += produced_chars;
}
else if (c1 == 'G')
{
- unsigned char *d = dst;
- int produced_chars;
-
/* XFree86 extension for embedding UTF-8 in CTEXT:
ESC % G --UTF-8-BYTES-- ESC % @
We keep these bytes as is for the moment.
They may be decoded by post-read-conversion. */
- if (d + 6 > (dst_bytes ? dst_end : src))
- goto label_end_of_loop;
- *d++ = ISO_CODE_ESC;
- *d++ = '%';
- *d++ = 'G';
- produced_chars = 3;
- while (d + 1 < (dst_bytes ? dst_end : src))
+ int *p = charbuf;
+
+ if (p + 6 > charbuf_end)
+ goto break_loop;
+ *p++ = ISO_CODE_ESC;
+ *p++ = '%';
+ *p++ = 'G';
+ while (p < charbuf_end)
{
ONE_MORE_BYTE (c1);
if (c1 == ISO_CODE_ESC
src += 2;
break;
}
- d += CHAR_STRING (c1, d), produced_chars++;
+ *p++ = ASCII_BYTE_P (c1) ? c1 : BYTE8_TO_CHAR (c1);
}
- if (d + 3 > (dst_bytes ? dst_end : src))
- goto label_end_of_loop;
- *d++ = ISO_CODE_ESC;
- *d++ = '%';
- *d++ = '@';
- dst = d;
- coding->produced_char += produced_chars + 3;
+ if (p + 3 > charbuf_end)
+ goto break_loop;
+ *p++ = ISO_CODE_ESC;
+ *p++ = '%';
+ *p++ = '@';
+ charbuf = p;
}
else
- goto label_invalid_code;
+ goto invalid_code;
continue;
+ break;
default:
- if (! (coding->flags & CODING_FLAG_ISO_DESIGNATION))
- goto label_invalid_code;
- if (c1 >= 0x28 && c1 <= 0x2B)
- { /* designation of DIMENSION1_CHARS94 character set */
- ONE_MORE_BYTE (c2);
- DECODE_DESIGNATION (c1 - 0x28, 1, 94, c2);
- }
- else if (c1 >= 0x2C && c1 <= 0x2F)
- { /* designation of DIMENSION1_CHARS96 character set */
- ONE_MORE_BYTE (c2);
- DECODE_DESIGNATION (c1 - 0x2C, 1, 96, c2);
- }
- else
- goto label_invalid_code;
- /* We must update these variables now. */
- charset0 = CODING_SPEC_ISO_PLANE_CHARSET (coding, 0);
- charset1 = CODING_SPEC_ISO_PLANE_CHARSET (coding, 1);
+ if (! (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_DESIGNATION))
+ goto invalid_code;
+ {
+ int reg, chars96;
+
+ if (c1 >= 0x28 && c1 <= 0x2B)
+ { /* designation of DIMENSION1_CHARS94 character set */
+ reg = c1 - 0x28, chars96 = 0;
+ ONE_MORE_BYTE (c1);
+ }
+ else if (c1 >= 0x2C && c1 <= 0x2F)
+ { /* designation of DIMENSION1_CHARS96 character set */
+ reg = c1 - 0x2C, chars96 = 1;
+ ONE_MORE_BYTE (c1);
+ }
+ else
+ goto invalid_code;
+ DECODE_DESIGNATION (reg, 1, chars96, c1);
+ /* We must update these variables now. */
+ if (reg == 0)
+ charset_id_0 = CODING_ISO_INVOKED_CHARSET (coding, 0);
+ else if (reg == 1)
+ charset_id_1 = CODING_ISO_INVOKED_CHARSET (coding, 1);
+ if (chars96 < 0)
+ goto invalid_code;
+ }
continue;
}
}
+ if (charset->id != charset_ascii
+ && last_id != charset->id)
+ {
+ if (last_id != charset_ascii)
+ ADD_CHARSET_DATA (charbuf, char_offset - last_offset, last_id);
+ last_id = charset->id;
+ last_offset = char_offset;
+ }
+
/* Now we know CHARSET and 1st position code C1 of a character.
- Produce a multibyte sequence for that character while getting
- 2nd position code C2 if necessary. */
- if (CHARSET_DIMENSION (charset) == 2)
+ Produce a decoded character while getting 2nd position code
+ C2 if necessary. */
+ c1 &= 0x7F;
+ if (CHARSET_DIMENSION (charset) > 1)
{
ONE_MORE_BYTE (c2);
- if (c1 < 0x80 ? c2 < 0x20 || c2 >= 0x80 : c2 < 0xA0)
+ if (c2 < 0x20 || (c2 >= 0x80 && c2 < 0xA0))
/* C2 is not in a valid range. */
- goto label_invalid_code;
+ goto invalid_code;
+ c1 = (c1 << 8) | (c2 & 0x7F);
+ if (CHARSET_DIMENSION (charset) > 2)
+ {
+ ONE_MORE_BYTE (c2);
+ if (c2 < 0x20 || (c2 >= 0x80 && c2 < 0xA0))
+ /* C2 is not in a valid range. */
+ goto invalid_code;
+ c1 = (c1 << 8) | (c2 & 0x7F);
+ }
+ }
+
+ CODING_DECODE_CHAR (coding, src, src_base, src_end, charset, c1, c);
+ if (c < 0)
+ {
+ MAYBE_FINISH_COMPOSITION ();
+ for (; src_base < src; src_base++, char_offset++)
+ {
+ if (ASCII_BYTE_P (*src_base))
+ *charbuf++ = *src_base;
+ else
+ *charbuf++ = BYTE8_TO_CHAR (*src_base);
+ }
+ }
+ else if (composition_state == COMPOSING_NO)
+ {
+ *charbuf++ = c;
+ char_offset++;
+ }
+ else
+ {
+ components[component_idx++] = c;
+ if (method == COMPOSITION_WITH_RULE
+ || (method == COMPOSITION_WITH_RULE_ALTCHARS
+ && composition_state == COMPOSING_COMPONENT_CHAR))
+ composition_state++;
}
- c = DECODE_ISO_CHARACTER (charset, c1, c2);
- EMIT_CHAR (c);
continue;
- label_invalid_code:
- coding->errors++;
- if (COMPOSING_P (coding))
- DECODE_COMPOSITION_END ('1');
+ invalid_code:
+ MAYBE_FINISH_COMPOSITION ();
src = src_base;
- c = *src++;
- if (! NILP (translation_table))
- c = translate_char (translation_table, c, 0, 0, 0);
- EMIT_CHAR (c);
+ consumed_chars = consumed_chars_base;
+ ONE_MORE_BYTE (c);
+ *charbuf++ = c < 0 ? -c : ASCII_BYTE_P (c) ? c : BYTE8_TO_CHAR (c);
+ char_offset++;
+ coding->errors++;
+ continue;
+
+ break_loop:
+ break;
}
- label_end_of_loop:
- coding->consumed = coding->consumed_char = src_base - source;
- coding->produced = dst - destination;
- return;
+ no_more_source:
+ if (last_id != charset_ascii)
+ ADD_CHARSET_DATA (charbuf, char_offset - last_offset, last_id);
+ coding->consumed_char += consumed_chars_base;
+ coding->consumed = src_base - coding->source;
+ coding->charbuf_used = charbuf - coding->charbuf;
}
/*
It is not enough to say just "ISO2022" on encoding, we have to
- specify more details. In Emacs, each ISO2022 coding system
+ specify more details. In Emacs, each coding system of ISO2022
variant has the following specifications:
- 1. Initial designation to G0 through G3.
+ 1. Initial designation to G0 thru G3.
2. Allows short-form designation?
3. ASCII should be designated to G0 before control characters?
4. ASCII should be designated to G0 at end of line?
And the following two are only for Japanese:
8. Use ASCII in place of JIS0201-1976-Roman?
9. Use JISX0208-1983 in place of JISX0208-1978?
- These specifications are encoded in `coding->flags' as flag bits
- defined by macros CODING_FLAG_ISO_XXX. See `coding.h' for more
+ These specifications are encoded in CODING_ISO_FLAGS (coding) as flag bits
+ defined by macros CODING_ISO_FLAG_XXX. See `coding.h' for more
details.
*/
#define ENCODE_DESIGNATION(charset, reg, coding) \
do { \
- unsigned char final_char = CHARSET_ISO_FINAL_CHAR (charset); \
+ unsigned char final_char = CHARSET_ISO_FINAL (charset); \
char *intermediate_char_94 = "()*+"; \
char *intermediate_char_96 = ",-./"; \
- int revision = CODING_SPEC_ISO_REVISION_NUMBER(coding, charset); \
- \
- if (revision < 255) \
+ int revision = -1; \
+ int c; \
+ \
+ if (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_REVISION) \
+ revision = CHARSET_ISO_REVISION (charset); \
+ \
+ if (revision >= 0) \
{ \
- *dst++ = ISO_CODE_ESC; \
- *dst++ = '&'; \
- *dst++ = '@' + revision; \
+ EMIT_TWO_ASCII_BYTES (ISO_CODE_ESC, '&'); \
+ EMIT_ONE_BYTE ('@' + revision); \
} \
- *dst++ = ISO_CODE_ESC; \
+ EMIT_ONE_ASCII_BYTE (ISO_CODE_ESC); \
if (CHARSET_DIMENSION (charset) == 1) \
{ \
- if (CHARSET_CHARS (charset) == 94) \
- *dst++ = (unsigned char) (intermediate_char_94[reg]); \
+ if (! CHARSET_ISO_CHARS_96 (charset)) \
+ c = intermediate_char_94[reg]; \
else \
- *dst++ = (unsigned char) (intermediate_char_96[reg]); \
+ c = intermediate_char_96[reg]; \
+ EMIT_ONE_ASCII_BYTE (c); \
} \
else \
{ \
- *dst++ = '$'; \
- if (CHARSET_CHARS (charset) == 94) \
+ EMIT_ONE_ASCII_BYTE ('$'); \
+ if (! CHARSET_ISO_CHARS_96 (charset)) \
{ \
- if (! (coding->flags & CODING_FLAG_ISO_SHORT_FORM) \
+ if (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_LONG_FORM \
|| reg != 0 \
|| final_char < '@' || final_char > 'B') \
- *dst++ = (unsigned char) (intermediate_char_94[reg]); \
+ EMIT_ONE_ASCII_BYTE (intermediate_char_94[reg]); \
} \
else \
- *dst++ = (unsigned char) (intermediate_char_96[reg]); \
+ EMIT_ONE_ASCII_BYTE (intermediate_char_96[reg]); \
} \
- *dst++ = final_char; \
- CODING_SPEC_ISO_DESIGNATION (coding, reg) = charset; \
+ EMIT_ONE_ASCII_BYTE (final_char); \
+ \
+ CODING_ISO_DESIGNATION (coding, reg) = CHARSET_ID (charset); \
} while (0)
+
/* The following two macros produce codes (control character or escape
sequence) for ISO2022 single-shift functions (single-shift-2 and
single-shift-3). */
-#define ENCODE_SINGLE_SHIFT_2 \
- do { \
- if (coding->flags & CODING_FLAG_ISO_SEVEN_BITS) \
- *dst++ = ISO_CODE_ESC, *dst++ = 'N'; \
- else \
- *dst++ = ISO_CODE_SS2; \
- CODING_SPEC_ISO_SINGLE_SHIFTING (coding) = 1; \
+#define ENCODE_SINGLE_SHIFT_2 \
+ do { \
+ if (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_SEVEN_BITS) \
+ EMIT_TWO_ASCII_BYTES (ISO_CODE_ESC, 'N'); \
+ else \
+ EMIT_ONE_BYTE (ISO_CODE_SS2); \
+ CODING_ISO_SINGLE_SHIFTING (coding) = 1; \
} while (0)
-#define ENCODE_SINGLE_SHIFT_3 \
- do { \
- if (coding->flags & CODING_FLAG_ISO_SEVEN_BITS) \
- *dst++ = ISO_CODE_ESC, *dst++ = 'O'; \
- else \
- *dst++ = ISO_CODE_SS3; \
- CODING_SPEC_ISO_SINGLE_SHIFTING (coding) = 1; \
+
+#define ENCODE_SINGLE_SHIFT_3 \
+ do { \
+ if (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_SEVEN_BITS) \
+ EMIT_TWO_ASCII_BYTES (ISO_CODE_ESC, 'O'); \
+ else \
+ EMIT_ONE_BYTE (ISO_CODE_SS3); \
+ CODING_ISO_SINGLE_SHIFTING (coding) = 1; \
} while (0)
+
/* The following four macros produce codes (control character or
escape sequence) for ISO2022 locking-shift functions (shift-in,
shift-out, locking-shift-2, and locking-shift-3). */
-#define ENCODE_SHIFT_IN \
- do { \
- *dst++ = ISO_CODE_SI; \
- CODING_SPEC_ISO_INVOCATION (coding, 0) = 0; \
+#define ENCODE_SHIFT_IN \
+ do { \
+ EMIT_ONE_ASCII_BYTE (ISO_CODE_SI); \
+ CODING_ISO_INVOCATION (coding, 0) = 0; \
} while (0)
-#define ENCODE_SHIFT_OUT \
- do { \
- *dst++ = ISO_CODE_SO; \
- CODING_SPEC_ISO_INVOCATION (coding, 0) = 1; \
+
+#define ENCODE_SHIFT_OUT \
+ do { \
+ EMIT_ONE_ASCII_BYTE (ISO_CODE_SO); \
+ CODING_ISO_INVOCATION (coding, 0) = 1; \
} while (0)
-#define ENCODE_LOCKING_SHIFT_2 \
- do { \
- *dst++ = ISO_CODE_ESC, *dst++ = 'n'; \
- CODING_SPEC_ISO_INVOCATION (coding, 0) = 2; \
+
+#define ENCODE_LOCKING_SHIFT_2 \
+ do { \
+ EMIT_TWO_ASCII_BYTES (ISO_CODE_ESC, 'n'); \
+ CODING_ISO_INVOCATION (coding, 0) = 2; \
} while (0)
-#define ENCODE_LOCKING_SHIFT_3 \
- do { \
- *dst++ = ISO_CODE_ESC, *dst++ = 'o'; \
- CODING_SPEC_ISO_INVOCATION (coding, 0) = 3; \
+
+#define ENCODE_LOCKING_SHIFT_3 \
+ do { \
+ EMIT_TWO_ASCII_BYTES (ISO_CODE_ESC, 'n'); \
+ CODING_ISO_INVOCATION (coding, 0) = 3; \
} while (0)
+
/* Produce codes for a DIMENSION1 character whose character set is
CHARSET and whose position-code is C1. Designation and invocation
sequences are also produced in advance if necessary. */
#define ENCODE_ISO_CHARACTER_DIMENSION1(charset, c1) \
do { \
- if (CODING_SPEC_ISO_SINGLE_SHIFTING (coding)) \
+ int id = CHARSET_ID (charset); \
+ \
+ if ((CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_USE_ROMAN) \
+ && id == charset_ascii) \
+ { \
+ id = charset_jisx0201_roman; \
+ charset = CHARSET_FROM_ID (id); \
+ } \
+ \
+ if (CODING_ISO_SINGLE_SHIFTING (coding)) \
{ \
- if (coding->flags & CODING_FLAG_ISO_SEVEN_BITS) \
- *dst++ = c1 & 0x7F; \
+ if (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_SEVEN_BITS) \
+ EMIT_ONE_ASCII_BYTE (c1 & 0x7F); \
else \
- *dst++ = c1 | 0x80; \
- CODING_SPEC_ISO_SINGLE_SHIFTING (coding) = 0; \
+ EMIT_ONE_BYTE (c1 | 0x80); \
+ CODING_ISO_SINGLE_SHIFTING (coding) = 0; \
break; \
} \
- else if (charset == CODING_SPEC_ISO_PLANE_CHARSET (coding, 0)) \
+ else if (id == CODING_ISO_INVOKED_CHARSET (coding, 0)) \
{ \
- *dst++ = c1 & 0x7F; \
+ EMIT_ONE_ASCII_BYTE (c1 & 0x7F); \
break; \
} \
- else if (charset == CODING_SPEC_ISO_PLANE_CHARSET (coding, 1)) \
+ else if (id == CODING_ISO_INVOKED_CHARSET (coding, 1)) \
{ \
- *dst++ = c1 | 0x80; \
+ EMIT_ONE_BYTE (c1 | 0x80); \
break; \
} \
else \
must invoke it, or, at first, designate it to some graphic \
register. Then repeat the loop to actually produce the \
character. */ \
- dst = encode_invocation_designation (charset, coding, dst); \
+ dst = encode_invocation_designation (charset, coding, dst, \
+ &produced_chars); \
} while (1)
+
/* Produce codes for a DIMENSION2 character whose character set is
CHARSET and whose position-codes are C1 and C2. Designation and
invocation codes are also produced in advance if necessary. */
#define ENCODE_ISO_CHARACTER_DIMENSION2(charset, c1, c2) \
do { \
- if (CODING_SPEC_ISO_SINGLE_SHIFTING (coding)) \
+ int id = CHARSET_ID (charset); \
+ \
+ if ((CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_USE_OLDJIS) \
+ && id == charset_jisx0208) \
{ \
- if (coding->flags & CODING_FLAG_ISO_SEVEN_BITS) \
- *dst++ = c1 & 0x7F, *dst++ = c2 & 0x7F; \
+ id = charset_jisx0208_1978; \
+ charset = CHARSET_FROM_ID (id); \
+ } \
+ \
+ if (CODING_ISO_SINGLE_SHIFTING (coding)) \
+ { \
+ if (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_SEVEN_BITS) \
+ EMIT_TWO_ASCII_BYTES ((c1) & 0x7F, (c2) & 0x7F); \
else \
- *dst++ = c1 | 0x80, *dst++ = c2 | 0x80; \
- CODING_SPEC_ISO_SINGLE_SHIFTING (coding) = 0; \
+ EMIT_TWO_BYTES ((c1) | 0x80, (c2) | 0x80); \
+ CODING_ISO_SINGLE_SHIFTING (coding) = 0; \
break; \
} \
- else if (charset == CODING_SPEC_ISO_PLANE_CHARSET (coding, 0)) \
+ else if (id == CODING_ISO_INVOKED_CHARSET (coding, 0)) \
{ \
- *dst++ = c1 & 0x7F, *dst++= c2 & 0x7F; \
+ EMIT_TWO_ASCII_BYTES ((c1) & 0x7F, (c2) & 0x7F); \
break; \
} \
- else if (charset == CODING_SPEC_ISO_PLANE_CHARSET (coding, 1)) \
+ else if (id == CODING_ISO_INVOKED_CHARSET (coding, 1)) \
{ \
- *dst++ = c1 | 0x80, *dst++= c2 | 0x80; \
+ EMIT_TWO_BYTES ((c1) | 0x80, (c2) | 0x80); \
break; \
} \
else \
must invoke it, or, at first, designate it to some graphic \
register. Then repeat the loop to actually produce the \
character. */ \
- dst = encode_invocation_designation (charset, coding, dst); \
+ dst = encode_invocation_designation (charset, coding, dst, \
+ &produced_chars); \
} while (1)
-#define ENCODE_ISO_CHARACTER(c) \
- do { \
- int charset, c1, c2; \
- \
- SPLIT_CHAR (c, charset, c1, c2); \
- if (CHARSET_DEFINED_P (charset)) \
- { \
- if (CHARSET_DIMENSION (charset) == 1) \
- { \
- if (charset == CHARSET_ASCII \
- && coding->flags & CODING_FLAG_ISO_USE_ROMAN) \
- charset = charset_latin_jisx0201; \
- ENCODE_ISO_CHARACTER_DIMENSION1 (charset, c1); \
- } \
- else \
- { \
- if (charset == charset_jisx0208 \
- && coding->flags & CODING_FLAG_ISO_USE_OLDJIS) \
- charset = charset_jisx0208_1978; \
- ENCODE_ISO_CHARACTER_DIMENSION2 (charset, c1, c2); \
- } \
- } \
- else \
- { \
- *dst++ = c1; \
- if (c2 >= 0) \
- *dst++ = c2; \
- } \
- } while (0)
-
-
-/* Instead of encoding character C, produce one or two `?'s. */
-#define ENCODE_UNSAFE_CHARACTER(c) \
- do { \
- ENCODE_ISO_CHARACTER (CODING_REPLACEMENT_CHARACTER); \
- if (CHARSET_WIDTH (CHAR_CHARSET (c)) > 1) \
- ENCODE_ISO_CHARACTER (CODING_REPLACEMENT_CHARACTER); \
+#define ENCODE_ISO_CHARACTER(charset, c) \
+ do { \
+ int code = ENCODE_CHAR ((charset),(c)); \
+ \
+ if (CHARSET_DIMENSION (charset) == 1) \
+ ENCODE_ISO_CHARACTER_DIMENSION1 ((charset), code); \
+ else \
+ ENCODE_ISO_CHARACTER_DIMENSION2 ((charset), code >> 8, code & 0xFF); \
} while (0)
/* Produce designation and invocation codes at a place pointed by DST
- to use CHARSET. The element `spec.iso2022' of *CODING is updated.
+ to use CHARSET. The element `spec.iso_2022' of *CODING is updated.
Return new DST. */
unsigned char *
-encode_invocation_designation (charset, coding, dst)
- int charset;
+encode_invocation_designation (charset, coding, dst, p_nchars)
+ struct charset *charset;
struct coding_system *coding;
unsigned char *dst;
+ int *p_nchars;
{
+ int multibytep = coding->dst_multibyte;
+ int produced_chars = *p_nchars;
int reg; /* graphic register number */
+ int id = CHARSET_ID (charset);
/* At first, check designations. */
for (reg = 0; reg < 4; reg++)
- if (charset == CODING_SPEC_ISO_DESIGNATION (coding, reg))
+ if (id == CODING_ISO_DESIGNATION (coding, reg))
break;
if (reg >= 4)
{
/* CHARSET is not yet designated to any graphic registers. */
/* At first check the requested designation. */
- reg = CODING_SPEC_ISO_REQUESTED_DESIGNATION (coding, charset);
- if (reg == CODING_SPEC_ISO_NO_REQUESTED_DESIGNATION)
+ reg = CODING_ISO_REQUEST (coding, id);
+ if (reg < 0)
/* Since CHARSET requests no special designation, designate it
to graphic register 0. */
reg = 0;
ENCODE_DESIGNATION (charset, reg, coding);
}
- if (CODING_SPEC_ISO_INVOCATION (coding, 0) != reg
- && CODING_SPEC_ISO_INVOCATION (coding, 1) != reg)
+ if (CODING_ISO_INVOCATION (coding, 0) != reg
+ && CODING_ISO_INVOCATION (coding, 1) != reg)
{
/* Since the graphic register REG is not invoked to any graphic
planes, invoke it to graphic plane 0. */
break;
case 2: /* graphic register 2 */
- if (coding->flags & CODING_FLAG_ISO_SINGLE_SHIFT)
+ if (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_SINGLE_SHIFT)
ENCODE_SINGLE_SHIFT_2;
else
ENCODE_LOCKING_SHIFT_2;
break;
case 3: /* graphic register 3 */
- if (coding->flags & CODING_FLAG_ISO_SINGLE_SHIFT)
+ if (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_SINGLE_SHIFT)
ENCODE_SINGLE_SHIFT_3;
else
ENCODE_LOCKING_SHIFT_3;
}
}
+ *p_nchars = produced_chars;
return dst;
}
-/* Produce 2-byte codes for encoded composition rule RULE. */
-
-#define ENCODE_COMPOSITION_RULE(rule) \
- do { \
- int gref, nref; \
- COMPOSITION_DECODE_RULE (rule, gref, nref); \
- *dst++ = 32 + 81 + gref; \
- *dst++ = 32 + nref; \
- } while (0)
-
-/* Produce codes for indicating the start of a composition sequence
- (ESC 0, ESC 3, or ESC 4). DATA points to an array of integers
- which specify information about the composition. See the comment
- in coding.h for the format of DATA. */
-
-#define ENCODE_COMPOSITION_START(coding, data) \
+/* The following three macros produce codes for indicating direction
+ of text. */
+#define ENCODE_CONTROL_SEQUENCE_INTRODUCER \
do { \
- coding->composing = data[3]; \
- *dst++ = ISO_CODE_ESC; \
- if (coding->composing == COMPOSITION_RELATIVE) \
- *dst++ = '0'; \
+ if (CODING_ISO_FLAGS (coding) == CODING_ISO_FLAG_SEVEN_BITS) \
+ EMIT_TWO_ASCII_BYTES (ISO_CODE_ESC, '['); \
else \
- { \
- *dst++ = (coding->composing == COMPOSITION_WITH_ALTCHARS \
- ? '3' : '4'); \
- coding->cmp_data_index = coding->cmp_data_start + 4; \
- coding->composition_rule_follows = 0; \
- } \
+ EMIT_ONE_BYTE (ISO_CODE_CSI); \
} while (0)
-/* Produce codes for indicating the end of the current composition. */
-#define ENCODE_COMPOSITION_END(coding, data) \
- do { \
- *dst++ = ISO_CODE_ESC; \
- *dst++ = '1'; \
- coding->cmp_data_start += data[0]; \
- coding->composing = COMPOSITION_NO; \
- if (coding->cmp_data_start == coding->cmp_data->used \
- && coding->cmp_data->next) \
- { \
- coding->cmp_data = coding->cmp_data->next; \
- coding->cmp_data_start = 0; \
- } \
+#define ENCODE_DIRECTION_R2L() \
+ do { \
+ ENCODE_CONTROL_SEQUENCE_INTRODUCER (dst); \
+ EMIT_TWO_ASCII_BYTES ('2', ']'); \
} while (0)
-/* Produce composition start sequence ESC 0. Here, this sequence
- doesn't mean the start of a new composition but means that we have
- just produced components (alternate chars and composition rules) of
- the composition and the actual text follows in SRC. */
-#define ENCODE_COMPOSITION_FAKE_START(coding) \
+#define ENCODE_DIRECTION_L2R() \
do { \
- *dst++ = ISO_CODE_ESC; \
- *dst++ = '0'; \
- coding->composing = COMPOSITION_RELATIVE; \
+ ENCODE_CONTROL_SEQUENCE_INTRODUCER (dst); \
+ EMIT_TWO_ASCII_BYTES ('0', ']'); \
} while (0)
-/* The following three macros produce codes for indicating direction
- of text. */
-#define ENCODE_CONTROL_SEQUENCE_INTRODUCER \
- do { \
- if (coding->flags == CODING_FLAG_ISO_SEVEN_BITS) \
- *dst++ = ISO_CODE_ESC, *dst++ = '['; \
- else \
- *dst++ = ISO_CODE_CSI; \
- } while (0)
-
-#define ENCODE_DIRECTION_R2L \
- ENCODE_CONTROL_SEQUENCE_INTRODUCER (dst), *dst++ = '2', *dst++ = ']'
-
-#define ENCODE_DIRECTION_L2R \
- ENCODE_CONTROL_SEQUENCE_INTRODUCER (dst), *dst++ = '0', *dst++ = ']'
/* Produce codes for designation and invocation to reset the graphic
planes and registers to initial state. */
-#define ENCODE_RESET_PLANE_AND_REGISTER \
- do { \
- int reg; \
- if (CODING_SPEC_ISO_INVOCATION (coding, 0) != 0) \
- ENCODE_SHIFT_IN; \
- for (reg = 0; reg < 4; reg++) \
- if (CODING_SPEC_ISO_INITIAL_DESIGNATION (coding, reg) >= 0 \
- && (CODING_SPEC_ISO_DESIGNATION (coding, reg) \
- != CODING_SPEC_ISO_INITIAL_DESIGNATION (coding, reg))) \
- ENCODE_DESIGNATION \
- (CODING_SPEC_ISO_INITIAL_DESIGNATION (coding, reg), reg, coding); \
+#define ENCODE_RESET_PLANE_AND_REGISTER() \
+ do { \
+ int reg; \
+ struct charset *charset; \
+ \
+ if (CODING_ISO_INVOCATION (coding, 0) != 0) \
+ ENCODE_SHIFT_IN; \
+ for (reg = 0; reg < 4; reg++) \
+ if (CODING_ISO_INITIAL (coding, reg) >= 0 \
+ && (CODING_ISO_DESIGNATION (coding, reg) \
+ != CODING_ISO_INITIAL (coding, reg))) \
+ { \
+ charset = CHARSET_FROM_ID (CODING_ISO_INITIAL (coding, reg)); \
+ ENCODE_DESIGNATION (charset, reg, coding); \
+ } \
} while (0)
+
/* Produce designation sequences of charsets in the line started from
SRC to a place pointed by DST, and return updated DST.
find all the necessary designations. */
static unsigned char *
-encode_designation_at_bol (coding, translation_table, src, src_end, dst)
+encode_designation_at_bol (coding, charbuf, charbuf_end, dst)
struct coding_system *coding;
- Lisp_Object translation_table;
- const unsigned char *src, *src_end;
+ int *charbuf, *charbuf_end;
unsigned char *dst;
{
- int charset, c, found = 0, reg;
+ struct charset *charset;
/* Table of charsets to be designated to each graphic register. */
int r[4];
+ int c, found = 0, reg;
+ int produced_chars = 0;
+ int multibytep = coding->dst_multibyte;
+ Lisp_Object attrs;
+ Lisp_Object charset_list;
+
+ attrs = CODING_ID_ATTRS (coding->id);
+ charset_list = CODING_ATTR_CHARSET_LIST (attrs);
+ if (EQ (charset_list, Qiso_2022))
+ charset_list = Viso_2022_charset_list;
for (reg = 0; reg < 4; reg++)
r[reg] = -1;
while (found < 4)
{
- ONE_MORE_CHAR (c);
+ int id;
+
+ c = *charbuf++;
if (c == '\n')
break;
-
- charset = CHAR_CHARSET (c);
- reg = CODING_SPEC_ISO_REQUESTED_DESIGNATION (coding, charset);
- if (reg != CODING_SPEC_ISO_NO_REQUESTED_DESIGNATION && r[reg] < 0)
+ charset = char_charset (c, charset_list, NULL);
+ id = CHARSET_ID (charset);
+ reg = CODING_ISO_REQUEST (coding, id);
+ if (reg >= 0 && r[reg] < 0)
{
found++;
- r[reg] = charset;
+ r[reg] = id;
}
}
- label_end_of_loop:
if (found)
{
for (reg = 0; reg < 4; reg++)
if (r[reg] >= 0
- && CODING_SPEC_ISO_DESIGNATION (coding, reg) != r[reg])
- ENCODE_DESIGNATION (r[reg], reg, coding);
+ && CODING_ISO_DESIGNATION (coding, reg) != r[reg])
+ ENCODE_DESIGNATION (CHARSET_FROM_ID (r[reg]), reg, coding);
}
return dst;
/* See the above "GENERAL NOTES on `encode_coding_XXX ()' functions". */
-static void
-encode_coding_iso2022 (coding, source, destination, src_bytes, dst_bytes)
+static int
+encode_coding_iso_2022 (coding)
struct coding_system *coding;
- const unsigned char *source;
- unsigned char *destination;
- int src_bytes, dst_bytes;
{
- const unsigned char *src = source;
- const unsigned char *src_end = source + src_bytes;
- unsigned char *dst = destination;
- unsigned char *dst_end = destination + dst_bytes;
- /* Since the maximum bytes produced by each loop is 20, we subtract 19
- from DST_END to assure overflow checking is necessary only at the
- head of loop. */
- unsigned char *adjusted_dst_end = dst_end - 19;
- /* SRC_BASE remembers the start position in source in each loop.
- The loop will be exited when there's not enough source text to
- analyze multi-byte codes (within macro ONE_MORE_CHAR), or when
- there's not enough destination area to produce encoded codes
- (within macro EMIT_BYTES). */
- const unsigned char *src_base;
+ int multibytep = coding->dst_multibyte;
+ int *charbuf = coding->charbuf;
+ int *charbuf_end = charbuf + coding->charbuf_used;
+ unsigned char *dst = coding->destination + coding->produced;
+ unsigned char *dst_end = coding->destination + coding->dst_bytes;
+ int safe_room = 16;
+ int bol_designation
+ = (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_DESIGNATE_AT_BOL
+ && CODING_ISO_BOL (coding));
+ int produced_chars = 0;
+ Lisp_Object attrs, eol_type, charset_list;
+ int ascii_compatible;
int c;
- Lisp_Object translation_table;
- Lisp_Object safe_chars;
-
- if (coding->flags & CODING_FLAG_ISO_SAFE)
- coding->mode |= CODING_MODE_INHIBIT_UNENCODABLE_CHAR;
+ int preferred_charset_id = -1;
- safe_chars = coding_safe_chars (coding->symbol);
+ CODING_GET_INFO (coding, attrs, charset_list);
+ eol_type = CODING_ID_EOL_TYPE (coding->id);
+ if (VECTORP (eol_type))
+ eol_type = Qunix;
- if (NILP (Venable_character_translation))
- translation_table = Qnil;
- else
- {
- translation_table = coding->translation_table_for_encode;
- if (NILP (translation_table))
- translation_table = Vstandard_translation_table_for_encode;
- }
+ setup_iso_safe_charsets (attrs);
+ /* Charset list may have been changed. */
+ charset_list = CODING_ATTR_CHARSET_LIST (attrs);
+ coding->safe_charsets = (char *) SDATA (CODING_ATTR_SAFE_CHARSETS(attrs));
- coding->consumed_char = 0;
- coding->errors = 0;
- while (1)
- {
- src_base = src;
+ ascii_compatible = ! NILP (CODING_ATTR_ASCII_COMPAT (attrs));
- if (dst >= (dst_bytes ? adjusted_dst_end : (src - 19)))
- {
- coding->result = CODING_FINISH_INSUFFICIENT_DST;
- break;
- }
+ while (charbuf < charbuf_end)
+ {
+ ASSURE_DESTINATION (safe_room);
- if (coding->flags & CODING_FLAG_ISO_DESIGNATE_AT_BOL
- && CODING_SPEC_ISO_BOL (coding))
+ if (bol_designation)
{
+ unsigned char *dst_prev = dst;
+
/* We have to produce designation sequences if any now. */
- dst = encode_designation_at_bol (coding, translation_table,
- src, src_end, dst);
- CODING_SPEC_ISO_BOL (coding) = 0;
+ dst = encode_designation_at_bol (coding, charbuf, charbuf_end, dst);
+ bol_designation = 0;
+ /* We are sure that designation sequences are all ASCII bytes. */
+ produced_chars += dst - dst_prev;
}
- /* Check composition start and end. */
- if (coding->composing != COMPOSITION_DISABLED
- && coding->cmp_data_start < coding->cmp_data->used)
- {
- struct composition_data *cmp_data = coding->cmp_data;
- int *data = cmp_data->data + coding->cmp_data_start;
- int this_pos = cmp_data->char_offset + coding->consumed_char;
+ c = *charbuf++;
- if (coding->composing == COMPOSITION_RELATIVE)
- {
- if (this_pos == data[2])
- {
- ENCODE_COMPOSITION_END (coding, data);
- cmp_data = coding->cmp_data;
- data = cmp_data->data + coding->cmp_data_start;
- }
- }
- else if (COMPOSING_P (coding))
- {
- /* COMPOSITION_WITH_ALTCHARS or COMPOSITION_WITH_RULE_ALTCHAR */
- if (coding->cmp_data_index == coding->cmp_data_start + data[0])
- /* We have consumed components of the composition.
- What follows in SRC is the composition's base
- text. */
- ENCODE_COMPOSITION_FAKE_START (coding);
- else
- {
- int c = cmp_data->data[coding->cmp_data_index++];
- if (coding->composition_rule_follows)
- {
- ENCODE_COMPOSITION_RULE (c);
- coding->composition_rule_follows = 0;
- }
- else
- {
- if (coding->mode & CODING_MODE_INHIBIT_UNENCODABLE_CHAR
- && ! CODING_SAFE_CHAR_P (safe_chars, c))
- ENCODE_UNSAFE_CHARACTER (c);
- else
- ENCODE_ISO_CHARACTER (c);
- if (coding->composing == COMPOSITION_WITH_RULE_ALTCHARS)
- coding->composition_rule_follows = 1;
- }
- continue;
- }
- }
- if (!COMPOSING_P (coding))
+ if (c < 0)
+ {
+ /* Handle an annotation. */
+ switch (*charbuf)
{
- if (this_pos == data[1])
- {
- ENCODE_COMPOSITION_START (coding, data);
- continue;
- }
+ case CODING_ANNOTATE_COMPOSITION_MASK:
+ /* Not yet implemented. */
+ break;
+ case CODING_ANNOTATE_CHARSET_MASK:
+ preferred_charset_id = charbuf[2];
+ if (preferred_charset_id >= 0
+ && NILP (Fmemq (make_number (preferred_charset_id),
+ charset_list)))
+ preferred_charset_id = -1;
+ break;
+ default:
+ abort ();
}
+ charbuf += -c - 1;
+ continue;
}
- ONE_MORE_CHAR (c);
-
/* Now encode the character C. */
if (c < 0x20 || c == 0x7F)
{
- if (c == '\r')
+ if (c == '\n'
+ || (c == '\r' && EQ (eol_type, Qmac)))
{
- if (! (coding->mode & CODING_MODE_SELECTIVE_DISPLAY))
+ if (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_RESET_AT_EOL)
+ ENCODE_RESET_PLANE_AND_REGISTER ();
+ if (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_INIT_AT_BOL)
{
- if (coding->flags & CODING_FLAG_ISO_RESET_AT_CNTL)
- ENCODE_RESET_PLANE_AND_REGISTER;
- *dst++ = c;
- continue;
+ int i;
+
+ for (i = 0; i < 4; i++)
+ CODING_ISO_DESIGNATION (coding, i)
+ = CODING_ISO_INITIAL (coding, i);
}
- /* fall down to treat '\r' as '\n' ... */
- c = '\n';
- }
- if (c == '\n')
- {
- if (coding->flags & CODING_FLAG_ISO_RESET_AT_EOL)
- ENCODE_RESET_PLANE_AND_REGISTER;
- if (coding->flags & CODING_FLAG_ISO_INIT_AT_BOL)
- bcopy (coding->spec.iso2022.initial_designation,
- coding->spec.iso2022.current_designation,
- sizeof coding->spec.iso2022.initial_designation);
- if (coding->eol_type == CODING_EOL_LF
- || coding->eol_type == CODING_EOL_UNDECIDED)
- *dst++ = ISO_CODE_LF;
- else if (coding->eol_type == CODING_EOL_CRLF)
- *dst++ = ISO_CODE_CR, *dst++ = ISO_CODE_LF;
- else
- *dst++ = ISO_CODE_CR;
- CODING_SPEC_ISO_BOL (coding) = 1;
+ bol_designation
+ = CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_DESIGNATE_AT_BOL;
}
+ else if (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_RESET_AT_CNTL)
+ ENCODE_RESET_PLANE_AND_REGISTER ();
+ EMIT_ONE_ASCII_BYTE (c);
+ }
+ else if (ASCII_CHAR_P (c))
+ {
+ if (ascii_compatible)
+ EMIT_ONE_ASCII_BYTE (c);
else
{
- if (coding->flags & CODING_FLAG_ISO_RESET_AT_CNTL)
- ENCODE_RESET_PLANE_AND_REGISTER;
- *dst++ = c;
+ struct charset *charset = CHARSET_FROM_ID (charset_ascii);
+ ENCODE_ISO_CHARACTER (charset, c);
}
}
- else if (ASCII_BYTE_P (c))
- ENCODE_ISO_CHARACTER (c);
- else if (SINGLE_BYTE_CHAR_P (c))
+ else if (CHAR_BYTE8_P (c))
{
- *dst++ = c;
- coding->errors++;
+ c = CHAR_TO_BYTE8 (c);
+ EMIT_ONE_BYTE (c);
}
- else if (coding->mode & CODING_MODE_INHIBIT_UNENCODABLE_CHAR
- && ! CODING_SAFE_CHAR_P (safe_chars, c))
- ENCODE_UNSAFE_CHARACTER (c);
else
- ENCODE_ISO_CHARACTER (c);
+ {
+ struct charset *charset;
- coding->consumed_char++;
+ if (preferred_charset_id >= 0)
+ {
+ charset = CHARSET_FROM_ID (preferred_charset_id);
+ if (! CHAR_CHARSET_P (c, charset))
+ charset = char_charset (c, charset_list, NULL);
+ }
+ else
+ charset = char_charset (c, charset_list, NULL);
+ if (!charset)
+ {
+ if (coding->mode & CODING_MODE_SAFE_ENCODING)
+ {
+ c = CODING_INHIBIT_CHARACTER_SUBSTITUTION;
+ charset = CHARSET_FROM_ID (charset_ascii);
+ }
+ else
+ {
+ c = coding->default_char;
+ charset = char_charset (c, charset_list, NULL);
+ }
+ }
+ ENCODE_ISO_CHARACTER (charset, c);
+ }
}
- label_end_of_loop:
- coding->consumed = src_base - source;
- coding->produced = coding->produced_char = dst - destination;
+ if (coding->mode & CODING_MODE_LAST_BLOCK
+ && CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_RESET_AT_EOL)
+ {
+ ASSURE_DESTINATION (safe_room);
+ ENCODE_RESET_PLANE_AND_REGISTER ();
+ }
+ record_conversion_result (coding, CODING_RESULT_SUCCESS);
+ CODING_ISO_BOL (coding) = bol_designation;
+ coding->produced_char += produced_chars;
+ coding->produced = dst - coding->destination;
+ return 0;
}
\f
-/*** 4. SJIS and BIG5 handlers ***/
+/*** 8,9. SJIS and BIG5 handlers ***/
-/* Although SJIS and BIG5 are not ISO coding systems, they are used
+/* Although SJIS and BIG5 are not ISO's coding system, they are used
quite widely. So, for the moment, Emacs supports them in the bare
C code. But, in the future, they may be supported only by CCL. */
as is. A character of charset katakana-jisx0201 is encoded by
"position-code + 0x80". A character of charset japanese-jisx0208
is encoded in 2-byte but two position-codes are divided and shifted
- so that it fits in the range below.
+ so that it fit in the range below.
--- CODE RANGE of SJIS ---
(character set) (range)
ASCII 0x00 .. 0x7F
- KATAKANA-JISX0201 0xA1 .. 0xDF
+ KATAKANA-JISX0201 0xA0 .. 0xDF
JISX0208 (1st byte) 0x81 .. 0x9F and 0xE0 .. 0xEF
(2nd byte) 0x40 .. 0x7E and 0x80 .. 0xFC
-------------------------------
/* BIG5 is a coding system encoding two character sets: ASCII and
Big5. An ASCII character is encoded as is. Big5 is a two-byte
- character set and is encoded in two bytes.
+ character set and is encoded in two-byte.
--- CODE RANGE of BIG5 ---
(character set) (range)
(2nd byte) 0x40 .. 0x7E and 0xA1 .. 0xFE
--------------------------
- Since the number of characters in Big5 is larger than maximum
- characters in Emacs' charset (96x96), it can't be handled as one
- charset. So, in Emacs, Big5 is divided into two: `charset-big5-1'
- and `charset-big5-2'. Both are DIMENSION2 and CHARS94. The former
- contains frequently used characters and the latter contains less
- frequently used characters. */
-
-/* Macros to decode or encode a character of Big5 in BIG5. B1 and B2
- are the 1st and 2nd position-codes of Big5 in BIG5 coding system.
- C1 and C2 are the 1st and 2nd position-codes of Emacs' internal
- format. CHARSET is `charset_big5_1' or `charset_big5_2'. */
-
-/* Number of Big5 characters which have the same code in 1st byte. */
-#define BIG5_SAME_ROW (0xFF - 0xA1 + 0x7F - 0x40)
-
-#define DECODE_BIG5(b1, b2, charset, c1, c2) \
- do { \
- unsigned int temp \
- = (b1 - 0xA1) * BIG5_SAME_ROW + b2 - (b2 < 0x7F ? 0x40 : 0x62); \
- if (b1 < 0xC9) \
- charset = charset_big5_1; \
- else \
- { \
- charset = charset_big5_2; \
- temp -= (0xC9 - 0xA1) * BIG5_SAME_ROW; \
- } \
- c1 = temp / (0xFF - 0xA1) + 0x21; \
- c2 = temp % (0xFF - 0xA1) + 0x21; \
- } while (0)
-
-#define ENCODE_BIG5(charset, c1, c2, b1, b2) \
- do { \
- unsigned int temp = (c1 - 0x21) * (0xFF - 0xA1) + (c2 - 0x21); \
- if (charset == charset_big5_2) \
- temp += BIG5_SAME_ROW * (0xC9 - 0xA1); \
- b1 = temp / BIG5_SAME_ROW + 0xA1; \
- b2 = temp % BIG5_SAME_ROW; \
- b2 += b2 < 0x3F ? 0x40 : 0x62; \
- } while (0)
+ */
/* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions".
Check if a text is encoded in SJIS. If it is, return
- CODING_CATEGORY_MASK_SJIS, else return 0. */
+ CATEGORY_MASK_SJIS, else return 0. */
static int
-detect_coding_sjis (src, src_end, multibytep)
- unsigned char *src, *src_end;
- int multibytep;
+detect_coding_sjis (coding, detect_info)
+ struct coding_system *coding;
+ struct coding_detection_info *detect_info;
{
+ const unsigned char *src = coding->source, *src_base;
+ const unsigned char *src_end = coding->source + coding->src_bytes;
+ int multibytep = coding->src_multibyte;
+ int consumed_chars = 0;
+ int found = 0;
int c;
- /* Dummy for ONE_MORE_BYTE. */
- struct coding_system dummy_coding;
- struct coding_system *coding = &dummy_coding;
+
+ detect_info->checked |= CATEGORY_MASK_SJIS;
+ /* A coding system of this category is always ASCII compatible. */
+ src += coding->head_ascii;
while (1)
{
- ONE_MORE_BYTE_CHECK_MULTIBYTE (c, multibytep, CODING_CATEGORY_MASK_SJIS);
+ src_base = src;
+ ONE_MORE_BYTE (c);
if (c < 0x80)
continue;
- if (c == 0x80 || c == 0xA0 || c > 0xEF)
- return 0;
- if (c <= 0x9F || c >= 0xE0)
+ if ((c >= 0x81 && c <= 0x9F) || (c >= 0xE0 && c <= 0xEF))
{
- ONE_MORE_BYTE_CHECK_MULTIBYTE (c, multibytep, 0);
+ ONE_MORE_BYTE (c);
if (c < 0x40 || c == 0x7F || c > 0xFC)
- return 0;
+ break;
+ found = CATEGORY_MASK_SJIS;
}
+ else if (c >= 0xA0 && c < 0xE0)
+ found = CATEGORY_MASK_SJIS;
+ else
+ break;
+ }
+ detect_info->rejected |= CATEGORY_MASK_SJIS;
+ return 0;
+
+ no_more_source:
+ if (src_base < src && coding->mode & CODING_MODE_LAST_BLOCK)
+ {
+ detect_info->rejected |= CATEGORY_MASK_SJIS;
+ return 0;
}
+ detect_info->found |= found;
+ return 1;
}
/* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions".
Check if a text is encoded in BIG5. If it is, return
- CODING_CATEGORY_MASK_BIG5, else return 0. */
+ CATEGORY_MASK_BIG5, else return 0. */
static int
-detect_coding_big5 (src, src_end, multibytep)
- unsigned char *src, *src_end;
- int multibytep;
+detect_coding_big5 (coding, detect_info)
+ struct coding_system *coding;
+ struct coding_detection_info *detect_info;
{
+ const unsigned char *src = coding->source, *src_base;
+ const unsigned char *src_end = coding->source + coding->src_bytes;
+ int multibytep = coding->src_multibyte;
+ int consumed_chars = 0;
+ int found = 0;
int c;
- /* Dummy for ONE_MORE_BYTE. */
- struct coding_system dummy_coding;
- struct coding_system *coding = &dummy_coding;
+
+ detect_info->checked |= CATEGORY_MASK_BIG5;
+ /* A coding system of this category is always ASCII compatible. */
+ src += coding->head_ascii;
while (1)
{
- ONE_MORE_BYTE_CHECK_MULTIBYTE (c, multibytep, CODING_CATEGORY_MASK_BIG5);
+ src_base = src;
+ ONE_MORE_BYTE (c);
if (c < 0x80)
continue;
- if (c < 0xA1 || c > 0xFE)
- return 0;
- ONE_MORE_BYTE_CHECK_MULTIBYTE (c, multibytep, 0);
- if (c < 0x40 || (c > 0x7F && c < 0xA1) || c > 0xFE)
- return 0;
+ if (c >= 0xA1)
+ {
+ ONE_MORE_BYTE (c);
+ if (c < 0x40 || (c >= 0x7F && c <= 0xA0))
+ return 0;
+ found = CATEGORY_MASK_BIG5;
+ }
+ else
+ break;
+ }
+ detect_info->rejected |= CATEGORY_MASK_BIG5;
+ return 0;
+
+ no_more_source:
+ if (src_base < src && coding->mode & CODING_MODE_LAST_BLOCK)
+ {
+ detect_info->rejected |= CATEGORY_MASK_BIG5;
+ return 0;
}
+ detect_info->found |= found;
+ return 1;
}
-/* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions".
- Check if a text is encoded in UTF-8. If it is, return
- CODING_CATEGORY_MASK_UTF_8, else return 0. */
+/* See the above "GENERAL NOTES on `decode_coding_XXX ()' functions".
+ If SJIS_P is 1, decode SJIS text, else decode BIG5 test. */
-#define UTF_8_1_OCTET_P(c) ((c) < 0x80)
-#define UTF_8_EXTRA_OCTET_P(c) (((c) & 0xC0) == 0x80)
-#define UTF_8_2_OCTET_LEADING_P(c) (((c) & 0xE0) == 0xC0)
-#define UTF_8_3_OCTET_LEADING_P(c) (((c) & 0xF0) == 0xE0)
-#define UTF_8_4_OCTET_LEADING_P(c) (((c) & 0xF8) == 0xF0)
-#define UTF_8_5_OCTET_LEADING_P(c) (((c) & 0xFC) == 0xF8)
-#define UTF_8_6_OCTET_LEADING_P(c) (((c) & 0xFE) == 0xFC)
+static void
+decode_coding_sjis (coding)
+ struct coding_system *coding;
+{
+ const unsigned char *src = coding->source + coding->consumed;
+ const unsigned char *src_end = coding->source + coding->src_bytes;
+ const unsigned char *src_base;
+ int *charbuf = coding->charbuf + coding->charbuf_used;
+ int *charbuf_end
+ = coding->charbuf + coding->charbuf_size - MAX_ANNOTATION_LENGTH;
+ int consumed_chars = 0, consumed_chars_base;
+ int multibytep = coding->src_multibyte;
+ struct charset *charset_roman, *charset_kanji, *charset_kana;
+ struct charset *charset_kanji2;
+ Lisp_Object attrs, charset_list, val;
+ int char_offset = coding->produced_char;
+ int last_offset = char_offset;
+ int last_id = charset_ascii;
+
+ CODING_GET_INFO (coding, attrs, charset_list);
+
+ val = charset_list;
+ charset_roman = CHARSET_FROM_ID (XINT (XCAR (val))), val = XCDR (val);
+ charset_kana = CHARSET_FROM_ID (XINT (XCAR (val))), val = XCDR (val);
+ charset_kanji = CHARSET_FROM_ID (XINT (XCAR (val))), val = XCDR (val);
+ charset_kanji2 = NILP (val) ? NULL : CHARSET_FROM_ID (XINT (XCAR (val)));
+
+ while (1)
+ {
+ int c, c1;
+ struct charset *charset;
+
+ src_base = src;
+ consumed_chars_base = consumed_chars;
+
+ if (charbuf >= charbuf_end)
+ break;
+
+ ONE_MORE_BYTE (c);
+ if (c < 0)
+ goto invalid_code;
+ if (c < 0x80)
+ charset = charset_roman;
+ else if (c == 0x80 || c == 0xA0)
+ goto invalid_code;
+ else if (c >= 0xA1 && c <= 0xDF)
+ {
+ /* SJIS -> JISX0201-Kana */
+ c &= 0x7F;
+ charset = charset_kana;
+ }
+ else if (c <= 0xEF)
+ {
+ /* SJIS -> JISX0208 */
+ ONE_MORE_BYTE (c1);
+ if (c1 < 0x40 || c1 == 0x7F || c1 > 0xFC)
+ goto invalid_code;
+ c = (c << 8) | c1;
+ SJIS_TO_JIS (c);
+ charset = charset_kanji;
+ }
+ else if (c <= 0xFC && charset_kanji2)
+ {
+ /* SJIS -> JISX0213-2 */
+ ONE_MORE_BYTE (c1);
+ if (c1 < 0x40 || c1 == 0x7F || c1 > 0xFC)
+ goto invalid_code;
+ c = (c << 8) | c1;
+ SJIS_TO_JIS2 (c);
+ charset = charset_kanji2;
+ }
+ else
+ goto invalid_code;
+ if (charset->id != charset_ascii
+ && last_id != charset->id)
+ {
+ if (last_id != charset_ascii)
+ ADD_CHARSET_DATA (charbuf, char_offset - last_offset, last_id);
+ last_id = charset->id;
+ last_offset = char_offset;
+ }
+ CODING_DECODE_CHAR (coding, src, src_base, src_end, charset, c, c);
+ *charbuf++ = c;
+ char_offset++;
+ continue;
+
+ invalid_code:
+ src = src_base;
+ consumed_chars = consumed_chars_base;
+ ONE_MORE_BYTE (c);
+ *charbuf++ = c < 0 ? -c : BYTE8_TO_CHAR (c);
+ char_offset++;
+ coding->errors++;
+ }
+
+ no_more_source:
+ if (last_id != charset_ascii)
+ ADD_CHARSET_DATA (charbuf, char_offset - last_offset, last_id);
+ coding->consumed_char += consumed_chars_base;
+ coding->consumed = src_base - coding->source;
+ coding->charbuf_used = charbuf - coding->charbuf;
+}
+
+static void
+decode_coding_big5 (coding)
+ struct coding_system *coding;
+{
+ const unsigned char *src = coding->source + coding->consumed;
+ const unsigned char *src_end = coding->source + coding->src_bytes;
+ const unsigned char *src_base;
+ int *charbuf = coding->charbuf + coding->charbuf_used;
+ int *charbuf_end
+ = coding->charbuf + coding->charbuf_size - MAX_ANNOTATION_LENGTH;
+ int consumed_chars = 0, consumed_chars_base;
+ int multibytep = coding->src_multibyte;
+ struct charset *charset_roman, *charset_big5;
+ Lisp_Object attrs, charset_list, val;
+ int char_offset = coding->produced_char;
+ int last_offset = char_offset;
+ int last_id = charset_ascii;
+
+ CODING_GET_INFO (coding, attrs, charset_list);
+ val = charset_list;
+ charset_roman = CHARSET_FROM_ID (XINT (XCAR (val))), val = XCDR (val);
+ charset_big5 = CHARSET_FROM_ID (XINT (XCAR (val)));
+
+ while (1)
+ {
+ int c, c1;
+ struct charset *charset;
+
+ src_base = src;
+ consumed_chars_base = consumed_chars;
+
+ if (charbuf >= charbuf_end)
+ break;
+
+ ONE_MORE_BYTE (c);
+
+ if (c < 0)
+ goto invalid_code;
+ if (c < 0x80)
+ charset = charset_roman;
+ else
+ {
+ /* BIG5 -> Big5 */
+ if (c < 0xA1 || c > 0xFE)
+ goto invalid_code;
+ ONE_MORE_BYTE (c1);
+ if (c1 < 0x40 || (c1 > 0x7E && c1 < 0xA1) || c1 > 0xFE)
+ goto invalid_code;
+ c = c << 8 | c1;
+ charset = charset_big5;
+ }
+ if (charset->id != charset_ascii
+ && last_id != charset->id)
+ {
+ if (last_id != charset_ascii)
+ ADD_CHARSET_DATA (charbuf, char_offset - last_offset, last_id);
+ last_id = charset->id;
+ last_offset = char_offset;
+ }
+ CODING_DECODE_CHAR (coding, src, src_base, src_end, charset, c, c);
+ *charbuf++ = c;
+ char_offset++;
+ continue;
+
+ invalid_code:
+ src = src_base;
+ consumed_chars = consumed_chars_base;
+ ONE_MORE_BYTE (c);
+ *charbuf++ = c < 0 ? -c : BYTE8_TO_CHAR (c);
+ char_offset++;
+ coding->errors++;
+ }
+
+ no_more_source:
+ if (last_id != charset_ascii)
+ ADD_CHARSET_DATA (charbuf, char_offset - last_offset, last_id);
+ coding->consumed_char += consumed_chars_base;
+ coding->consumed = src_base - coding->source;
+ coding->charbuf_used = charbuf - coding->charbuf;
+}
+
+/* See the above "GENERAL NOTES on `encode_coding_XXX ()' functions".
+ This function can encode charsets `ascii', `katakana-jisx0201',
+ `japanese-jisx0208', `chinese-big5-1', and `chinese-big5-2'. We
+ are sure that all these charsets are registered as official charset
+ (i.e. do not have extended leading-codes). Characters of other
+ charsets are produced without any encoding. If SJIS_P is 1, encode
+ SJIS text, else encode BIG5 text. */
static int
-detect_coding_utf_8 (src, src_end, multibytep)
- unsigned char *src, *src_end;
- int multibytep;
+encode_coding_sjis (coding)
+ struct coding_system *coding;
{
- unsigned char c;
- int seq_maybe_bytes;
- /* Dummy for ONE_MORE_BYTE. */
- struct coding_system dummy_coding;
- struct coding_system *coding = &dummy_coding;
+ int multibytep = coding->dst_multibyte;
+ int *charbuf = coding->charbuf;
+ int *charbuf_end = charbuf + coding->charbuf_used;
+ unsigned char *dst = coding->destination + coding->produced;
+ unsigned char *dst_end = coding->destination + coding->dst_bytes;
+ int safe_room = 4;
+ int produced_chars = 0;
+ Lisp_Object attrs, charset_list, val;
+ int ascii_compatible;
+ struct charset *charset_roman, *charset_kanji, *charset_kana;
+ struct charset *charset_kanji2;
+ int c;
+
+ CODING_GET_INFO (coding, attrs, charset_list);
+ val = charset_list;
+ charset_roman = CHARSET_FROM_ID (XINT (XCAR (val))), val = XCDR (val);
+ charset_kana = CHARSET_FROM_ID (XINT (XCAR (val))), val = XCDR (val);
+ charset_kanji = CHARSET_FROM_ID (XINT (XCAR (val))), val = XCDR (val);
+ charset_kanji2 = NILP (val) ? NULL : CHARSET_FROM_ID (XINT (XCAR (val)));
+
+ ascii_compatible = ! NILP (CODING_ATTR_ASCII_COMPAT (attrs));
+
+ while (charbuf < charbuf_end)
+ {
+ ASSURE_DESTINATION (safe_room);
+ c = *charbuf++;
+ /* Now encode the character C. */
+ if (ASCII_CHAR_P (c) && ascii_compatible)
+ EMIT_ONE_ASCII_BYTE (c);
+ else if (CHAR_BYTE8_P (c))
+ {
+ c = CHAR_TO_BYTE8 (c);
+ EMIT_ONE_BYTE (c);
+ }
+ else
+ {
+ unsigned code;
+ struct charset *charset = char_charset (c, charset_list, &code);
+
+ if (!charset)
+ {
+ if (coding->mode & CODING_MODE_SAFE_ENCODING)
+ {
+ code = CODING_INHIBIT_CHARACTER_SUBSTITUTION;
+ charset = CHARSET_FROM_ID (charset_ascii);
+ }
+ else
+ {
+ c = coding->default_char;
+ charset = char_charset (c, charset_list, &code);
+ }
+ }
+ if (code == CHARSET_INVALID_CODE (charset))
+ abort ();
+ if (charset == charset_kanji)
+ {
+ int c1, c2;
+ JIS_TO_SJIS (code);
+ c1 = code >> 8, c2 = code & 0xFF;
+ EMIT_TWO_BYTES (c1, c2);
+ }
+ else if (charset == charset_kana)
+ EMIT_ONE_BYTE (code | 0x80);
+ else if (charset_kanji2 && charset == charset_kanji2)
+ {
+ int c1, c2;
+
+ c1 = code >> 8;
+ if (c1 == 0x21 || (c1 >= 0x23 && c1 < 0x25)
+ || (c1 >= 0x2C && c1 <= 0x2F) || c1 >= 0x6E)
+ {
+ JIS_TO_SJIS2 (code);
+ c1 = code >> 8, c2 = code & 0xFF;
+ EMIT_TWO_BYTES (c1, c2);
+ }
+ else
+ EMIT_ONE_ASCII_BYTE (code & 0x7F);
+ }
+ else
+ EMIT_ONE_ASCII_BYTE (code & 0x7F);
+ }
+ }
+ record_conversion_result (coding, CODING_RESULT_SUCCESS);
+ coding->produced_char += produced_chars;
+ coding->produced = dst - coding->destination;
+ return 0;
+}
+
+static int
+encode_coding_big5 (coding)
+ struct coding_system *coding;
+{
+ int multibytep = coding->dst_multibyte;
+ int *charbuf = coding->charbuf;
+ int *charbuf_end = charbuf + coding->charbuf_used;
+ unsigned char *dst = coding->destination + coding->produced;
+ unsigned char *dst_end = coding->destination + coding->dst_bytes;
+ int safe_room = 4;
+ int produced_chars = 0;
+ Lisp_Object attrs, charset_list, val;
+ int ascii_compatible;
+ struct charset *charset_roman, *charset_big5;
+ int c;
+
+ CODING_GET_INFO (coding, attrs, charset_list);
+ val = charset_list;
+ charset_roman = CHARSET_FROM_ID (XINT (XCAR (val))), val = XCDR (val);
+ charset_big5 = CHARSET_FROM_ID (XINT (XCAR (val)));
+ ascii_compatible = ! NILP (CODING_ATTR_ASCII_COMPAT (attrs));
+
+ while (charbuf < charbuf_end)
+ {
+ ASSURE_DESTINATION (safe_room);
+ c = *charbuf++;
+ /* Now encode the character C. */
+ if (ASCII_CHAR_P (c) && ascii_compatible)
+ EMIT_ONE_ASCII_BYTE (c);
+ else if (CHAR_BYTE8_P (c))
+ {
+ c = CHAR_TO_BYTE8 (c);
+ EMIT_ONE_BYTE (c);
+ }
+ else
+ {
+ unsigned code;
+ struct charset *charset = char_charset (c, charset_list, &code);
+
+ if (! charset)
+ {
+ if (coding->mode & CODING_MODE_SAFE_ENCODING)
+ {
+ code = CODING_INHIBIT_CHARACTER_SUBSTITUTION;
+ charset = CHARSET_FROM_ID (charset_ascii);
+ }
+ else
+ {
+ c = coding->default_char;
+ charset = char_charset (c, charset_list, &code);
+ }
+ }
+ if (code == CHARSET_INVALID_CODE (charset))
+ abort ();
+ if (charset == charset_big5)
+ {
+ int c1, c2;
+
+ c1 = code >> 8, c2 = code & 0xFF;
+ EMIT_TWO_BYTES (c1, c2);
+ }
+ else
+ EMIT_ONE_ASCII_BYTE (code & 0x7F);
+ }
+ }
+ record_conversion_result (coding, CODING_RESULT_SUCCESS);
+ coding->produced_char += produced_chars;
+ coding->produced = dst - coding->destination;
+ return 0;
+}
+
+\f
+/*** 10. CCL handlers ***/
+
+/* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions".
+ Check if a text is encoded in a coding system of which
+ encoder/decoder are written in CCL program. If it is, return
+ CATEGORY_MASK_CCL, else return 0. */
+
+static int
+detect_coding_ccl (coding, detect_info)
+ struct coding_system *coding;
+ struct coding_detection_info *detect_info;
+{
+ const unsigned char *src = coding->source, *src_base;
+ const unsigned char *src_end = coding->source + coding->src_bytes;
+ int multibytep = coding->src_multibyte;
+ int consumed_chars = 0;
+ int found = 0;
+ unsigned char *valids;
+ int head_ascii = coding->head_ascii;
+ Lisp_Object attrs;
+
+ detect_info->checked |= CATEGORY_MASK_CCL;
+
+ coding = &coding_categories[coding_category_ccl];
+ valids = CODING_CCL_VALIDS (coding);
+ attrs = CODING_ID_ATTRS (coding->id);
+ if (! NILP (CODING_ATTR_ASCII_COMPAT (attrs)))
+ src += head_ascii;
+
+ while (1)
+ {
+ int c;
+
+ src_base = src;
+ ONE_MORE_BYTE (c);
+ if (c < 0 || ! valids[c])
+ break;
+ if ((valids[c] > 1))
+ found = CATEGORY_MASK_CCL;
+ }
+ detect_info->rejected |= CATEGORY_MASK_CCL;
+ return 0;
+
+ no_more_source:
+ detect_info->found |= found;
+ return 1;
+}
- while (1)
- {
- ONE_MORE_BYTE_CHECK_MULTIBYTE (c, multibytep, CODING_CATEGORY_MASK_UTF_8);
- if (UTF_8_1_OCTET_P (c))
- continue;
- else if (UTF_8_2_OCTET_LEADING_P (c))
- seq_maybe_bytes = 1;
- else if (UTF_8_3_OCTET_LEADING_P (c))
- seq_maybe_bytes = 2;
- else if (UTF_8_4_OCTET_LEADING_P (c))
- seq_maybe_bytes = 3;
- else if (UTF_8_5_OCTET_LEADING_P (c))
- seq_maybe_bytes = 4;
- else if (UTF_8_6_OCTET_LEADING_P (c))
- seq_maybe_bytes = 5;
+static void
+decode_coding_ccl (coding)
+ struct coding_system *coding;
+{
+ const unsigned char *src = coding->source + coding->consumed;
+ const unsigned char *src_end = coding->source + coding->src_bytes;
+ int *charbuf = coding->charbuf + coding->charbuf_used;
+ int *charbuf_end = coding->charbuf + coding->charbuf_size;
+ int consumed_chars = 0;
+ int multibytep = coding->src_multibyte;
+ struct ccl_program ccl;
+ int source_charbuf[1024];
+ int source_byteidx[1024];
+ Lisp_Object attrs, charset_list;
+
+ CODING_GET_INFO (coding, attrs, charset_list);
+ setup_ccl_program (&ccl, CODING_CCL_DECODER (coding));
+
+ while (src < src_end)
+ {
+ const unsigned char *p = src;
+ int *source, *source_end;
+ int i = 0;
+
+ if (multibytep)
+ while (i < 1024 && p < src_end)
+ {
+ source_byteidx[i] = p - src;
+ source_charbuf[i++] = STRING_CHAR_ADVANCE (p);
+ }
else
- return 0;
+ while (i < 1024 && p < src_end)
+ source_charbuf[i++] = *p++;
- do
+ if (p == src_end && coding->mode & CODING_MODE_LAST_BLOCK)
+ ccl.last_block = 1;
+
+ source = source_charbuf;
+ source_end = source + i;
+ while (source < source_end)
{
- ONE_MORE_BYTE_CHECK_MULTIBYTE (c, multibytep, 0);
- if (!UTF_8_EXTRA_OCTET_P (c))
- return 0;
- seq_maybe_bytes--;
+ ccl_driver (&ccl, source, charbuf,
+ source_end - source, charbuf_end - charbuf,
+ charset_list);
+ source += ccl.consumed;
+ charbuf += ccl.produced;
+ if (ccl.status != CCL_STAT_SUSPEND_BY_DST)
+ break;
}
- while (seq_maybe_bytes > 0);
- }
-}
-
-/* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions".
- Check if a text is encoded in UTF-16 Big Endian (endian == 1) or
- Little Endian (otherwise). If it is, return
- CODING_CATEGORY_MASK_UTF_16_BE or CODING_CATEGORY_MASK_UTF_16_LE,
- else return 0. */
-
-#define UTF_16_INVALID_P(val) \
- (((val) == 0xFFFE) \
- || ((val) == 0xFFFF))
+ if (source < source_end)
+ src += source_byteidx[source - source_charbuf];
+ else
+ src = p;
+ consumed_chars += source - source_charbuf;
-#define UTF_16_HIGH_SURROGATE_P(val) \
- (((val) & 0xD800) == 0xD800)
+ if (ccl.status != CCL_STAT_SUSPEND_BY_SRC
+ && ccl.status != CODING_RESULT_INSUFFICIENT_SRC)
+ break;
+ }
-#define UTF_16_LOW_SURROGATE_P(val) \
- (((val) & 0xDC00) == 0xDC00)
+ switch (ccl.status)
+ {
+ case CCL_STAT_SUSPEND_BY_SRC:
+ record_conversion_result (coding, CODING_RESULT_INSUFFICIENT_SRC);
+ break;
+ case CCL_STAT_SUSPEND_BY_DST:
+ break;
+ case CCL_STAT_QUIT:
+ case CCL_STAT_INVALID_CMD:
+ record_conversion_result (coding, CODING_RESULT_INTERRUPT);
+ break;
+ default:
+ record_conversion_result (coding, CODING_RESULT_SUCCESS);
+ break;
+ }
+ coding->consumed_char += consumed_chars;
+ coding->consumed = src - coding->source;
+ coding->charbuf_used = charbuf - coding->charbuf;
+}
static int
-detect_coding_utf_16 (src, src_end, multibytep)
- unsigned char *src, *src_end;
- int multibytep;
+encode_coding_ccl (coding)
+ struct coding_system *coding;
{
- unsigned char c1, c2;
- /* Dummy for ONE_MORE_BYTE_CHECK_MULTIBYTE. */
- struct coding_system dummy_coding;
- struct coding_system *coding = &dummy_coding;
+ struct ccl_program ccl;
+ int multibytep = coding->dst_multibyte;
+ int *charbuf = coding->charbuf;
+ int *charbuf_end = charbuf + coding->charbuf_used;
+ unsigned char *dst = coding->destination + coding->produced;
+ unsigned char *dst_end = coding->destination + coding->dst_bytes;
+ int destination_charbuf[1024];
+ int i, produced_chars = 0;
+ Lisp_Object attrs, charset_list;
+
+ CODING_GET_INFO (coding, attrs, charset_list);
+ setup_ccl_program (&ccl, CODING_CCL_ENCODER (coding));
+
+ ccl.last_block = coding->mode & CODING_MODE_LAST_BLOCK;
+ ccl.dst_multibyte = coding->dst_multibyte;
+
+ while (charbuf < charbuf_end)
+ {
+ ccl_driver (&ccl, charbuf, destination_charbuf,
+ charbuf_end - charbuf, 1024, charset_list);
+ if (multibytep)
+ {
+ ASSURE_DESTINATION (ccl.produced * 2);
+ for (i = 0; i < ccl.produced; i++)
+ EMIT_ONE_BYTE (destination_charbuf[i] & 0xFF);
+ }
+ else
+ {
+ ASSURE_DESTINATION (ccl.produced);
+ for (i = 0; i < ccl.produced; i++)
+ *dst++ = destination_charbuf[i] & 0xFF;
+ produced_chars += ccl.produced;
+ }
+ charbuf += ccl.consumed;
+ if (ccl.status == CCL_STAT_QUIT
+ || ccl.status == CCL_STAT_INVALID_CMD)
+ break;
+ }
- ONE_MORE_BYTE_CHECK_MULTIBYTE (c1, multibytep, 0);
- ONE_MORE_BYTE_CHECK_MULTIBYTE (c2, multibytep, 0);
+ switch (ccl.status)
+ {
+ case CCL_STAT_SUSPEND_BY_SRC:
+ record_conversion_result (coding, CODING_RESULT_INSUFFICIENT_SRC);
+ break;
+ case CCL_STAT_SUSPEND_BY_DST:
+ record_conversion_result (coding, CODING_RESULT_INSUFFICIENT_DST);
+ break;
+ case CCL_STAT_QUIT:
+ case CCL_STAT_INVALID_CMD:
+ record_conversion_result (coding, CODING_RESULT_INTERRUPT);
+ break;
+ default:
+ record_conversion_result (coding, CODING_RESULT_SUCCESS);
+ break;
+ }
- if ((c1 == 0xFF) && (c2 == 0xFE))
- return CODING_CATEGORY_MASK_UTF_16_LE;
- else if ((c1 == 0xFE) && (c2 == 0xFF))
- return CODING_CATEGORY_MASK_UTF_16_BE;
+ coding->produced_char += produced_chars;
+ coding->produced = dst - coding->destination;
return 0;
}
-/* See the above "GENERAL NOTES on `decode_coding_XXX ()' functions".
- If SJIS_P is 1, decode SJIS text, else decode BIG5 test. */
+
+\f
+/*** 10, 11. no-conversion handlers ***/
+
+/* See the above "GENERAL NOTES on `decode_coding_XXX ()' functions". */
static void
-decode_coding_sjis_big5 (coding, source, destination,
- src_bytes, dst_bytes, sjis_p)
+decode_coding_raw_text (coding)
struct coding_system *coding;
- const unsigned char *source;
- unsigned char *destination;
- int src_bytes, dst_bytes;
- int sjis_p;
{
- const unsigned char *src = source;
- const unsigned char *src_end = source + src_bytes;
- unsigned char *dst = destination;
- unsigned char *dst_end = destination + dst_bytes;
- /* SRC_BASE remembers the start position in source in each loop.
- The loop will be exited when there's not enough source code
- (within macro ONE_MORE_BYTE), or when there's not enough
- destination area to produce a character (within macro
- EMIT_CHAR). */
- const unsigned char *src_base;
- Lisp_Object translation_table;
+ coding->chars_at_source = 1;
+ coding->consumed_char = 0;
+ coding->consumed = 0;
+ record_conversion_result (coding, CODING_RESULT_SUCCESS);
+}
- if (NILP (Venable_character_translation))
- translation_table = Qnil;
- else
- {
- translation_table = coding->translation_table_for_decode;
- if (NILP (translation_table))
- translation_table = Vstandard_translation_table_for_decode;
- }
+static int
+encode_coding_raw_text (coding)
+ struct coding_system *coding;
+{
+ int multibytep = coding->dst_multibyte;
+ int *charbuf = coding->charbuf;
+ int *charbuf_end = coding->charbuf + coding->charbuf_used;
+ unsigned char *dst = coding->destination + coding->produced;
+ unsigned char *dst_end = coding->destination + coding->dst_bytes;
+ int produced_chars = 0;
+ int c;
- coding->produced_char = 0;
- while (1)
+ if (multibytep)
{
- int c, charset, c1, c2 = 0;
+ int safe_room = MAX_MULTIBYTE_LENGTH * 2;
- src_base = src;
- ONE_MORE_BYTE (c1);
+ if (coding->src_multibyte)
+ while (charbuf < charbuf_end)
+ {
+ ASSURE_DESTINATION (safe_room);
+ c = *charbuf++;
+ if (ASCII_CHAR_P (c))
+ EMIT_ONE_ASCII_BYTE (c);
+ else if (CHAR_BYTE8_P (c))
+ {
+ c = CHAR_TO_BYTE8 (c);
+ EMIT_ONE_BYTE (c);
+ }
+ else
+ {
+ unsigned char str[MAX_MULTIBYTE_LENGTH], *p0 = str, *p1 = str;
- if (c1 < 0x80)
+ CHAR_STRING_ADVANCE (c, p1);
+ while (p0 < p1)
+ {
+ EMIT_ONE_BYTE (*p0);
+ p0++;
+ }
+ }
+ }
+ else
+ while (charbuf < charbuf_end)
+ {
+ ASSURE_DESTINATION (safe_room);
+ c = *charbuf++;
+ EMIT_ONE_BYTE (c);
+ }
+ }
+ else
+ {
+ if (coding->src_multibyte)
{
- charset = CHARSET_ASCII;
- if (c1 < 0x20)
+ int safe_room = MAX_MULTIBYTE_LENGTH;
+
+ while (charbuf < charbuf_end)
{
- if (c1 == '\r')
- {
- if (coding->eol_type == CODING_EOL_CRLF)
- {
- ONE_MORE_BYTE (c2);
- if (c2 == '\n')
- c1 = c2;
- else
- /* To process C2 again, SRC is subtracted by 1. */
- src--;
- }
- else if (coding->eol_type == CODING_EOL_CR)
- c1 = '\n';
- }
- else if (c1 == '\n'
- && (coding->mode & CODING_MODE_INHIBIT_INCONSISTENT_EOL)
- && (coding->eol_type == CODING_EOL_CR
- || coding->eol_type == CODING_EOL_CRLF))
- {
- coding->result = CODING_FINISH_INCONSISTENT_EOL;
- goto label_end_of_loop;
- }
+ ASSURE_DESTINATION (safe_room);
+ c = *charbuf++;
+ if (ASCII_CHAR_P (c))
+ *dst++ = c;
+ else if (CHAR_BYTE8_P (c))
+ *dst++ = CHAR_TO_BYTE8 (c);
+ else
+ CHAR_STRING_ADVANCE (c, dst);
+ produced_chars++;
}
}
else
- {
- if (sjis_p)
- {
- if (c1 == 0x80 || c1 == 0xA0 || c1 > 0xEF)
- goto label_invalid_code;
- if (c1 <= 0x9F || c1 >= 0xE0)
- {
- /* SJIS -> JISX0208 */
- ONE_MORE_BYTE (c2);
- if (c2 < 0x40 || c2 == 0x7F || c2 > 0xFC)
- goto label_invalid_code;
- DECODE_SJIS (c1, c2, c1, c2);
- charset = charset_jisx0208;
- }
- else
- /* SJIS -> JISX0201-Kana */
- charset = charset_katakana_jisx0201;
- }
- else
- {
- /* BIG5 -> Big5 */
- if (c1 < 0xA0 || c1 > 0xFE)
- goto label_invalid_code;
- ONE_MORE_BYTE (c2);
- if (c2 < 0x40 || (c2 > 0x7E && c2 < 0xA1) || c2 > 0xFE)
- goto label_invalid_code;
- DECODE_BIG5 (c1, c2, charset, c1, c2);
- }
+ {
+ ASSURE_DESTINATION (charbuf_end - charbuf);
+ while (charbuf < charbuf_end && dst < dst_end)
+ *dst++ = *charbuf++;
+ produced_chars = dst - (coding->destination + coding->dst_bytes);
}
-
- c = DECODE_ISO_CHARACTER (charset, c1, c2);
- EMIT_CHAR (c);
- continue;
-
- label_invalid_code:
- coding->errors++;
- src = src_base;
- c = *src++;
- EMIT_CHAR (c);
}
-
- label_end_of_loop:
- coding->consumed = coding->consumed_char = src_base - source;
- coding->produced = dst - destination;
- return;
+ record_conversion_result (coding, CODING_RESULT_SUCCESS);
+ coding->produced_char += produced_chars;
+ coding->produced = dst - coding->destination;
+ return 0;
}
-/* See the above "GENERAL NOTES on `encode_coding_XXX ()' functions".
- This function can encode charsets `ascii', `katakana-jisx0201',
- `japanese-jisx0208', `chinese-big5-1', and `chinese-big5-2'. We
- are sure that all these charsets are registered as official charset
- (i.e. do not have extended leading-codes). Characters of other
- charsets are produced without any encoding. If SJIS_P is 1, encode
- SJIS text, else encode BIG5 text. */
+/* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions".
+ Check if a text is encoded in a charset-based coding system. If it
+ is, return 1, else return 0. */
-static void
-encode_coding_sjis_big5 (coding, source, destination,
- src_bytes, dst_bytes, sjis_p)
+static int
+detect_coding_charset (coding, detect_info)
struct coding_system *coding;
- unsigned char *source, *destination;
- int src_bytes, dst_bytes;
- int sjis_p;
+ struct coding_detection_info *detect_info;
{
- unsigned char *src = source;
- unsigned char *src_end = source + src_bytes;
- unsigned char *dst = destination;
- unsigned char *dst_end = destination + dst_bytes;
- /* SRC_BASE remembers the start position in source in each loop.
- The loop will be exited when there's not enough source text to
- analyze multi-byte codes (within macro ONE_MORE_CHAR), or when
- there's not enough destination area to produce encoded codes
- (within macro EMIT_BYTES). */
- unsigned char *src_base;
- Lisp_Object translation_table;
+ const unsigned char *src = coding->source, *src_base;
+ const unsigned char *src_end = coding->source + coding->src_bytes;
+ int multibytep = coding->src_multibyte;
+ int consumed_chars = 0;
+ Lisp_Object attrs, valids;
+ int found = 0;
+ int head_ascii = coding->head_ascii;
- if (NILP (Venable_character_translation))
- translation_table = Qnil;
- else
- {
- translation_table = coding->translation_table_for_encode;
- if (NILP (translation_table))
- translation_table = Vstandard_translation_table_for_encode;
- }
+ detect_info->checked |= CATEGORY_MASK_CHARSET;
+
+ coding = &coding_categories[coding_category_charset];
+ attrs = CODING_ID_ATTRS (coding->id);
+ valids = AREF (attrs, coding_attr_charset_valids);
+
+ if (! NILP (CODING_ATTR_ASCII_COMPAT (attrs)))
+ src += head_ascii;
while (1)
{
- int c, charset, c1, c2;
+ int c;
+ Lisp_Object val;
+ struct charset *charset;
+ int dim, idx;
src_base = src;
- ONE_MORE_CHAR (c);
-
- /* Now encode the character C. */
- if (SINGLE_BYTE_CHAR_P (c))
+ ONE_MORE_BYTE (c);
+ if (c < 0)
+ continue;
+ val = AREF (valids, c);
+ if (NILP (val))
+ break;
+ if (c >= 0x80)
+ found = CATEGORY_MASK_CHARSET;
+ if (INTEGERP (val))
{
- switch (c)
+ charset = CHARSET_FROM_ID (XFASTINT (val));
+ dim = CHARSET_DIMENSION (charset);
+ for (idx = 1; idx < dim; idx++)
{
- case '\r':
- if (!(coding->mode & CODING_MODE_SELECTIVE_DISPLAY))
- {
- EMIT_ONE_BYTE (c);
- break;
- }
- c = '\n';
- case '\n':
- if (coding->eol_type == CODING_EOL_CRLF)
- {
- EMIT_TWO_BYTES ('\r', c);
- break;
- }
- else if (coding->eol_type == CODING_EOL_CR)
- c = '\r';
- default:
- EMIT_ONE_BYTE (c);
+ if (src == src_end)
+ goto too_short;
+ ONE_MORE_BYTE (c);
+ if (c < charset->code_space[(dim - 1 - idx) * 2]
+ || c > charset->code_space[(dim - 1 - idx) * 2 + 1])
+ break;
}
+ if (idx < dim)
+ break;
}
else
{
- SPLIT_CHAR (c, charset, c1, c2);
- if (sjis_p)
- {
- if (charset == charset_jisx0208
- || charset == charset_jisx0208_1978)
- {
- ENCODE_SJIS (c1, c2, c1, c2);
- EMIT_TWO_BYTES (c1, c2);
- }
- else if (charset == charset_katakana_jisx0201)
- EMIT_ONE_BYTE (c1 | 0x80);
- else if (charset == charset_latin_jisx0201)
- EMIT_ONE_BYTE (c1);
- else if (coding->mode & CODING_MODE_INHIBIT_UNENCODABLE_CHAR)
- {
- EMIT_ONE_BYTE (CODING_REPLACEMENT_CHARACTER);
- if (CHARSET_WIDTH (charset) > 1)
- EMIT_ONE_BYTE (CODING_REPLACEMENT_CHARACTER);
- }
- else
- /* There's no way other than producing the internal
- codes as is. */
- EMIT_BYTES (src_base, src);
- }
- else
+ idx = 1;
+ for (; CONSP (val); val = XCDR (val))
{
- if (charset == charset_big5_1 || charset == charset_big5_2)
+ charset = CHARSET_FROM_ID (XFASTINT (XCAR (val)));
+ dim = CHARSET_DIMENSION (charset);
+ while (idx < dim)
{
- ENCODE_BIG5 (charset, c1, c2, c1, c2);
- EMIT_TWO_BYTES (c1, c2);
+ if (src == src_end)
+ goto too_short;
+ ONE_MORE_BYTE (c);
+ if (c < charset->code_space[(dim - 1 - idx) * 4]
+ || c > charset->code_space[(dim - 1 - idx) * 4 + 1])
+ break;
+ idx++;
}
- else if (coding->mode & CODING_MODE_INHIBIT_UNENCODABLE_CHAR)
+ if (idx == dim)
{
- EMIT_ONE_BYTE (CODING_REPLACEMENT_CHARACTER);
- if (CHARSET_WIDTH (charset) > 1)
- EMIT_ONE_BYTE (CODING_REPLACEMENT_CHARACTER);
+ val = Qnil;
+ break;
}
- else
- /* There's no way other than producing the internal
- codes as is. */
- EMIT_BYTES (src_base, src);
}
+ if (CONSP (val))
+ break;
}
- coding->consumed_char++;
}
+ too_short:
+ detect_info->rejected |= CATEGORY_MASK_CHARSET;
+ return 0;
- label_end_of_loop:
- coding->consumed = src_base - source;
- coding->produced = coding->produced_char = dst - destination;
+ no_more_source:
+ detect_info->found |= found;
+ return 1;
}
-\f
-/*** 5. CCL handlers ***/
-
-/* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions".
- Check if a text is encoded in a coding system of which
- encoder/decoder are written in CCL program. If it is, return
- CODING_CATEGORY_MASK_CCL, else return 0. */
-
-static int
-detect_coding_ccl (src, src_end, multibytep)
- unsigned char *src, *src_end;
- int multibytep;
+static void
+decode_coding_charset (coding)
+ struct coding_system *coding;
{
- unsigned char *valid;
- int c;
- /* Dummy for ONE_MORE_BYTE. */
- struct coding_system dummy_coding;
- struct coding_system *coding = &dummy_coding;
-
- /* No coding system is assigned to coding-category-ccl. */
- if (!coding_system_table[CODING_CATEGORY_IDX_CCL])
- return 0;
+ const unsigned char *src = coding->source + coding->consumed;
+ const unsigned char *src_end = coding->source + coding->src_bytes;
+ const unsigned char *src_base;
+ int *charbuf = coding->charbuf + coding->charbuf_used;
+ int *charbuf_end
+ = coding->charbuf + coding->charbuf_size - MAX_ANNOTATION_LENGTH;
+ int consumed_chars = 0, consumed_chars_base;
+ int multibytep = coding->src_multibyte;
+ Lisp_Object attrs, charset_list, valids;
+ int char_offset = coding->produced_char;
+ int last_offset = char_offset;
+ int last_id = charset_ascii;
+
+ CODING_GET_INFO (coding, attrs, charset_list);
+ valids = AREF (attrs, coding_attr_charset_valids);
- valid = coding_system_table[CODING_CATEGORY_IDX_CCL]->spec.ccl.valid_codes;
while (1)
{
- ONE_MORE_BYTE_CHECK_MULTIBYTE (c, multibytep, CODING_CATEGORY_MASK_CCL);
- if (! valid[c])
- return 0;
- }
-}
+ int c;
+ Lisp_Object val;
+ struct charset *charset;
+ int dim;
+ int len = 1;
+ unsigned code;
-\f
-/*** 6. End-of-line handlers ***/
+ src_base = src;
+ consumed_chars_base = consumed_chars;
-/* See the above "GENERAL NOTES on `decode_coding_XXX ()' functions". */
+ if (charbuf >= charbuf_end)
+ break;
-static void
-decode_eol (coding, source, destination, src_bytes, dst_bytes)
- struct coding_system *coding;
- const unsigned char *source;
- unsigned char *destination;
- int src_bytes, dst_bytes;
-{
- const unsigned char *src = source;
- unsigned char *dst = destination;
- const unsigned char *src_end = src + src_bytes;
- unsigned char *dst_end = dst + dst_bytes;
- Lisp_Object translation_table;
- /* SRC_BASE remembers the start position in source in each loop.
- The loop will be exited when there's not enough source code
- (within macro ONE_MORE_BYTE), or when there's not enough
- destination area to produce a character (within macro
- EMIT_CHAR). */
- const unsigned char *src_base;
- int c;
+ ONE_MORE_BYTE (c);
+ if (c < 0)
+ goto invalid_code;
+ code = c;
- translation_table = Qnil;
- switch (coding->eol_type)
- {
- case CODING_EOL_CRLF:
- while (1)
+ val = AREF (valids, c);
+ if (NILP (val))
+ goto invalid_code;
+ if (INTEGERP (val))
{
- src_base = src;
- ONE_MORE_BYTE (c);
- if (c == '\r')
+ charset = CHARSET_FROM_ID (XFASTINT (val));
+ dim = CHARSET_DIMENSION (charset);
+ while (len < dim)
{
ONE_MORE_BYTE (c);
- if (c != '\n')
- {
- src--;
- c = '\r';
- }
- }
- else if (c == '\n'
- && (coding->mode & CODING_MODE_INHIBIT_INCONSISTENT_EOL))
- {
- coding->result = CODING_FINISH_INCONSISTENT_EOL;
- goto label_end_of_loop;
+ code = (code << 8) | c;
+ len++;
}
- EMIT_CHAR (c);
+ CODING_DECODE_CHAR (coding, src, src_base, src_end,
+ charset, code, c);
}
- break;
-
- case CODING_EOL_CR:
- while (1)
+ else
{
- src_base = src;
- ONE_MORE_BYTE (c);
- if (c == '\n')
+ /* VAL is a list of charset IDs. It is assured that the
+ list is sorted by charset dimensions (smaller one
+ comes first). */
+ while (CONSP (val))
{
- if (coding->mode & CODING_MODE_INHIBIT_INCONSISTENT_EOL)
+ charset = CHARSET_FROM_ID (XFASTINT (XCAR (val)));
+ dim = CHARSET_DIMENSION (charset);
+ while (len < dim)
{
- coding->result = CODING_FINISH_INCONSISTENT_EOL;
- goto label_end_of_loop;
+ ONE_MORE_BYTE (c);
+ code = (code << 8) | c;
+ len++;
}
+ CODING_DECODE_CHAR (coding, src, src_base,
+ src_end, charset, code, c);
+ if (c >= 0)
+ break;
+ val = XCDR (val);
}
- else if (c == '\r')
- c = '\n';
- EMIT_CHAR (c);
}
- break;
-
- default: /* no need for EOL handling */
- while (1)
+ if (c < 0)
+ goto invalid_code;
+ if (charset->id != charset_ascii
+ && last_id != charset->id)
{
- src_base = src;
- ONE_MORE_BYTE (c);
- EMIT_CHAR (c);
+ if (last_id != charset_ascii)
+ ADD_CHARSET_DATA (charbuf, char_offset - last_offset, last_id);
+ last_id = charset->id;
+ last_offset = char_offset;
}
+
+ *charbuf++ = c;
+ char_offset++;
+ continue;
+
+ invalid_code:
+ src = src_base;
+ consumed_chars = consumed_chars_base;
+ ONE_MORE_BYTE (c);
+ *charbuf++ = c < 0 ? -c : ASCII_BYTE_P (c) ? c : BYTE8_TO_CHAR (c);
+ char_offset++;
+ coding->errors++;
}
- label_end_of_loop:
- coding->consumed = coding->consumed_char = src_base - source;
- coding->produced = dst - destination;
- return;
+ no_more_source:
+ if (last_id != charset_ascii)
+ ADD_CHARSET_DATA (charbuf, char_offset - last_offset, last_id);
+ coding->consumed_char += consumed_chars_base;
+ coding->consumed = src_base - coding->source;
+ coding->charbuf_used = charbuf - coding->charbuf;
}
-/* See "GENERAL NOTES about `encode_coding_XXX ()' functions". Encode
- format of end-of-line according to `coding->eol_type'. It also
- convert multibyte form 8-bit characters to unibyte if
- CODING->src_multibyte is nonzero. If `coding->mode &
- CODING_MODE_SELECTIVE_DISPLAY' is nonzero, code '\r' in source text
- also means end-of-line. */
-
-static void
-encode_eol (coding, source, destination, src_bytes, dst_bytes)
+static int
+encode_coding_charset (coding)
struct coding_system *coding;
- const unsigned char *source;
- unsigned char *destination;
- int src_bytes, dst_bytes;
{
- const unsigned char *src = source;
- unsigned char *dst = destination;
- const unsigned char *src_end = src + src_bytes;
- unsigned char *dst_end = dst + dst_bytes;
- Lisp_Object translation_table;
- /* SRC_BASE remembers the start position in source in each loop.
- The loop will be exited when there's not enough source text to
- analyze multi-byte codes (within macro ONE_MORE_CHAR), or when
- there's not enough destination area to produce encoded codes
- (within macro EMIT_BYTES). */
- const unsigned char *src_base;
- unsigned char *tmp;
- int c;
- int selective_display = coding->mode & CODING_MODE_SELECTIVE_DISPLAY;
-
- translation_table = Qnil;
- if (coding->src_multibyte
- && *(src_end - 1) == LEADING_CODE_8_BIT_CONTROL)
- {
- src_end--;
- src_bytes--;
- coding->result = CODING_FINISH_INSUFFICIENT_SRC;
- }
-
- if (coding->eol_type == CODING_EOL_CRLF)
- {
- while (src < src_end)
- {
- src_base = src;
- c = *src++;
- if (c >= 0x20)
- EMIT_ONE_BYTE (c);
- else if (c == '\n' || (c == '\r' && selective_display))
- EMIT_TWO_BYTES ('\r', '\n');
- else
- EMIT_ONE_BYTE (c);
- }
- src_base = src;
- label_end_of_loop:
- ;
- }
- else
+ int multibytep = coding->dst_multibyte;
+ int *charbuf = coding->charbuf;
+ int *charbuf_end = charbuf + coding->charbuf_used;
+ unsigned char *dst = coding->destination + coding->produced;
+ unsigned char *dst_end = coding->destination + coding->dst_bytes;
+ int safe_room = MAX_MULTIBYTE_LENGTH;
+ int produced_chars = 0;
+ Lisp_Object attrs, charset_list;
+ int ascii_compatible;
+ int c;
+
+ CODING_GET_INFO (coding, attrs, charset_list);
+ ascii_compatible = ! NILP (CODING_ATTR_ASCII_COMPAT (attrs));
+
+ while (charbuf < charbuf_end)
{
- if (!dst_bytes || src_bytes <= dst_bytes)
+ struct charset *charset;
+ unsigned code;
+
+ ASSURE_DESTINATION (safe_room);
+ c = *charbuf++;
+ if (ascii_compatible && ASCII_CHAR_P (c))
+ EMIT_ONE_ASCII_BYTE (c);
+ else if (CHAR_BYTE8_P (c))
{
- safe_bcopy (src, dst, src_bytes);
- src_base = src_end;
- dst += src_bytes;
+ c = CHAR_TO_BYTE8 (c);
+ EMIT_ONE_BYTE (c);
}
else
{
- if (coding->src_multibyte
- && *(src + dst_bytes - 1) == LEADING_CODE_8_BIT_CONTROL)
- dst_bytes--;
- safe_bcopy (src, dst, dst_bytes);
- src_base = src + dst_bytes;
- dst = destination + dst_bytes;
- coding->result = CODING_FINISH_INSUFFICIENT_DST;
- }
- if (coding->eol_type == CODING_EOL_CR)
- {
- for (tmp = destination; tmp < dst; tmp++)
- if (*tmp == '\n') *tmp = '\r';
- }
- else if (selective_display)
- {
- for (tmp = destination; tmp < dst; tmp++)
- if (*tmp == '\r') *tmp = '\n';
+ charset = char_charset (c, charset_list, &code);
+ if (charset)
+ {
+ if (CHARSET_DIMENSION (charset) == 1)
+ EMIT_ONE_BYTE (code);
+ else if (CHARSET_DIMENSION (charset) == 2)
+ EMIT_TWO_BYTES (code >> 8, code & 0xFF);
+ else if (CHARSET_DIMENSION (charset) == 3)
+ EMIT_THREE_BYTES (code >> 16, (code >> 8) & 0xFF, code & 0xFF);
+ else
+ EMIT_FOUR_BYTES (code >> 24, (code >> 16) & 0xFF,
+ (code >> 8) & 0xFF, code & 0xFF);
+ }
+ else
+ {
+ if (coding->mode & CODING_MODE_SAFE_ENCODING)
+ c = CODING_INHIBIT_CHARACTER_SUBSTITUTION;
+ else
+ c = coding->default_char;
+ EMIT_ONE_BYTE (c);
+ }
}
}
- if (coding->src_multibyte)
- dst = destination + str_as_unibyte (destination, dst - destination);
- coding->consumed = src_base - source;
- coding->produced = dst - destination;
- coding->produced_char = coding->produced;
+ record_conversion_result (coding, CODING_RESULT_SUCCESS);
+ coding->produced_char += produced_chars;
+ coding->produced = dst - coding->destination;
+ return 0;
}
\f
/*** 7. C library functions ***/
-/* In Emacs Lisp, a coding system is represented by a Lisp symbol which
- has a property `coding-system'. The value of this property is a
- vector of length 5 (called the coding-vector). Among elements of
- this vector, the first (element[0]) and the fifth (element[4])
- carry important information for decoding/encoding. Before
- decoding/encoding, this information should be set in fields of a
- structure of type `coding_system'.
-
- The value of the property `coding-system' can be a symbol of another
- subsidiary coding-system. In that case, Emacs gets coding-vector
- from that symbol.
-
- `element[0]' contains information to be set in `coding->type'. The
- value and its meaning is as follows:
-
- 0 -- coding_type_emacs_mule
- 1 -- coding_type_sjis
- 2 -- coding_type_iso2022
- 3 -- coding_type_big5
- 4 -- coding_type_ccl encoder/decoder written in CCL
- nil -- coding_type_no_conversion
- t -- coding_type_undecided (automatic conversion on decoding,
- no-conversion on encoding)
-
- `element[4]' contains information to be set in `coding->flags' and
- `coding->spec'. The meaning varies by `coding->type'.
-
- If `coding->type' is `coding_type_iso2022', element[4] is a vector
- of length 32 (of which the first 13 sub-elements are used now).
- Meanings of these sub-elements are:
-
- sub-element[N] where N is 0 through 3: to be set in `coding->spec.iso2022'
- If the value is an integer of valid charset, the charset is
- assumed to be designated to graphic register N initially.
-
- If the value is minus, it is a minus value of charset which
- reserves graphic register N, which means that the charset is
- not designated initially but should be designated to graphic
- register N just before encoding a character in that charset.
-
- If the value is nil, graphic register N is never used on
- encoding.
-
- sub-element[N] where N is 4 through 11: to be set in `coding->flags'
- Each value takes t or nil. See the section ISO2022 of
- `coding.h' for more information.
-
- If `coding->type' is `coding_type_big5', element[4] is t to denote
- BIG5-ETen or nil to denote BIG5-HKU.
-
- If `coding->type' takes the other value, element[4] is ignored.
-
- Emacs Lisp's coding systems also carry information about format of
- end-of-line in a value of property `eol-type'. If the value is
- integer, 0 means CODING_EOL_LF, 1 means CODING_EOL_CRLF, and 2
- means CODING_EOL_CR. If it is not integer, it should be a vector
- of subsidiary coding systems of which property `eol-type' has one
- of the above values.
-
-*/
-
-/* Extract information for decoding/encoding from CODING_SYSTEM_SYMBOL
- and set it in CODING. If CODING_SYSTEM_SYMBOL is invalid, CODING
- is setup so that no conversion is necessary and return -1, else
- return 0. */
+/* Setup coding context CODING from information about CODING_SYSTEM.
+ If CODING_SYSTEM is nil, `no-conversion' is assumed. If
+ CODING_SYSTEM is invalid, signal an error. */
-int
+void
setup_coding_system (coding_system, coding)
Lisp_Object coding_system;
struct coding_system *coding;
{
- Lisp_Object coding_spec, coding_type, eol_type, plist;
+ Lisp_Object attrs;
+ Lisp_Object eol_type;
+ Lisp_Object coding_type;
Lisp_Object val;
- /* At first, zero clear all members. */
- bzero (coding, sizeof (struct coding_system));
-
- /* Initialize some fields required for all kinds of coding systems. */
- coding->symbol = coding_system;
- coding->heading_ascii = -1;
- coding->post_read_conversion = coding->pre_write_conversion = Qnil;
- coding->composing = COMPOSITION_DISABLED;
- coding->cmp_data = NULL;
-
if (NILP (coding_system))
- goto label_invalid_coding_system;
+ coding_system = Qundecided;
- coding_spec = Fget (coding_system, Qcoding_system);
+ CHECK_CODING_SYSTEM_GET_ID (coding_system, coding->id);
- if (!VECTORP (coding_spec)
- || XVECTOR (coding_spec)->size != 5
- || !CONSP (XVECTOR (coding_spec)->contents[3]))
- goto label_invalid_coding_system;
+ attrs = CODING_ID_ATTRS (coding->id);
+ eol_type = CODING_ID_EOL_TYPE (coding->id);
- eol_type = inhibit_eol_conversion ? Qnil : Fget (coding_system, Qeol_type);
+ coding->mode = 0;
+ coding->head_ascii = -1;
if (VECTORP (eol_type))
+ coding->common_flags = (CODING_REQUIRE_DECODING_MASK
+ | CODING_REQUIRE_DETECTION_MASK);
+ else if (! EQ (eol_type, Qunix))
+ coding->common_flags = (CODING_REQUIRE_DECODING_MASK
+ | CODING_REQUIRE_ENCODING_MASK);
+ else
+ coding->common_flags = 0;
+ if (! NILP (CODING_ATTR_POST_READ (attrs)))
+ coding->common_flags |= CODING_REQUIRE_DECODING_MASK;
+ if (! NILP (CODING_ATTR_PRE_WRITE (attrs)))
+ coding->common_flags |= CODING_REQUIRE_ENCODING_MASK;
+ if (! NILP (CODING_ATTR_FOR_UNIBYTE (attrs)))
+ coding->common_flags |= CODING_FOR_UNIBYTE_MASK;
+
+ val = CODING_ATTR_SAFE_CHARSETS (attrs);
+ coding->max_charset_id = SCHARS (val) - 1;
+ coding->safe_charsets = (char *) SDATA (val);
+ coding->default_char = XINT (CODING_ATTR_DEFAULT_CHAR (attrs));
+
+ coding_type = CODING_ATTR_TYPE (attrs);
+ if (EQ (coding_type, Qundecided))
{
- coding->eol_type = CODING_EOL_UNDECIDED;
- coding->common_flags = CODING_REQUIRE_DETECTION_MASK;
- if (system_eol_type != CODING_EOL_LF)
- coding->common_flags |= CODING_REQUIRE_ENCODING_MASK;
+ coding->detector = NULL;
+ coding->decoder = decode_coding_raw_text;
+ coding->encoder = encode_coding_raw_text;
+ coding->common_flags |= CODING_REQUIRE_DETECTION_MASK;
}
- else if (XFASTINT (eol_type) == 1)
+ else if (EQ (coding_type, Qiso_2022))
{
- coding->eol_type = CODING_EOL_CRLF;
+ int i;
+ int flags = XINT (AREF (attrs, coding_attr_iso_flags));
+
+ /* Invoke graphic register 0 to plane 0. */
+ CODING_ISO_INVOCATION (coding, 0) = 0;
+ /* Invoke graphic register 1 to plane 1 if we can use 8-bit. */
+ CODING_ISO_INVOCATION (coding, 1)
+ = (flags & CODING_ISO_FLAG_SEVEN_BITS ? -1 : 1);
+ /* Setup the initial status of designation. */
+ for (i = 0; i < 4; i++)
+ CODING_ISO_DESIGNATION (coding, i) = CODING_ISO_INITIAL (coding, i);
+ /* Not single shifting initially. */
+ CODING_ISO_SINGLE_SHIFTING (coding) = 0;
+ /* Beginning of buffer should also be regarded as bol. */
+ CODING_ISO_BOL (coding) = 1;
+ coding->detector = detect_coding_iso_2022;
+ coding->decoder = decode_coding_iso_2022;
+ coding->encoder = encode_coding_iso_2022;
+ if (flags & CODING_ISO_FLAG_SAFE)
+ coding->mode |= CODING_MODE_SAFE_ENCODING;
coding->common_flags
- = CODING_REQUIRE_DECODING_MASK | CODING_REQUIRE_ENCODING_MASK;
+ |= (CODING_REQUIRE_DECODING_MASK | CODING_REQUIRE_ENCODING_MASK
+ | CODING_REQUIRE_FLUSHING_MASK);
+ if (flags & CODING_ISO_FLAG_COMPOSITION)
+ coding->common_flags |= CODING_ANNOTATE_COMPOSITION_MASK;
+ if (flags & CODING_ISO_FLAG_DESIGNATION)
+ coding->common_flags |= CODING_ANNOTATE_CHARSET_MASK;
+ if (flags & CODING_ISO_FLAG_FULL_SUPPORT)
+ {
+ setup_iso_safe_charsets (attrs);
+ val = CODING_ATTR_SAFE_CHARSETS (attrs);
+ coding->max_charset_id = SCHARS (val) - 1;
+ coding->safe_charsets = (char *) SDATA (val);
+ }
+ CODING_ISO_FLAGS (coding) = flags;
}
- else if (XFASTINT (eol_type) == 2)
+ else if (EQ (coding_type, Qcharset))
{
- coding->eol_type = CODING_EOL_CR;
+ coding->detector = detect_coding_charset;
+ coding->decoder = decode_coding_charset;
+ coding->encoder = encode_coding_charset;
coding->common_flags
- = CODING_REQUIRE_DECODING_MASK | CODING_REQUIRE_ENCODING_MASK;
+ |= (CODING_REQUIRE_DECODING_MASK | CODING_REQUIRE_ENCODING_MASK);
}
- else
+ else if (EQ (coding_type, Qutf_8))
{
- coding->common_flags = 0;
- coding->eol_type = CODING_EOL_LF;
+ coding->detector = detect_coding_utf_8;
+ coding->decoder = decode_coding_utf_8;
+ coding->encoder = encode_coding_utf_8;
+ coding->common_flags
+ |= (CODING_REQUIRE_DECODING_MASK | CODING_REQUIRE_ENCODING_MASK);
+ }
+ else if (EQ (coding_type, Qutf_16))
+ {
+ val = AREF (attrs, coding_attr_utf_16_bom);
+ CODING_UTF_16_BOM (coding) = (CONSP (val) ? utf_16_detect_bom
+ : EQ (val, Qt) ? utf_16_with_bom
+ : utf_16_without_bom);
+ val = AREF (attrs, coding_attr_utf_16_endian);
+ CODING_UTF_16_ENDIAN (coding) = (EQ (val, Qbig) ? utf_16_big_endian
+ : utf_16_little_endian);
+ CODING_UTF_16_SURROGATE (coding) = 0;
+ coding->detector = detect_coding_utf_16;
+ coding->decoder = decode_coding_utf_16;
+ coding->encoder = encode_coding_utf_16;
+ coding->common_flags
+ |= (CODING_REQUIRE_DECODING_MASK | CODING_REQUIRE_ENCODING_MASK);
+ if (CODING_UTF_16_BOM (coding) == utf_16_detect_bom)
+ coding->common_flags |= CODING_REQUIRE_DETECTION_MASK;
}
-
- coding_type = XVECTOR (coding_spec)->contents[0];
- /* Try short cut. */
- if (SYMBOLP (coding_type))
+ else if (EQ (coding_type, Qccl))
+ {
+ coding->detector = detect_coding_ccl;
+ coding->decoder = decode_coding_ccl;
+ coding->encoder = encode_coding_ccl;
+ coding->common_flags
+ |= (CODING_REQUIRE_DECODING_MASK | CODING_REQUIRE_ENCODING_MASK
+ | CODING_REQUIRE_FLUSHING_MASK);
+ }
+ else if (EQ (coding_type, Qemacs_mule))
{
- if (EQ (coding_type, Qt))
+ coding->detector = detect_coding_emacs_mule;
+ coding->decoder = decode_coding_emacs_mule;
+ coding->encoder = encode_coding_emacs_mule;
+ coding->common_flags
+ |= (CODING_REQUIRE_DECODING_MASK | CODING_REQUIRE_ENCODING_MASK);
+ if (! NILP (AREF (attrs, coding_attr_emacs_mule_full))
+ && ! EQ (CODING_ATTR_CHARSET_LIST (attrs), Vemacs_mule_charset_list))
{
- coding->type = coding_type_undecided;
- coding->common_flags |= CODING_REQUIRE_DETECTION_MASK;
+ Lisp_Object tail, safe_charsets;
+ int max_charset_id = 0;
+
+ for (tail = Vemacs_mule_charset_list; CONSP (tail);
+ tail = XCDR (tail))
+ if (max_charset_id < XFASTINT (XCAR (tail)))
+ max_charset_id = XFASTINT (XCAR (tail));
+ safe_charsets = Fmake_string (make_number (max_charset_id + 1),
+ make_number (255));
+ for (tail = Vemacs_mule_charset_list; CONSP (tail);
+ tail = XCDR (tail))
+ SSET (safe_charsets, XFASTINT (XCAR (tail)), 0);
+ coding->max_charset_id = max_charset_id;
+ coding->safe_charsets = (char *) SDATA (safe_charsets);
}
- else
- coding->type = coding_type_no_conversion;
- /* Initialize this member. Any thing other than
- CODING_CATEGORY_IDX_UTF_16_BE and
- CODING_CATEGORY_IDX_UTF_16_LE are ok because they have
- special treatment in detect_eol. */
- coding->category_idx = CODING_CATEGORY_IDX_EMACS_MULE;
-
- return 0;
- }
-
- /* Get values of coding system properties:
- `post-read-conversion', `pre-write-conversion',
- `translation-table-for-decode', `translation-table-for-encode'. */
- plist = XVECTOR (coding_spec)->contents[3];
- /* Pre & post conversion functions should be disabled if
- inhibit_eol_conversion is nonzero. This is the case that a code
- conversion function is called while those functions are running. */
- if (! inhibit_pre_post_conversion)
- {
- coding->post_read_conversion = Fplist_get (plist, Qpost_read_conversion);
- coding->pre_write_conversion = Fplist_get (plist, Qpre_write_conversion);
- }
- val = Fplist_get (plist, Qtranslation_table_for_decode);
- if (SYMBOLP (val))
- val = Fget (val, Qtranslation_table_for_decode);
- coding->translation_table_for_decode = CHAR_TABLE_P (val) ? val : Qnil;
- val = Fplist_get (plist, Qtranslation_table_for_encode);
- if (SYMBOLP (val))
- val = Fget (val, Qtranslation_table_for_encode);
- coding->translation_table_for_encode = CHAR_TABLE_P (val) ? val : Qnil;
- val = Fplist_get (plist, Qcoding_category);
- if (!NILP (val))
- {
- val = Fget (val, Qcoding_category_index);
- if (INTEGERP (val))
- coding->category_idx = XINT (val);
- else
- goto label_invalid_coding_system;
}
- else
- goto label_invalid_coding_system;
-
- /* If the coding system has non-nil `composition' property, enable
- composition handling. */
- val = Fplist_get (plist, Qcomposition);
- if (!NILP (val))
- coding->composing = COMPOSITION_NO;
-
- /* If the coding system is ascii-incompatible, record it in
- common_flags. */
- val = Fplist_get (plist, Qascii_incompatible);
- if (! NILP (val))
- coding->common_flags |= CODING_ASCII_INCOMPATIBLE_MASK;
-
- switch (XFASTINT (coding_type))
+ else if (EQ (coding_type, Qshift_jis))
{
- case 0:
- coding->type = coding_type_emacs_mule;
- coding->common_flags
- |= CODING_REQUIRE_DECODING_MASK | CODING_REQUIRE_ENCODING_MASK;
- if (!NILP (coding->post_read_conversion))
- coding->common_flags |= CODING_REQUIRE_DECODING_MASK;
- if (!NILP (coding->pre_write_conversion))
- coding->common_flags |= CODING_REQUIRE_ENCODING_MASK;
- break;
-
- case 1:
- coding->type = coding_type_sjis;
- coding->common_flags
- |= CODING_REQUIRE_DECODING_MASK | CODING_REQUIRE_ENCODING_MASK;
- break;
-
- case 2:
- coding->type = coding_type_iso2022;
- coding->common_flags
- |= CODING_REQUIRE_DECODING_MASK | CODING_REQUIRE_ENCODING_MASK;
- {
- Lisp_Object val, temp;
- Lisp_Object *flags;
- int i, charset, reg_bits = 0;
-
- val = XVECTOR (coding_spec)->contents[4];
-
- if (!VECTORP (val) || XVECTOR (val)->size != 32)
- goto label_invalid_coding_system;
-
- flags = XVECTOR (val)->contents;
- coding->flags
- = ((NILP (flags[4]) ? 0 : CODING_FLAG_ISO_SHORT_FORM)
- | (NILP (flags[5]) ? 0 : CODING_FLAG_ISO_RESET_AT_EOL)
- | (NILP (flags[6]) ? 0 : CODING_FLAG_ISO_RESET_AT_CNTL)
- | (NILP (flags[7]) ? 0 : CODING_FLAG_ISO_SEVEN_BITS)
- | (NILP (flags[8]) ? 0 : CODING_FLAG_ISO_LOCKING_SHIFT)
- | (NILP (flags[9]) ? 0 : CODING_FLAG_ISO_SINGLE_SHIFT)
- | (NILP (flags[10]) ? 0 : CODING_FLAG_ISO_USE_ROMAN)
- | (NILP (flags[11]) ? 0 : CODING_FLAG_ISO_USE_OLDJIS)
- | (NILP (flags[12]) ? 0 : CODING_FLAG_ISO_NO_DIRECTION)
- | (NILP (flags[13]) ? 0 : CODING_FLAG_ISO_INIT_AT_BOL)
- | (NILP (flags[14]) ? 0 : CODING_FLAG_ISO_DESIGNATE_AT_BOL)
- | (NILP (flags[15]) ? 0 : CODING_FLAG_ISO_SAFE)
- | (NILP (flags[16]) ? 0 : CODING_FLAG_ISO_LATIN_EXTRA)
- );
-
- /* Invoke graphic register 0 to plane 0. */
- CODING_SPEC_ISO_INVOCATION (coding, 0) = 0;
- /* Invoke graphic register 1 to plane 1 if we can use full 8-bit. */
- CODING_SPEC_ISO_INVOCATION (coding, 1)
- = (coding->flags & CODING_FLAG_ISO_SEVEN_BITS ? -1 : 1);
- /* Not single shifting at first. */
- CODING_SPEC_ISO_SINGLE_SHIFTING (coding) = 0;
- /* Beginning of buffer should also be regarded as bol. */
- CODING_SPEC_ISO_BOL (coding) = 1;
-
- for (charset = 0; charset <= MAX_CHARSET; charset++)
- CODING_SPEC_ISO_REVISION_NUMBER (coding, charset) = 255;
- val = Vcharset_revision_alist;
- while (CONSP (val))
- {
- charset = get_charset_id (Fcar_safe (XCAR (val)));
- if (charset >= 0
- && (temp = Fcdr_safe (XCAR (val)), INTEGERP (temp))
- && (i = XINT (temp), (i >= 0 && (i + '@') < 128)))
- CODING_SPEC_ISO_REVISION_NUMBER (coding, charset) = i;
- val = XCDR (val);
- }
-
- /* Checks FLAGS[REG] (REG = 0, 1, 2 3) and decide designations.
- FLAGS[REG] can be one of below:
- integer CHARSET: CHARSET occupies register I,
- t: designate nothing to REG initially, but can be used
- by any charsets,
- list of integer, nil, or t: designate the first
- element (if integer) to REG initially, the remaining
- elements (if integer) is designated to REG on request,
- if an element is t, REG can be used by any charsets,
- nil: REG is never used. */
- for (charset = 0; charset <= MAX_CHARSET; charset++)
- CODING_SPEC_ISO_REQUESTED_DESIGNATION (coding, charset)
- = CODING_SPEC_ISO_NO_REQUESTED_DESIGNATION;
- for (i = 0; i < 4; i++)
- {
- if ((INTEGERP (flags[i])
- && (charset = XINT (flags[i]), CHARSET_VALID_P (charset)))
- || (charset = get_charset_id (flags[i])) >= 0)
- {
- CODING_SPEC_ISO_INITIAL_DESIGNATION (coding, i) = charset;
- CODING_SPEC_ISO_REQUESTED_DESIGNATION (coding, charset) = i;
- }
- else if (EQ (flags[i], Qt))
- {
- CODING_SPEC_ISO_INITIAL_DESIGNATION (coding, i) = -1;
- reg_bits |= 1 << i;
- coding->flags |= CODING_FLAG_ISO_DESIGNATION;
- }
- else if (CONSP (flags[i]))
- {
- Lisp_Object tail;
- tail = flags[i];
-
- coding->flags |= CODING_FLAG_ISO_DESIGNATION;
- if ((INTEGERP (XCAR (tail))
- && (charset = XINT (XCAR (tail)),
- CHARSET_VALID_P (charset)))
- || (charset = get_charset_id (XCAR (tail))) >= 0)
- {
- CODING_SPEC_ISO_INITIAL_DESIGNATION (coding, i) = charset;
- CODING_SPEC_ISO_REQUESTED_DESIGNATION (coding, charset) =i;
- }
- else
- CODING_SPEC_ISO_INITIAL_DESIGNATION (coding, i) = -1;
- tail = XCDR (tail);
- while (CONSP (tail))
- {
- if ((INTEGERP (XCAR (tail))
- && (charset = XINT (XCAR (tail)),
- CHARSET_VALID_P (charset)))
- || (charset = get_charset_id (XCAR (tail))) >= 0)
- CODING_SPEC_ISO_REQUESTED_DESIGNATION (coding, charset)
- = i;
- else if (EQ (XCAR (tail), Qt))
- reg_bits |= 1 << i;
- tail = XCDR (tail);
- }
- }
- else
- CODING_SPEC_ISO_INITIAL_DESIGNATION (coding, i) = -1;
-
- CODING_SPEC_ISO_DESIGNATION (coding, i)
- = CODING_SPEC_ISO_INITIAL_DESIGNATION (coding, i);
- }
-
- if (reg_bits && ! (coding->flags & CODING_FLAG_ISO_LOCKING_SHIFT))
- {
- /* REG 1 can be used only by locking shift in 7-bit env. */
- if (coding->flags & CODING_FLAG_ISO_SEVEN_BITS)
- reg_bits &= ~2;
- if (! (coding->flags & CODING_FLAG_ISO_SINGLE_SHIFT))
- /* Without any shifting, only REG 0 and 1 can be used. */
- reg_bits &= 3;
- }
-
- if (reg_bits)
- for (charset = 0; charset <= MAX_CHARSET; charset++)
- {
- if (CHARSET_DEFINED_P (charset)
- && (CODING_SPEC_ISO_REQUESTED_DESIGNATION (coding, charset)
- == CODING_SPEC_ISO_NO_REQUESTED_DESIGNATION))
- {
- /* There exist some default graphic registers to be
- used by CHARSET. */
-
- /* We had better avoid designating a charset of
- CHARS96 to REG 0 as far as possible. */
- if (CHARSET_CHARS (charset) == 96)
- CODING_SPEC_ISO_REQUESTED_DESIGNATION (coding, charset)
- = (reg_bits & 2
- ? 1 : (reg_bits & 4 ? 2 : (reg_bits & 8 ? 3 : 0)));
- else
- CODING_SPEC_ISO_REQUESTED_DESIGNATION (coding, charset)
- = (reg_bits & 1
- ? 0 : (reg_bits & 2 ? 1 : (reg_bits & 4 ? 2 : 3)));
- }
- }
- }
- coding->common_flags |= CODING_REQUIRE_FLUSHING_MASK;
- coding->spec.iso2022.last_invalid_designation_register = -1;
- break;
-
- case 3:
- coding->type = coding_type_big5;
+ coding->detector = detect_coding_sjis;
+ coding->decoder = decode_coding_sjis;
+ coding->encoder = encode_coding_sjis;
coding->common_flags
- |= CODING_REQUIRE_DECODING_MASK | CODING_REQUIRE_ENCODING_MASK;
- coding->flags
- = (NILP (XVECTOR (coding_spec)->contents[4])
- ? CODING_FLAG_BIG5_HKU
- : CODING_FLAG_BIG5_ETEN);
- break;
-
- case 4:
- coding->type = coding_type_ccl;
+ |= (CODING_REQUIRE_DECODING_MASK | CODING_REQUIRE_ENCODING_MASK);
+ }
+ else if (EQ (coding_type, Qbig5))
+ {
+ coding->detector = detect_coding_big5;
+ coding->decoder = decode_coding_big5;
+ coding->encoder = encode_coding_big5;
coding->common_flags
- |= CODING_REQUIRE_DECODING_MASK | CODING_REQUIRE_ENCODING_MASK;
- {
- val = XVECTOR (coding_spec)->contents[4];
- if (! CONSP (val)
- || setup_ccl_program (&(coding->spec.ccl.decoder),
- XCAR (val)) < 0
- || setup_ccl_program (&(coding->spec.ccl.encoder),
- XCDR (val)) < 0)
- goto label_invalid_coding_system;
-
- bzero (coding->spec.ccl.valid_codes, 256);
- val = Fplist_get (plist, Qvalid_codes);
- if (CONSP (val))
- {
- Lisp_Object this;
-
- for (; CONSP (val); val = XCDR (val))
- {
- this = XCAR (val);
- if (INTEGERP (this)
- && XINT (this) >= 0 && XINT (this) < 256)
- coding->spec.ccl.valid_codes[XINT (this)] = 1;
- else if (CONSP (this)
- && INTEGERP (XCAR (this))
- && INTEGERP (XCDR (this)))
- {
- int start = XINT (XCAR (this));
- int end = XINT (XCDR (this));
-
- if (start >= 0 && start <= end && end < 256)
- while (start <= end)
- coding->spec.ccl.valid_codes[start++] = 1;
- }
- }
- }
- }
- coding->common_flags |= CODING_REQUIRE_FLUSHING_MASK;
- coding->spec.ccl.cr_carryover = 0;
- coding->spec.ccl.eight_bit_carryover[0] = 0;
- break;
-
- case 5:
- coding->type = coding_type_raw_text;
- break;
+ |= (CODING_REQUIRE_DECODING_MASK | CODING_REQUIRE_ENCODING_MASK);
+ }
+ else /* EQ (coding_type, Qraw_text) */
+ {
+ coding->detector = NULL;
+ coding->decoder = decode_coding_raw_text;
+ coding->encoder = encode_coding_raw_text;
+ if (! EQ (eol_type, Qunix))
+ {
+ coding->common_flags |= CODING_REQUIRE_DECODING_MASK;
+ if (! VECTORP (eol_type))
+ coding->common_flags |= CODING_REQUIRE_ENCODING_MASK;
+ }
- default:
- goto label_invalid_coding_system;
}
- return 0;
- label_invalid_coding_system:
- coding->type = coding_type_no_conversion;
- coding->category_idx = CODING_CATEGORY_IDX_BINARY;
- coding->common_flags = 0;
- coding->eol_type = CODING_EOL_UNDECIDED;
- coding->pre_write_conversion = coding->post_read_conversion = Qnil;
- return NILP (coding_system) ? 0 : -1;
+ return;
}
-/* Free memory blocks allocated for storing composition information. */
+/* Return a list of charsets supported by CODING. */
-void
-coding_free_composition_data (coding)
+Lisp_Object
+coding_charset_list (coding)
struct coding_system *coding;
{
- struct composition_data *cmp_data = coding->cmp_data, *next;
+ Lisp_Object attrs, charset_list;
- if (!cmp_data)
- return;
- /* Memory blocks are chained. At first, rewind to the first, then,
- free blocks one by one. */
- while (cmp_data->prev)
- cmp_data = cmp_data->prev;
- while (cmp_data)
+ CODING_GET_INFO (coding, attrs, charset_list);
+ if (EQ (CODING_ATTR_TYPE (attrs), Qiso_2022))
{
- next = cmp_data->next;
- xfree (cmp_data);
- cmp_data = next;
+ int flags = XINT (AREF (attrs, coding_attr_iso_flags));
+
+ if (flags & CODING_ISO_FLAG_FULL_SUPPORT)
+ charset_list = Viso_2022_charset_list;
+ }
+ else if (EQ (CODING_ATTR_TYPE (attrs), Qemacs_mule))
+ {
+ charset_list = Vemacs_mule_charset_list;
}
- coding->cmp_data = NULL;
+ return charset_list;
}
-/* Set `char_offset' member of all memory blocks pointed by
- coding->cmp_data to POS. */
-void
-coding_adjust_composition_offset (coding, pos)
- struct coding_system *coding;
- int pos;
+/* Return raw-text or one of its subsidiaries that has the same
+ eol_type as CODING-SYSTEM. */
+
+Lisp_Object
+raw_text_coding_system (coding_system)
+ Lisp_Object coding_system;
{
- struct composition_data *cmp_data;
+ Lisp_Object spec, attrs;
+ Lisp_Object eol_type, raw_text_eol_type;
+
+ if (NILP (coding_system))
+ return Qraw_text;
+ spec = CODING_SYSTEM_SPEC (coding_system);
+ attrs = AREF (spec, 0);
+
+ if (EQ (CODING_ATTR_TYPE (attrs), Qraw_text))
+ return coding_system;
- for (cmp_data = coding->cmp_data; cmp_data; cmp_data = cmp_data->next)
- cmp_data->char_offset = pos;
+ eol_type = AREF (spec, 2);
+ if (VECTORP (eol_type))
+ return Qraw_text;
+ spec = CODING_SYSTEM_SPEC (Qraw_text);
+ raw_text_eol_type = AREF (spec, 2);
+ return (EQ (eol_type, Qunix) ? AREF (raw_text_eol_type, 0)
+ : EQ (eol_type, Qdos) ? AREF (raw_text_eol_type, 1)
+ : AREF (raw_text_eol_type, 2));
}
-/* Setup raw-text or one of its subsidiaries in the structure
- coding_system CODING according to the already setup value eol_type
- in CODING. CODING should be setup for some coding system in
- advance. */
-void
-setup_raw_text_coding_system (coding)
- struct coding_system *coding;
+/* If CODING_SYSTEM doesn't specify end-of-line format but PARENT
+ does, return one of the subsidiary that has the same eol-spec as
+ PARENT. Otherwise, return CODING_SYSTEM. If PARENT is nil,
+ inherit end-of-line format from the system's setting
+ (system_eol_type). */
+
+Lisp_Object
+coding_inherit_eol_type (coding_system, parent)
+ Lisp_Object coding_system, parent;
{
- if (coding->type != coding_type_raw_text)
+ Lisp_Object spec, eol_type;
+
+ if (NILP (coding_system))
+ coding_system = Qraw_text;
+ spec = CODING_SYSTEM_SPEC (coding_system);
+ eol_type = AREF (spec, 2);
+ if (VECTORP (eol_type))
{
- coding->symbol = Qraw_text;
- coding->type = coding_type_raw_text;
- if (coding->eol_type != CODING_EOL_UNDECIDED)
+ Lisp_Object parent_eol_type;
+
+ if (! NILP (parent))
{
- Lisp_Object subsidiaries;
- subsidiaries = Fget (Qraw_text, Qeol_type);
+ Lisp_Object parent_spec;
- if (VECTORP (subsidiaries)
- && XVECTOR (subsidiaries)->size == 3)
- coding->symbol
- = XVECTOR (subsidiaries)->contents[coding->eol_type];
+ parent_spec = CODING_SYSTEM_SPEC (parent);
+ parent_eol_type = AREF (parent_spec, 2);
}
- setup_coding_system (coding->symbol, coding);
- }
- return;
+ else
+ parent_eol_type = system_eol_type;
+ if (EQ (parent_eol_type, Qunix))
+ coding_system = AREF (eol_type, 0);
+ else if (EQ (parent_eol_type, Qdos))
+ coding_system = AREF (eol_type, 1);
+ else if (EQ (parent_eol_type, Qmac))
+ coding_system = AREF (eol_type, 2);
+ }
+ return coding_system;
}
/* Emacs has a mechanism to automatically detect a coding system if it
o coding-category-iso-7-else
The category for a coding system which has the same code range
- as ISO2022 of 7-bit environment but uses locking shift or
+ as ISO2022 of 7-bit environemnt but uses locking shift or
single shift functions. Assigned the coding-system (Lisp
symbol) `iso-2022-7bit-lock' by default.
o coding-category-iso-8-else
The category for a coding system which has the same code range
- as ISO2022 of 8-bit environment but uses locking shift or
+ as ISO2022 of 8-bit environemnt but uses locking shift or
single shift functions. Assigned the coding-system (Lisp
symbol) `iso-2022-8bit-ss2' by default.
`no-conversion' by default.
Each of them is a Lisp symbol and the value is an actual
- `coding-system' (this is also a Lisp symbol) assigned by a user.
+ `coding-system's (this is also a Lisp symbol) assigned by a user.
What Emacs does actually is to detect a category of coding system.
Then, it uses a `coding-system' assigned to it. If Emacs can't
- decide a single possible category, it selects a category of the
+ decide only one possible category, it selects a category of the
highest priority. Priorities of categories are also specified by a
user in a Lisp variable `coding-category-list'.
*/
-static
-int ascii_skip_code[256];
-
-/* Detect how a text of length SRC_BYTES pointed by SOURCE is encoded.
- If it detects possible coding systems, return an integer in which
- appropriate flag bits are set. Flag bits are defined by macros
- CODING_CATEGORY_MASK_XXX in `coding.h'. If PRIORITIES is non-NULL,
- it should point the table `coding_priorities'. In that case, only
- the flag bit for a coding system of the highest priority is set in
- the returned value. If MULTIBYTEP is nonzero, 8-bit codes of the
- range 0x80..0x9F are in multibyte form.
-
- How many ASCII characters are at the head is returned as *SKIP. */
-
-static int
-detect_coding_mask (source, src_bytes, priorities, skip, multibytep)
- unsigned char *source;
- int src_bytes, *priorities, *skip;
- int multibytep;
-{
- register unsigned char c;
- unsigned char *src = source, *src_end = source + src_bytes;
- unsigned int mask, utf16_examined_p, iso2022_examined_p;
- int i;
-
- /* At first, skip all ASCII characters and control characters except
- for three ISO2022 specific control characters. */
- ascii_skip_code[ISO_CODE_SO] = 0;
- ascii_skip_code[ISO_CODE_SI] = 0;
- ascii_skip_code[ISO_CODE_ESC] = 0;
-
- label_loop_detect_coding:
- while (src < src_end && ascii_skip_code[*src]) src++;
- *skip = src - source;
-
- if (src >= src_end)
- /* We found nothing other than ASCII. There's nothing to do. */
- return 0;
-
- c = *src;
- /* The text seems to be encoded in some multilingual coding system.
- Now, try to find in which coding system the text is encoded. */
- if (c < 0x80)
- {
- /* i.e. (c == ISO_CODE_ESC || c == ISO_CODE_SI || c == ISO_CODE_SO) */
- /* C is an ISO2022 specific control code of C0. */
- mask = detect_coding_iso2022 (src, src_end, multibytep);
- if (mask == 0)
- {
- /* No valid ISO2022 code follows C. Try again. */
- src++;
- if (c == ISO_CODE_ESC)
- ascii_skip_code[ISO_CODE_ESC] = 1;
- else
- ascii_skip_code[ISO_CODE_SO] = ascii_skip_code[ISO_CODE_SI] = 1;
- goto label_loop_detect_coding;
- }
- if (priorities)
- {
- for (i = 0; i < CODING_CATEGORY_IDX_MAX; i++)
- {
- if (mask & priorities[i])
- return priorities[i];
- }
- return CODING_CATEGORY_MASK_RAW_TEXT;
- }
- }
- else
- {
- int try;
-
- if (multibytep && c == LEADING_CODE_8_BIT_CONTROL)
- c = src[1] - 0x20;
-
- if (c < 0xA0)
- {
- /* C is the first byte of SJIS character code,
- or a leading-code of Emacs' internal format (emacs-mule),
- or the first byte of UTF-16. */
- try = (CODING_CATEGORY_MASK_SJIS
- | CODING_CATEGORY_MASK_EMACS_MULE
- | CODING_CATEGORY_MASK_UTF_16_BE
- | CODING_CATEGORY_MASK_UTF_16_LE);
-
- /* Or, if C is a special latin extra code,
- or is an ISO2022 specific control code of C1 (SS2 or SS3),
- or is an ISO2022 control-sequence-introducer (CSI),
- we should also consider the possibility of ISO2022 codings. */
- if ((VECTORP (Vlatin_extra_code_table)
- && !NILP (XVECTOR (Vlatin_extra_code_table)->contents[c]))
- || (c == ISO_CODE_SS2 || c == ISO_CODE_SS3)
- || (c == ISO_CODE_CSI
- && (src < src_end
- && (*src == ']'
- || ((*src == '0' || *src == '1' || *src == '2')
- && src + 1 < src_end
- && src[1] == ']')))))
- try |= (CODING_CATEGORY_MASK_ISO_8_ELSE
- | CODING_CATEGORY_MASK_ISO_8BIT);
- }
- else
- /* C is a character of ISO2022 in graphic plane right,
- or a SJIS's 1-byte character code (i.e. JISX0201),
- or the first byte of BIG5's 2-byte code,
- or the first byte of UTF-8/16. */
- try = (CODING_CATEGORY_MASK_ISO_8_ELSE
- | CODING_CATEGORY_MASK_ISO_8BIT
- | CODING_CATEGORY_MASK_SJIS
- | CODING_CATEGORY_MASK_BIG5
- | CODING_CATEGORY_MASK_UTF_8
- | CODING_CATEGORY_MASK_UTF_16_BE
- | CODING_CATEGORY_MASK_UTF_16_LE);
-
- /* Or, we may have to consider the possibility of CCL. */
- if (coding_system_table[CODING_CATEGORY_IDX_CCL]
- && (coding_system_table[CODING_CATEGORY_IDX_CCL]
- ->spec.ccl.valid_codes)[c])
- try |= CODING_CATEGORY_MASK_CCL;
-
- mask = 0;
- utf16_examined_p = iso2022_examined_p = 0;
- if (priorities)
- {
- for (i = 0; i < CODING_CATEGORY_IDX_MAX; i++)
- {
- if (!iso2022_examined_p
- && (priorities[i] & try & CODING_CATEGORY_MASK_ISO))
- {
- mask |= detect_coding_iso2022 (src, src_end, multibytep);
- iso2022_examined_p = 1;
- }
- else if (priorities[i] & try & CODING_CATEGORY_MASK_SJIS)
- mask |= detect_coding_sjis (src, src_end, multibytep);
- else if (priorities[i] & try & CODING_CATEGORY_MASK_UTF_8)
- mask |= detect_coding_utf_8 (src, src_end, multibytep);
- else if (!utf16_examined_p
- && (priorities[i] & try &
- CODING_CATEGORY_MASK_UTF_16_BE_LE))
- {
- mask |= detect_coding_utf_16 (src, src_end, multibytep);
- utf16_examined_p = 1;
- }
- else if (priorities[i] & try & CODING_CATEGORY_MASK_BIG5)
- mask |= detect_coding_big5 (src, src_end, multibytep);
- else if (priorities[i] & try & CODING_CATEGORY_MASK_EMACS_MULE)
- mask |= detect_coding_emacs_mule (src, src_end, multibytep);
- else if (priorities[i] & try & CODING_CATEGORY_MASK_CCL)
- mask |= detect_coding_ccl (src, src_end, multibytep);
- else if (priorities[i] & CODING_CATEGORY_MASK_RAW_TEXT)
- mask |= CODING_CATEGORY_MASK_RAW_TEXT;
- else if (priorities[i] & CODING_CATEGORY_MASK_BINARY)
- mask |= CODING_CATEGORY_MASK_BINARY;
- if (mask & priorities[i])
- return priorities[i];
- }
- return CODING_CATEGORY_MASK_RAW_TEXT;
- }
- if (try & CODING_CATEGORY_MASK_ISO)
- mask |= detect_coding_iso2022 (src, src_end, multibytep);
- if (try & CODING_CATEGORY_MASK_SJIS)
- mask |= detect_coding_sjis (src, src_end, multibytep);
- if (try & CODING_CATEGORY_MASK_BIG5)
- mask |= detect_coding_big5 (src, src_end, multibytep);
- if (try & CODING_CATEGORY_MASK_UTF_8)
- mask |= detect_coding_utf_8 (src, src_end, multibytep);
- if (try & CODING_CATEGORY_MASK_UTF_16_BE_LE)
- mask |= detect_coding_utf_16 (src, src_end, multibytep);
- if (try & CODING_CATEGORY_MASK_EMACS_MULE)
- mask |= detect_coding_emacs_mule (src, src_end, multibytep);
- if (try & CODING_CATEGORY_MASK_CCL)
- mask |= detect_coding_ccl (src, src_end, multibytep);
- }
- return (mask | CODING_CATEGORY_MASK_RAW_TEXT | CODING_CATEGORY_MASK_BINARY);
-}
-
-/* Detect how a text of length SRC_BYTES pointed by SRC is encoded.
- The information of the detected coding system is set in CODING. */
-
-void
-detect_coding (coding, src, src_bytes)
- struct coding_system *coding;
- const unsigned char *src;
- int src_bytes;
-{
- unsigned int idx;
- int skip, mask;
- Lisp_Object val;
-
- val = Vcoding_category_list;
- mask = detect_coding_mask (src, src_bytes, coding_priorities, &skip,
- coding->src_multibyte);
- coding->heading_ascii = skip;
-
- if (!mask) return;
-
- /* We found a single coding system of the highest priority in MASK. */
- idx = 0;
- while (mask && ! (mask & 1)) mask >>= 1, idx++;
- if (! mask)
- idx = CODING_CATEGORY_IDX_RAW_TEXT;
-
- val = find_symbol_value (XVECTOR (Vcoding_category_table)->contents[idx]);
-
- if (coding->eol_type != CODING_EOL_UNDECIDED)
- {
- Lisp_Object tmp;
-
- tmp = Fget (val, Qeol_type);
- if (VECTORP (tmp))
- val = XVECTOR (tmp)->contents[coding->eol_type];
- }
-
- /* Setup this new coding system while preserving some slots. */
- {
- int src_multibyte = coding->src_multibyte;
- int dst_multibyte = coding->dst_multibyte;
-
- setup_coding_system (val, coding);
- coding->src_multibyte = src_multibyte;
- coding->dst_multibyte = dst_multibyte;
- coding->heading_ascii = skip;
- }
-}
+#define EOL_SEEN_NONE 0
+#define EOL_SEEN_LF 1
+#define EOL_SEEN_CR 2
+#define EOL_SEEN_CRLF 4
/* Detect how end-of-line of a text of length SRC_BYTES pointed by
- SOURCE is encoded. Return one of CODING_EOL_LF, CODING_EOL_CRLF,
- CODING_EOL_CR, and CODING_EOL_UNDECIDED.
-
- How many non-eol characters are at the head is returned as *SKIP. */
-
-#define MAX_EOL_CHECK_COUNT 3
-
-static int
-detect_eol_type (source, src_bytes, skip)
- const unsigned char *source;
- int src_bytes, *skip;
-{
- const unsigned char *src = source, *src_end = src + src_bytes;
- unsigned char c;
- int total = 0; /* How many end-of-lines are found so far. */
- int eol_type = CODING_EOL_UNDECIDED;
- int this_eol_type;
-
- *skip = 0;
-
- while (src < src_end && total < MAX_EOL_CHECK_COUNT)
- {
- c = *src++;
- if (c == '\n' || c == '\r')
- {
- if (*skip == 0)
- *skip = src - 1 - source;
- total++;
- if (c == '\n')
- this_eol_type = CODING_EOL_LF;
- else if (src >= src_end || *src != '\n')
- this_eol_type = CODING_EOL_CR;
- else
- this_eol_type = CODING_EOL_CRLF, src++;
-
- if (eol_type == CODING_EOL_UNDECIDED)
- /* This is the first end-of-line. */
- eol_type = this_eol_type;
- else if (eol_type != this_eol_type)
- {
- /* The found type is different from what found before. */
- eol_type = CODING_EOL_INCONSISTENT;
- break;
- }
- }
- }
-
- if (*skip == 0)
- *skip = src_end - source;
- return eol_type;
-}
-
-/* Like detect_eol_type, but detect EOL type in 2-octet
- big-endian/little-endian format for coding systems utf-16-be and
- utf-16-le. */
-
-static int
-detect_eol_type_in_2_octet_form (source, src_bytes, skip, big_endian_p)
- const unsigned char *source;
- int src_bytes, *skip, big_endian_p;
-{
- const unsigned char *src = source, *src_end = src + src_bytes;
- unsigned int c1, c2;
- int total = 0; /* How many end-of-lines are found so far. */
- int eol_type = CODING_EOL_UNDECIDED;
- int this_eol_type;
- int msb, lsb;
-
- if (big_endian_p)
- msb = 0, lsb = 1;
- else
- msb = 1, lsb = 0;
-
- *skip = 0;
-
- while ((src + 1) < src_end && total < MAX_EOL_CHECK_COUNT)
- {
- c1 = (src[msb] << 8) | (src[lsb]);
- src += 2;
-
- if (c1 == '\n' || c1 == '\r')
- {
- if (*skip == 0)
- *skip = src - 2 - source;
- total++;
- if (c1 == '\n')
- {
- this_eol_type = CODING_EOL_LF;
- }
- else
- {
- if ((src + 1) >= src_end)
- {
- this_eol_type = CODING_EOL_CR;
- }
- else
- {
- c2 = (src[msb] << 8) | (src[lsb]);
- if (c2 == '\n')
- this_eol_type = CODING_EOL_CRLF, src += 2;
- else
- this_eol_type = CODING_EOL_CR;
- }
- }
-
- if (eol_type == CODING_EOL_UNDECIDED)
- /* This is the first end-of-line. */
- eol_type = this_eol_type;
- else if (eol_type != this_eol_type)
- {
- /* The found type is different from what found before. */
- eol_type = CODING_EOL_INCONSISTENT;
- break;
- }
- }
- }
-
- if (*skip == 0)
- *skip = src_end - source;
- return eol_type;
-}
-
-/* Detect how end-of-line of a text of length SRC_BYTES pointed by SRC
- is encoded. If it detects an appropriate format of end-of-line, it
- sets the information in *CODING. */
-
-void
-detect_eol (coding, src, src_bytes)
- struct coding_system *coding;
- const unsigned char *src;
- int src_bytes;
-{
- Lisp_Object val;
- int skip;
- int eol_type;
-
- switch (coding->category_idx)
- {
- case CODING_CATEGORY_IDX_UTF_16_BE:
- eol_type = detect_eol_type_in_2_octet_form (src, src_bytes, &skip, 1);
- break;
- case CODING_CATEGORY_IDX_UTF_16_LE:
- eol_type = detect_eol_type_in_2_octet_form (src, src_bytes, &skip, 0);
- break;
- default:
- eol_type = detect_eol_type (src, src_bytes, &skip);
- break;
- }
+ SOURCE is encoded. If CATEGORY is one of
+ coding_category_utf_16_XXXX, assume that CR and LF are encoded by
+ two-byte, else they are encoded by one-byte.
- if (coding->heading_ascii > skip)
- coding->heading_ascii = skip;
- else
- skip = coding->heading_ascii;
+ Return one of EOL_SEEN_XXX. */
- if (eol_type == CODING_EOL_UNDECIDED)
- return;
- if (eol_type == CODING_EOL_INCONSISTENT)
- {
-#if 0
- /* This code is suppressed until we find a better way to
- distinguish raw text file and binary file. */
+#define MAX_EOL_CHECK_COUNT 3
- /* If we have already detected that the coding is raw-text, the
- coding should actually be no-conversion. */
- if (coding->type == coding_type_raw_text)
- {
- setup_coding_system (Qno_conversion, coding);
- return;
- }
- /* Else, let's decode only text code anyway. */
-#endif /* 0 */
- eol_type = CODING_EOL_LF;
- }
+static int
+detect_eol (source, src_bytes, category)
+ const unsigned char *source;
+ EMACS_INT src_bytes;
+ enum coding_category category;
+{
+ const unsigned char *src = source, *src_end = src + src_bytes;
+ unsigned char c;
+ int total = 0;
+ int eol_seen = EOL_SEEN_NONE;
- val = Fget (coding->symbol, Qeol_type);
- if (VECTORP (val) && XVECTOR (val)->size == 3)
+ if ((1 << category) & CATEGORY_MASK_UTF_16)
{
- int src_multibyte = coding->src_multibyte;
- int dst_multibyte = coding->dst_multibyte;
- struct composition_data *cmp_data = coding->cmp_data;
+ int msb, lsb;
- setup_coding_system (XVECTOR (val)->contents[eol_type], coding);
- coding->src_multibyte = src_multibyte;
- coding->dst_multibyte = dst_multibyte;
- coding->heading_ascii = skip;
- coding->cmp_data = cmp_data;
- }
-}
+ msb = category == (coding_category_utf_16_le
+ | coding_category_utf_16_le_nosig);
+ lsb = 1 - msb;
-#define CONVERSION_BUFFER_EXTRA_ROOM 256
+ while (src + 1 < src_end)
+ {
+ c = src[lsb];
+ if (src[msb] == 0 && (c == '\n' || c == '\r'))
+ {
+ int this_eol;
+
+ if (c == '\n')
+ this_eol = EOL_SEEN_LF;
+ else if (src + 3 >= src_end
+ || src[msb + 2] != 0
+ || src[lsb + 2] != '\n')
+ this_eol = EOL_SEEN_CR;
+ else
+ this_eol = EOL_SEEN_CRLF;
-#define DECODING_BUFFER_MAG(coding) \
- (coding->type == coding_type_iso2022 \
- ? 3 \
- : (coding->type == coding_type_ccl \
- ? coding->spec.ccl.decoder.buf_magnification \
- : 2))
+ if (eol_seen == EOL_SEEN_NONE)
+ /* This is the first end-of-line. */
+ eol_seen = this_eol;
+ else if (eol_seen != this_eol)
+ {
+ /* The found type is different from what found before. */
+ eol_seen = EOL_SEEN_LF;
+ break;
+ }
+ if (++total == MAX_EOL_CHECK_COUNT)
+ break;
+ }
+ src += 2;
+ }
+ }
+ else
+ {
+ while (src < src_end)
+ {
+ c = *src++;
+ if (c == '\n' || c == '\r')
+ {
+ int this_eol;
-/* Return maximum size (bytes) of a buffer enough for decoding
- SRC_BYTES of text encoded in CODING. */
+ if (c == '\n')
+ this_eol = EOL_SEEN_LF;
+ else if (src >= src_end || *src != '\n')
+ this_eol = EOL_SEEN_CR;
+ else
+ this_eol = EOL_SEEN_CRLF, src++;
-int
-decoding_buffer_size (coding, src_bytes)
- struct coding_system *coding;
- int src_bytes;
-{
- return (src_bytes * DECODING_BUFFER_MAG (coding)
- + CONVERSION_BUFFER_EXTRA_ROOM);
+ if (eol_seen == EOL_SEEN_NONE)
+ /* This is the first end-of-line. */
+ eol_seen = this_eol;
+ else if (eol_seen != this_eol)
+ {
+ /* The found type is different from what found before. */
+ eol_seen = EOL_SEEN_LF;
+ break;
+ }
+ if (++total == MAX_EOL_CHECK_COUNT)
+ break;
+ }
+ }
+ }
+ return eol_seen;
}
-/* Return maximum size (bytes) of a buffer enough for encoding
- SRC_BYTES of text to CODING. */
-int
-encoding_buffer_size (coding, src_bytes)
+static Lisp_Object
+adjust_coding_eol_type (coding, eol_seen)
struct coding_system *coding;
- int src_bytes;
+ int eol_seen;
{
- int magnification;
+ Lisp_Object eol_type;
- if (coding->type == coding_type_ccl)
+ eol_type = CODING_ID_EOL_TYPE (coding->id);
+ if (eol_seen & EOL_SEEN_LF)
{
- magnification = coding->spec.ccl.encoder.buf_magnification;
- if (coding->eol_type == CODING_EOL_CRLF)
- magnification *= 2;
+ coding->id = CODING_SYSTEM_ID (AREF (eol_type, 0));
+ eol_type = Qunix;
}
- else if (CODING_REQUIRE_ENCODING (coding))
- magnification = 3;
- else
- magnification = 1;
-
- return (src_bytes * magnification + CONVERSION_BUFFER_EXTRA_ROOM);
-}
-
-/* Working buffer for code conversion. */
-struct conversion_buffer
-{
- int size; /* size of data. */
- int on_stack; /* 1 if allocated by alloca. */
- unsigned char *data;
-};
-
-/* Allocate LEN bytes of memory for BUF (struct conversion_buffer). */
-#define allocate_conversion_buffer(buf, len) \
- do { \
- if (len < MAX_ALLOCA) \
- { \
- buf.data = (unsigned char *) alloca (len); \
- buf.on_stack = 1; \
- } \
- else \
- { \
- buf.data = (unsigned char *) xmalloc (len); \
- buf.on_stack = 0; \
- } \
- buf.size = len; \
- } while (0)
-
-/* Double the allocated memory for *BUF. */
-static void
-extend_conversion_buffer (buf)
- struct conversion_buffer *buf;
-{
- if (buf->on_stack)
+ else if (eol_seen & EOL_SEEN_CRLF)
{
- unsigned char *save = buf->data;
- buf->data = (unsigned char *) xmalloc (buf->size * 2);
- bcopy (save, buf->data, buf->size);
- buf->on_stack = 0;
+ coding->id = CODING_SYSTEM_ID (AREF (eol_type, 1));
+ eol_type = Qdos;
}
- else
+ else if (eol_seen & EOL_SEEN_CR)
{
- buf->data = (unsigned char *) xrealloc (buf->data, buf->size * 2);
+ coding->id = CODING_SYSTEM_ID (AREF (eol_type, 2));
+ eol_type = Qmac;
}
- buf->size *= 2;
+ return eol_type;
}
-/* Free the allocated memory for BUF if it is not on stack. */
-static void
-free_conversion_buffer (buf)
- struct conversion_buffer *buf;
-{
- if (!buf->on_stack)
- xfree (buf->data);
-}
+/* Detect how a text specified in CODING is encoded. If a coding
+ system is detected, update fields of CODING by the detected coding
+ system. */
-int
-ccl_coding_driver (coding, source, destination, src_bytes, dst_bytes, encodep)
+void
+detect_coding (coding)
struct coding_system *coding;
- unsigned char *source, *destination;
- int src_bytes, dst_bytes, encodep;
{
- struct ccl_program *ccl
- = encodep ? &coding->spec.ccl.encoder : &coding->spec.ccl.decoder;
- unsigned char *dst = destination;
+ const unsigned char *src, *src_end;
- ccl->suppress_error = coding->suppress_error;
- ccl->last_block = coding->mode & CODING_MODE_LAST_BLOCK;
- if (encodep)
- {
- /* On encoding, EOL format is converted within ccl_driver. For
- that, setup proper information in the structure CCL. */
- ccl->eol_type = coding->eol_type;
- if (ccl->eol_type ==CODING_EOL_UNDECIDED)
- ccl->eol_type = CODING_EOL_LF;
- ccl->cr_consumed = coding->spec.ccl.cr_carryover;
- ccl->eight_bit_control = coding->dst_multibyte;
- }
- else
- ccl->eight_bit_control = 1;
- ccl->multibyte = coding->src_multibyte;
- if (coding->spec.ccl.eight_bit_carryover[0] != 0)
- {
- /* Move carryover bytes to DESTINATION. */
- unsigned char *p = coding->spec.ccl.eight_bit_carryover;
- while (*p)
- *dst++ = *p++;
- coding->spec.ccl.eight_bit_carryover[0] = 0;
- if (dst_bytes)
- dst_bytes -= dst - destination;
- }
+ coding->consumed = coding->consumed_char = 0;
+ coding->produced = coding->produced_char = 0;
+ coding_set_source (coding);
- coding->produced = (ccl_driver (ccl, source, dst, src_bytes, dst_bytes,
- &(coding->consumed))
- + dst - destination);
+ src_end = coding->source + coding->src_bytes;
- if (encodep)
- {
- coding->produced_char = coding->produced;
- coding->spec.ccl.cr_carryover = ccl->cr_consumed;
- }
- else if (!ccl->eight_bit_control)
- {
- /* The produced bytes forms a valid multibyte sequence. */
- coding->produced_char
- = multibyte_chars_in_text (destination, coding->produced);
- coding->spec.ccl.eight_bit_carryover[0] = 0;
- }
- else
+ /* If we have not yet decided the text encoding type, detect it
+ now. */
+ if (EQ (CODING_ATTR_TYPE (CODING_ID_ATTRS (coding->id)), Qundecided))
{
- /* On decoding, the destination should always multibyte. But,
- CCL program might have been generated an invalid multibyte
- sequence. Here we make such a sequence valid as
- multibyte. */
- int bytes
- = dst_bytes ? dst_bytes : source + coding->consumed - destination;
-
- if ((coding->consumed < src_bytes
- || !ccl->last_block)
- && coding->produced >= 1
- && destination[coding->produced - 1] >= 0x80)
- {
- /* We should not convert the tailing 8-bit codes to
- multibyte form even if they doesn't form a valid
- multibyte sequence. They may form a valid sequence in
- the next call. */
- int carryover = 0;
-
- if (destination[coding->produced - 1] < 0xA0)
- carryover = 1;
- else if (coding->produced >= 2)
+ int c, i;
+ struct coding_detection_info detect_info;
+
+ detect_info.checked = detect_info.found = detect_info.rejected = 0;
+ for (i = 0, src = coding->source; src < src_end; i++, src++)
+ {
+ c = *src;
+ if (c & 0x80)
+ break;
+ if (c < 0x20
+ && (c == ISO_CODE_ESC || c == ISO_CODE_SI || c == ISO_CODE_SO)
+ && ! inhibit_iso_escape_detection
+ && ! detect_info.checked)
{
- if (destination[coding->produced - 2] >= 0x80)
+ coding->head_ascii = src - (coding->source + coding->consumed);
+ if (detect_coding_iso_2022 (coding, &detect_info))
{
- if (destination[coding->produced - 2] < 0xA0)
- carryover = 2;
- else if (coding->produced >= 3
- && destination[coding->produced - 3] >= 0x80
- && destination[coding->produced - 3] < 0xA0)
- carryover = 3;
+ /* We have scanned the whole data. */
+ if (! (detect_info.rejected & CATEGORY_MASK_ISO_7_ELSE))
+ /* We didn't find an 8-bit code. */
+ src = src_end;
+ break;
}
}
- if (carryover > 0)
- {
- BCOPY_SHORT (destination + coding->produced - carryover,
- coding->spec.ccl.eight_bit_carryover,
- carryover);
- coding->spec.ccl.eight_bit_carryover[carryover] = 0;
- coding->produced -= carryover;
- }
}
- coding->produced = str_as_multibyte (destination, bytes,
- coding->produced,
- &(coding->produced_char));
- }
+ coding->head_ascii = src - (coding->source + coding->consumed);
+
+ if (coding->head_ascii < coding->src_bytes
+ || detect_info.found)
+ {
+ enum coding_category category;
+ struct coding_system *this;
- switch (ccl->status)
+ if (coding->head_ascii == coding->src_bytes)
+ /* As all bytes are 7-bit, we can ignore non-ISO-2022 codings. */
+ for (i = 0; i < coding_category_raw_text; i++)
+ {
+ category = coding_priorities[i];
+ this = coding_categories + category;
+ if (detect_info.found & (1 << category))
+ break;
+ }
+ else
+ for (i = 0; i < coding_category_raw_text; i++)
+ {
+ category = coding_priorities[i];
+ this = coding_categories + category;
+ if (this->id < 0)
+ {
+ /* No coding system of this category is defined. */
+ detect_info.rejected |= (1 << category);
+ }
+ else if (category >= coding_category_raw_text)
+ continue;
+ else if (detect_info.checked & (1 << category))
+ {
+ if (detect_info.found & (1 << category))
+ break;
+ }
+ else if ((*(this->detector)) (coding, &detect_info)
+ && detect_info.found & (1 << category))
+ {
+ if (category == coding_category_utf_16_auto)
+ {
+ if (detect_info.found & CATEGORY_MASK_UTF_16_LE)
+ category = coding_category_utf_16_le;
+ else
+ category = coding_category_utf_16_be;
+ }
+ break;
+ }
+ }
+
+ if (i < coding_category_raw_text)
+ setup_coding_system (CODING_ID_NAME (this->id), coding);
+ else if (detect_info.rejected == CATEGORY_MASK_ANY)
+ setup_coding_system (Qraw_text, coding);
+ else if (detect_info.rejected)
+ for (i = 0; i < coding_category_raw_text; i++)
+ if (! (detect_info.rejected & (1 << coding_priorities[i])))
+ {
+ this = coding_categories + coding_priorities[i];
+ setup_coding_system (CODING_ID_NAME (this->id), coding);
+ break;
+ }
+ }
+ }
+ else if (XINT (CODING_ATTR_CATEGORY (CODING_ID_ATTRS (coding->id)))
+ == coding_category_utf_16_auto)
{
- case CCL_STAT_SUSPEND_BY_SRC:
- coding->result = CODING_FINISH_INSUFFICIENT_SRC;
- break;
- case CCL_STAT_SUSPEND_BY_DST:
- coding->result = CODING_FINISH_INSUFFICIENT_DST;
- break;
- case CCL_STAT_QUIT:
- case CCL_STAT_INVALID_CMD:
- coding->result = CODING_FINISH_INTERRUPT;
- break;
- default:
- coding->result = CODING_FINISH_NORMAL;
- break;
+ Lisp_Object coding_systems;
+ struct coding_detection_info detect_info;
+
+ coding_systems
+ = AREF (CODING_ID_ATTRS (coding->id), coding_attr_utf_16_bom);
+ detect_info.found = detect_info.rejected = 0;
+ if (CONSP (coding_systems)
+ && detect_coding_utf_16 (coding, &detect_info))
+ {
+ if (detect_info.found & CATEGORY_MASK_UTF_16_LE)
+ setup_coding_system (XCAR (coding_systems), coding);
+ else if (detect_info.found & CATEGORY_MASK_UTF_16_BE)
+ setup_coding_system (XCDR (coding_systems), coding);
+ }
}
- return coding->result;
}
-/* Decode EOL format of the text at PTR of BYTES length destructively
- according to CODING->eol_type. This is called after the CCL
- program produced a decoded text at PTR. If we do CRLF->LF
- conversion, update CODING->produced and CODING->produced_char. */
static void
-decode_eol_post_ccl (coding, ptr, bytes)
+decode_eol (coding)
struct coding_system *coding;
- unsigned char *ptr;
- int bytes;
{
- Lisp_Object val, saved_coding_symbol;
- unsigned char *pend = ptr + bytes;
- int dummy;
-
- /* Remember the current coding system symbol. We set it back when
- an inconsistent EOL is found so that `last-coding-system-used' is
- set to the coding system that doesn't specify EOL conversion. */
- saved_coding_symbol = coding->symbol;
+ Lisp_Object eol_type;
+ unsigned char *p, *pbeg, *pend;
+
+ eol_type = CODING_ID_EOL_TYPE (coding->id);
+ if (EQ (eol_type, Qunix))
+ return;
- coding->spec.ccl.cr_carryover = 0;
- if (coding->eol_type == CODING_EOL_UNDECIDED)
- {
- /* Here, to avoid the call of setup_coding_system, we directly
- call detect_eol_type. */
- coding->eol_type = detect_eol_type (ptr, bytes, &dummy);
- if (coding->eol_type == CODING_EOL_INCONSISTENT)
- coding->eol_type = CODING_EOL_LF;
- if (coding->eol_type != CODING_EOL_UNDECIDED)
- {
- val = Fget (coding->symbol, Qeol_type);
- if (VECTORP (val) && XVECTOR (val)->size == 3)
- coding->symbol = XVECTOR (val)->contents[coding->eol_type];
- }
- coding->mode |= CODING_MODE_INHIBIT_INCONSISTENT_EOL;
- }
+ if (NILP (coding->dst_object))
+ pbeg = coding->destination;
+ else
+ pbeg = BYTE_POS_ADDR (coding->dst_pos_byte);
+ pend = pbeg + coding->produced;
- if (coding->eol_type == CODING_EOL_LF
- || coding->eol_type == CODING_EOL_UNDECIDED)
- {
- /* We have nothing to do. */
- ptr = pend;
- }
- else if (coding->eol_type == CODING_EOL_CRLF)
+ if (VECTORP (eol_type))
{
- unsigned char *pstart = ptr, *p = ptr;
+ int eol_seen = EOL_SEEN_NONE;
- if (! (coding->mode & CODING_MODE_LAST_BLOCK)
- && *(pend - 1) == '\r')
- {
- /* If the last character is CR, we can't handle it here
- because LF will be in the not-yet-decoded source text.
- Record that the CR is not yet processed. */
- coding->spec.ccl.cr_carryover = 1;
- coding->produced--;
- coding->produced_char--;
- pend--;
- }
- while (ptr < pend)
+ for (p = pbeg; p < pend; p++)
{
- if (*ptr == '\r')
+ if (*p == '\n')
+ eol_seen |= EOL_SEEN_LF;
+ else if (*p == '\r')
{
- if (ptr + 1 < pend && *(ptr + 1) == '\n')
- {
- *p++ = '\n';
- ptr += 2;
- }
- else
+ if (p + 1 < pend && *(p + 1) == '\n')
{
- if (coding->mode & CODING_MODE_INHIBIT_INCONSISTENT_EOL)
- goto undo_eol_conversion;
- *p++ = *ptr++;
+ eol_seen |= EOL_SEEN_CRLF;
+ p++;
}
- }
- else if (*ptr == '\n'
- && coding->mode & CODING_MODE_INHIBIT_INCONSISTENT_EOL)
- goto undo_eol_conversion;
- else
- *p++ = *ptr++;
- continue;
-
- undo_eol_conversion:
- /* We have faced with inconsistent EOL format at PTR.
- Convert all LFs before PTR back to CRLFs. */
- for (p--, ptr--; p >= pstart; p--)
- {
- if (*p == '\n')
- *ptr-- = '\n', *ptr-- = '\r';
else
- *ptr-- = *p;
- }
- /* If carryover is recorded, cancel it because we don't
- convert CRLF anymore. */
- if (coding->spec.ccl.cr_carryover)
- {
- coding->spec.ccl.cr_carryover = 0;
- coding->produced++;
- coding->produced_char++;
- pend++;
+ eol_seen |= EOL_SEEN_CR;
}
- p = ptr = pend;
- coding->eol_type = CODING_EOL_LF;
- coding->symbol = saved_coding_symbol;
- }
- if (p < pend)
- {
- /* As each two-byte sequence CRLF was converted to LF, (PEND
- - P) is the number of deleted characters. */
- coding->produced -= pend - p;
- coding->produced_char -= pend - p;
}
+ if (eol_seen != EOL_SEEN_NONE
+ && eol_seen != EOL_SEEN_LF
+ && eol_seen != EOL_SEEN_CRLF
+ && eol_seen != EOL_SEEN_CR)
+ eol_seen = EOL_SEEN_LF;
+ if (eol_seen != EOL_SEEN_NONE)
+ eol_type = adjust_coding_eol_type (coding, eol_seen);
+ }
+
+ if (EQ (eol_type, Qmac))
+ {
+ for (p = pbeg; p < pend; p++)
+ if (*p == '\r')
+ *p = '\n';
}
- else /* i.e. coding->eol_type == CODING_EOL_CR */
+ else if (EQ (eol_type, Qdos))
{
- unsigned char *p = ptr;
+ int n = 0;
- for (; ptr < pend; ptr++)
+ if (NILP (coding->dst_object))
+ {
+ /* Start deleting '\r' from the tail to minimize the memory
+ movement. */
+ for (p = pend - 2; p >= pbeg; p--)
+ if (*p == '\r')
+ {
+ safe_bcopy ((char *) (p + 1), (char *) p, pend-- - p - 1);
+ n++;
+ }
+ }
+ else
{
- if (*ptr == '\r')
- *ptr = '\n';
- else if (*ptr == '\n'
- && coding->mode & CODING_MODE_INHIBIT_INCONSISTENT_EOL)
+ int pos_byte = coding->dst_pos_byte;
+ int pos = coding->dst_pos;
+ int pos_end = pos + coding->produced_char - 1;
+
+ while (pos < pos_end)
{
- for (; p < ptr; p++)
+ p = BYTE_POS_ADDR (pos_byte);
+ if (*p == '\r' && p[1] == '\n')
{
- if (*p == '\n')
- *p = '\r';
+ del_range_2 (pos, pos_byte, pos + 1, pos_byte + 1, 0);
+ n++;
+ pos_end--;
}
- ptr = pend;
- coding->eol_type = CODING_EOL_LF;
- coding->symbol = saved_coding_symbol;
+ pos++;
+ pos_byte += BYTES_BY_CHAR_HEAD (*p);
}
}
+ coding->produced -= n;
+ coding->produced_char -= n;
}
}
-/* See "GENERAL NOTES about `decode_coding_XXX ()' functions". Before
- decoding, it may detect coding system and format of end-of-line if
- those are not yet decided. The source should be unibyte, the
- result is multibyte if CODING->dst_multibyte is nonzero, else
- unibyte. */
-
-int
-decode_coding (coding, source, destination, src_bytes, dst_bytes)
- struct coding_system *coding;
- const unsigned char *source;
- unsigned char *destination;
- int src_bytes, dst_bytes;
-{
- int extra = 0;
-
- if (coding->type == coding_type_undecided)
- detect_coding (coding, source, src_bytes);
- if (coding->eol_type == CODING_EOL_UNDECIDED
- && coding->type != coding_type_ccl)
- {
- detect_eol (coding, source, src_bytes);
- /* We had better recover the original eol format if we
- encounter an inconsistent eol format while decoding. */
- coding->mode |= CODING_MODE_INHIBIT_INCONSISTENT_EOL;
- }
+/* Return a translation table (or list of them) from coding system
+ attribute vector ATTRS for encoding (ENCODEP is nonzero) or
+ decoding (ENCODEP is zero). */
- coding->produced = coding->produced_char = 0;
- coding->consumed = coding->consumed_char = 0;
- coding->errors = 0;
- coding->result = CODING_FINISH_NORMAL;
+static Lisp_Object
+get_translation_table (attrs, encodep, max_lookup)
+ Lisp_Object attrs;
+ int encodep, *max_lookup;
+{
+ Lisp_Object standard, translation_table;
+ Lisp_Object val;
- switch (coding->type)
+ if (encodep)
+ translation_table = CODING_ATTR_ENCODE_TBL (attrs),
+ standard = Vstandard_translation_table_for_encode;
+ else
+ translation_table = CODING_ATTR_DECODE_TBL (attrs),
+ standard = Vstandard_translation_table_for_decode;
+ if (NILP (translation_table))
+ translation_table = standard;
+ else
{
- case coding_type_sjis:
- decode_coding_sjis_big5 (coding, source, destination,
- src_bytes, dst_bytes, 1);
- break;
-
- case coding_type_iso2022:
- decode_coding_iso2022 (coding, source, destination,
- src_bytes, dst_bytes);
- break;
-
- case coding_type_big5:
- decode_coding_sjis_big5 (coding, source, destination,
- src_bytes, dst_bytes, 0);
- break;
-
- case coding_type_emacs_mule:
- decode_coding_emacs_mule (coding, source, destination,
- src_bytes, dst_bytes);
- break;
-
- case coding_type_ccl:
- if (coding->spec.ccl.cr_carryover)
+ if (SYMBOLP (translation_table))
+ translation_table = Fget (translation_table, Qtranslation_table);
+ else if (CONSP (translation_table))
{
- /* Put the CR which was not processed by the previous call
- of decode_eol_post_ccl in DESTINATION. It will be
- decoded together with the following LF by the call to
- decode_eol_post_ccl below. */
- *destination = '\r';
- coding->produced++;
- coding->produced_char++;
- dst_bytes--;
- extra = coding->spec.ccl.cr_carryover;
+ translation_table = Fcopy_sequence (translation_table);
+ for (val = translation_table; CONSP (val); val = XCDR (val))
+ if (SYMBOLP (XCAR (val)))
+ XSETCAR (val, Fget (XCAR (val), Qtranslation_table));
}
- ccl_coding_driver (coding, source, destination + extra,
- src_bytes, dst_bytes, 0);
- if (coding->eol_type != CODING_EOL_LF)
+ if (CHAR_TABLE_P (standard))
{
- coding->produced += extra;
- coding->produced_char += extra;
- decode_eol_post_ccl (coding, destination, coding->produced);
+ if (CONSP (translation_table))
+ translation_table = nconc2 (translation_table,
+ Fcons (standard, Qnil));
+ else
+ translation_table = Fcons (translation_table,
+ Fcons (standard, Qnil));
}
- break;
-
- default:
- decode_eol (coding, source, destination, src_bytes, dst_bytes);
}
- if (coding->result == CODING_FINISH_INSUFFICIENT_SRC
- && coding->mode & CODING_MODE_LAST_BLOCK
- && coding->consumed == src_bytes)
- coding->result = CODING_FINISH_NORMAL;
-
- if (coding->mode & CODING_MODE_LAST_BLOCK
- && coding->result == CODING_FINISH_INSUFFICIENT_SRC)
+ if (max_lookup)
{
- const unsigned char *src = source + coding->consumed;
- unsigned char *dst = destination + coding->produced;
-
- src_bytes -= coding->consumed;
- coding->errors++;
- if (COMPOSING_P (coding))
- DECODE_COMPOSITION_END ('1');
- while (src_bytes--)
+ *max_lookup = 1;
+ if (CHAR_TABLE_P (translation_table)
+ && CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (translation_table)) > 1)
{
- int c = *src++;
- dst += CHAR_STRING (c, dst);
- coding->produced_char++;
+ val = XCHAR_TABLE (translation_table)->extras[1];
+ if (NATNUMP (val) && *max_lookup < XFASTINT (val))
+ *max_lookup = XFASTINT (val);
}
- coding->consumed = coding->consumed_char = src - source;
- coding->produced = dst - destination;
- coding->result = CODING_FINISH_NORMAL;
- }
+ else if (CONSP (translation_table))
+ {
+ Lisp_Object tail, val;
- if (!coding->dst_multibyte)
- {
- coding->produced = str_as_unibyte (destination, coding->produced);
- coding->produced_char = coding->produced;
+ for (tail = translation_table; CONSP (tail); tail = XCDR (tail))
+ if (CHAR_TABLE_P (XCAR (tail))
+ && CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (XCAR (tail))) > 1)
+ {
+ val = XCHAR_TABLE (XCAR (tail))->extras[1];
+ if (NATNUMP (val) && *max_lookup < XFASTINT (val))
+ *max_lookup = XFASTINT (val);
+ }
+ }
}
-
- return coding->result;
+ return translation_table;
}
-/* See "GENERAL NOTES about `encode_coding_XXX ()' functions". The
- multibyteness of the source is CODING->src_multibyte, the
- multibyteness of the result is always unibyte. */
-
-int
-encode_coding (coding, source, destination, src_bytes, dst_bytes)
- struct coding_system *coding;
- const unsigned char *source;
- unsigned char *destination;
- int src_bytes, dst_bytes;
-{
- coding->produced = coding->produced_char = 0;
- coding->consumed = coding->consumed_char = 0;
- coding->errors = 0;
- coding->result = CODING_FINISH_NORMAL;
- if (coding->eol_type == CODING_EOL_UNDECIDED)
- coding->eol_type = CODING_EOL_LF;
-
- switch (coding->type)
- {
- case coding_type_sjis:
- encode_coding_sjis_big5 (coding, source, destination,
- src_bytes, dst_bytes, 1);
- break;
-
- case coding_type_iso2022:
- encode_coding_iso2022 (coding, source, destination,
- src_bytes, dst_bytes);
- break;
-
- case coding_type_big5:
- encode_coding_sjis_big5 (coding, source, destination,
- src_bytes, dst_bytes, 0);
- break;
-
- case coding_type_emacs_mule:
- encode_coding_emacs_mule (coding, source, destination,
- src_bytes, dst_bytes);
- break;
-
- case coding_type_ccl:
- ccl_coding_driver (coding, source, destination,
- src_bytes, dst_bytes, 1);
- break;
+#define LOOKUP_TRANSLATION_TABLE(table, c, trans) \
+ do { \
+ trans = Qnil; \
+ if (CHAR_TABLE_P (table)) \
+ { \
+ trans = CHAR_TABLE_REF (table, c); \
+ if (CHARACTERP (trans)) \
+ c = XFASTINT (trans), trans = Qnil; \
+ } \
+ else if (CONSP (table)) \
+ { \
+ Lisp_Object tail; \
+ \
+ for (tail = table; CONSP (tail); tail = XCDR (tail)) \
+ if (CHAR_TABLE_P (XCAR (tail))) \
+ { \
+ trans = CHAR_TABLE_REF (XCAR (tail), c); \
+ if (CHARACTERP (trans)) \
+ c = XFASTINT (trans), trans = Qnil; \
+ else if (! NILP (trans)) \
+ break; \
+ } \
+ } \
+ } while (0)
- default:
- encode_eol (coding, source, destination, src_bytes, dst_bytes);
- }
- if (coding->mode & CODING_MODE_LAST_BLOCK
- && coding->result == CODING_FINISH_INSUFFICIENT_SRC)
+static Lisp_Object
+get_translation (val, buf, buf_end, last_block, from_nchars, to_nchars)
+ Lisp_Object val;
+ int *buf, *buf_end;
+ int last_block;
+ int *from_nchars, *to_nchars;
+{
+ /* VAL is TO or (([FROM-CHAR ...] . TO) ...) where TO is TO-CHAR or
+ [TO-CHAR ...]. */
+ if (CONSP (val))
{
- const unsigned char *src = source + coding->consumed;
- unsigned char *dst = destination + coding->produced;
+ Lisp_Object from, tail;
+ int i, len;
- if (coding->type == coding_type_iso2022)
- ENCODE_RESET_PLANE_AND_REGISTER;
- if (COMPOSING_P (coding))
- *dst++ = ISO_CODE_ESC, *dst++ = '1';
- if (coding->consumed < src_bytes)
+ for (tail = val; CONSP (tail); tail = XCDR (tail))
{
- int len = src_bytes - coding->consumed;
-
- BCOPY_SHORT (src, dst, len);
- if (coding->src_multibyte)
- len = str_as_unibyte (dst, len);
- dst += len;
- coding->consumed = src_bytes;
+ val = XCAR (tail);
+ from = XCAR (val);
+ len = ASIZE (from);
+ for (i = 0; i < len; i++)
+ {
+ if (buf + i == buf_end)
+ {
+ if (! last_block)
+ return Qt;
+ break;
+ }
+ if (XINT (AREF (from, i)) != buf[i])
+ break;
+ }
+ if (i == len)
+ {
+ val = XCDR (val);
+ *from_nchars = len;
+ break;
+ }
}
- coding->produced = coding->produced_char = dst - destination;
- coding->result = CODING_FINISH_NORMAL;
+ if (! CONSP (tail))
+ return Qnil;
}
-
- if (coding->result == CODING_FINISH_INSUFFICIENT_SRC
- && coding->consumed == src_bytes)
- coding->result = CODING_FINISH_NORMAL;
-
- return coding->result;
+ if (VECTORP (val))
+ *buf = XINT (AREF (val, 0)), *to_nchars = ASIZE (val);
+ else
+ *buf = XINT (val);
+ return val;
}
-/* Scan text in the region between *BEG and *END (byte positions),
- skip characters which we don't have to decode by coding system
- CODING at the head and tail, then set *BEG and *END to the region
- of the text we actually have to convert. The caller should move
- the gap out of the region in advance if the region is from a
- buffer.
-
- If STR is not NULL, *BEG and *END are indices into STR. */
-static void
-shrink_decoding_region (beg, end, coding, str)
- int *beg, *end;
+static int
+produce_chars (coding, translation_table, last_block)
struct coding_system *coding;
- unsigned char *str;
+ Lisp_Object translation_table;
+ int last_block;
{
- unsigned char *begp_orig, *begp, *endp_orig, *endp, c;
- int eol_conversion;
- Lisp_Object translation_table;
+ unsigned char *dst = coding->destination + coding->produced;
+ unsigned char *dst_end = coding->destination + coding->dst_bytes;
+ int produced;
+ int produced_chars = 0;
+ int carryover = 0;
- if (coding->type == coding_type_ccl
- || coding->type == coding_type_undecided
- || coding->eol_type != CODING_EOL_LF
- || !NILP (coding->post_read_conversion)
- || coding->composing != COMPOSITION_DISABLED)
+ if (! coding->chars_at_source)
{
- /* We can't skip any data. */
- return;
- }
- if (coding->type == coding_type_no_conversion
- || coding->type == coding_type_raw_text
- || coding->type == coding_type_emacs_mule)
- {
- /* We need no conversion, but don't have to skip any data here.
- Decoding routine handles them effectively anyway. */
- return;
- }
+ /* Characters are in coding->charbuf. */
+ int *buf = coding->charbuf;
+ int *buf_end = buf + coding->charbuf_used;
+
+ if (BUFFERP (coding->src_object)
+ && EQ (coding->src_object, coding->dst_object))
+ dst_end = ((unsigned char *) coding->source) + coding->consumed;
+
+ while (buf < buf_end)
+ {
+ int c = *buf, i;
+
+ if (c >= 0)
+ {
+ int from_nchars = 1, to_nchars = 1;
+ Lisp_Object trans = Qnil;
- translation_table = coding->translation_table_for_decode;
- if (NILP (translation_table) && !NILP (Venable_character_translation))
- translation_table = Vstandard_translation_table_for_decode;
- if (CHAR_TABLE_P (translation_table))
- {
- int i;
- for (i = 0; i < 128; i++)
- if (!NILP (CHAR_TABLE_REF (translation_table, i)))
- break;
- if (i < 128)
- /* Some ASCII character should be translated. We give up
- shrinking. */
- return;
- }
+ LOOKUP_TRANSLATION_TABLE (translation_table, c, trans);
+ if (! NILP (trans))
+ {
+ trans = get_translation (trans, buf, buf_end, last_block,
+ &from_nchars, &to_nchars);
+ if (EQ (trans, Qt))
+ break;
+ c = *buf;
+ }
- if (coding->heading_ascii >= 0)
- /* Detection routine has already found how much we can skip at the
- head. */
- *beg += coding->heading_ascii;
+ if (dst + MAX_MULTIBYTE_LENGTH * to_nchars > dst_end)
+ {
+ dst = alloc_destination (coding,
+ buf_end - buf
+ + MAX_MULTIBYTE_LENGTH * to_nchars,
+ dst);
+ dst_end = coding->destination + coding->dst_bytes;
+ }
- if (str)
- {
- begp_orig = begp = str + *beg;
- endp_orig = endp = str + *end;
+ for (i = 0; i < to_nchars; i++)
+ {
+ if (i > 0)
+ c = XINT (AREF (trans, i));
+ if (coding->dst_multibyte
+ || ! CHAR_BYTE8_P (c))
+ CHAR_STRING_ADVANCE (c, dst);
+ else
+ *dst++ = CHAR_TO_BYTE8 (c);
+ }
+ produced_chars += to_nchars;
+ *buf++ = to_nchars;
+ while (--from_nchars > 0)
+ *buf++ = 0;
+ }
+ else
+ /* This is an annotation datum. (-C) is the length. */
+ buf += -c;
+ }
+ carryover = buf_end - buf;
}
else
{
- begp_orig = begp = BYTE_POS_ADDR (*beg);
- endp_orig = endp = begp + *end - *beg;
- }
+ const unsigned char *src = coding->source;
+ const unsigned char *src_end = src + coding->src_bytes;
+ Lisp_Object eol_type;
- eol_conversion = (coding->eol_type == CODING_EOL_CR
- || coding->eol_type == CODING_EOL_CRLF);
+ eol_type = CODING_ID_EOL_TYPE (coding->id);
- switch (coding->type)
- {
- case coding_type_sjis:
- case coding_type_big5:
- /* We can skip all ASCII characters at the head. */
- if (coding->heading_ascii < 0)
+ if (coding->src_multibyte != coding->dst_multibyte)
{
- if (eol_conversion)
- while (begp < endp && *begp < 0x80 && *begp != '\r') begp++;
- else
- while (begp < endp && *begp < 0x80) begp++;
- }
- /* We can skip all ASCII characters at the tail except for the
- second byte of SJIS or BIG5 code. */
- if (eol_conversion)
- while (begp < endp && endp[-1] < 0x80 && endp[-1] != '\r') endp--;
- else
- while (begp < endp && endp[-1] < 0x80) endp--;
- /* Do not consider LF as ascii if preceded by CR, since that
- confuses eol decoding. */
- if (begp < endp && endp < endp_orig && endp[-1] == '\r' && endp[0] == '\n')
- endp++;
- if (begp < endp && endp < endp_orig && endp[-1] >= 0x80)
- endp++;
- break;
+ if (coding->src_multibyte)
+ {
+ int multibytep = 1;
+ int consumed_chars;
- case coding_type_iso2022:
- if (CODING_SPEC_ISO_INITIAL_DESIGNATION (coding, 0) != CHARSET_ASCII)
- /* We can't skip any data. */
- break;
- if (coding->heading_ascii < 0)
- {
- /* We can skip all ASCII characters at the head except for a
- few control codes. */
- while (begp < endp && (c = *begp) < 0x80
- && c != ISO_CODE_CR && c != ISO_CODE_SO
- && c != ISO_CODE_SI && c != ISO_CODE_ESC
- && (!eol_conversion || c != ISO_CODE_LF))
- begp++;
- }
- switch (coding->category_idx)
- {
- case CODING_CATEGORY_IDX_ISO_8_1:
- case CODING_CATEGORY_IDX_ISO_8_2:
- /* We can skip all ASCII characters at the tail. */
- if (eol_conversion)
- while (begp < endp && (c = endp[-1]) < 0x80 && c != '\r') endp--;
+ while (1)
+ {
+ const unsigned char *src_base = src;
+ int c;
+
+ ONE_MORE_BYTE (c);
+ if (c == '\r')
+ {
+ if (EQ (eol_type, Qdos))
+ {
+ if (src == src_end)
+ {
+ record_conversion_result
+ (coding, CODING_RESULT_INSUFFICIENT_SRC);
+ goto no_more_source;
+ }
+ if (*src == '\n')
+ c = *src++;
+ }
+ else if (EQ (eol_type, Qmac))
+ c = '\n';
+ }
+ if (dst == dst_end)
+ {
+ coding->consumed = src - coding->source;
+
+ if (EQ (coding->src_object, coding->dst_object))
+ dst_end = (unsigned char *) src;
+ if (dst == dst_end)
+ {
+ dst = alloc_destination (coding, src_end - src + 1,
+ dst);
+ dst_end = coding->destination + coding->dst_bytes;
+ coding_set_source (coding);
+ src = coding->source + coding->consumed;
+ src_end = coding->source + coding->src_bytes;
+ }
+ }
+ *dst++ = c;
+ produced_chars++;
+ }
+ no_more_source:
+ ;
+ }
else
- while (begp < endp && endp[-1] < 0x80) endp--;
- /* Do not consider LF as ascii if preceded by CR, since that
- confuses eol decoding. */
- if (begp < endp && endp < endp_orig && endp[-1] == '\r' && endp[0] == '\n')
- endp++;
- break;
+ while (src < src_end)
+ {
+ int multibytep = 1;
+ int c = *src++;
- case CODING_CATEGORY_IDX_ISO_7:
- case CODING_CATEGORY_IDX_ISO_7_TIGHT:
- {
- /* We can skip all characters at the tail except for 8-bit
- codes and ESC and the following 2-byte at the tail. */
- unsigned char *eight_bit = NULL;
+ if (c == '\r')
+ {
+ if (EQ (eol_type, Qdos))
+ {
+ if (src < src_end
+ && *src == '\n')
+ c = *src++;
+ }
+ else if (EQ (eol_type, Qmac))
+ c = '\n';
+ }
+ if (dst >= dst_end - 1)
+ {
+ coding->consumed = src - coding->source;
+
+ if (EQ (coding->src_object, coding->dst_object))
+ dst_end = (unsigned char *) src;
+ if (dst >= dst_end - 1)
+ {
+ dst = alloc_destination (coding, src_end - src + 2,
+ dst);
+ dst_end = coding->destination + coding->dst_bytes;
+ coding_set_source (coding);
+ src = coding->source + coding->consumed;
+ src_end = coding->source + coding->src_bytes;
+ }
+ }
+ EMIT_ONE_BYTE (c);
+ }
+ }
+ else
+ {
+ if (!EQ (coding->src_object, coding->dst_object))
+ {
+ int require = coding->src_bytes - coding->dst_bytes;
- if (eol_conversion)
- while (begp < endp
- && (c = endp[-1]) != ISO_CODE_ESC && c != '\r')
+ if (require > 0)
{
- if (!eight_bit && c & 0x80) eight_bit = endp;
- endp--;
+ EMACS_INT offset = src - coding->source;
+
+ dst = alloc_destination (coding, require, dst);
+ coding_set_source (coding);
+ src = coding->source + offset;
+ src_end = coding->source + coding->src_bytes;
}
- else
- while (begp < endp
- && (c = endp[-1]) != ISO_CODE_ESC)
+ }
+ produced_chars = coding->src_chars;
+ while (src < src_end)
+ {
+ int c = *src++;
+
+ if (c == '\r')
{
- if (!eight_bit && c & 0x80) eight_bit = endp;
- endp--;
+ if (EQ (eol_type, Qdos))
+ {
+ if (src < src_end
+ && *src == '\n')
+ c = *src++;
+ produced_chars--;
+ }
+ else if (EQ (eol_type, Qmac))
+ c = '\n';
}
- /* Do not consider LF as ascii if preceded by CR, since that
- confuses eol decoding. */
- if (begp < endp && endp < endp_orig
- && endp[-1] == '\r' && endp[0] == '\n')
- endp++;
- if (begp < endp && endp[-1] == ISO_CODE_ESC)
- {
- if (endp + 1 < endp_orig && end[0] == '(' && end[1] == 'B')
- /* This is an ASCII designation sequence. We can
- surely skip the tail. But, if we have
- encountered an 8-bit code, skip only the codes
- after that. */
- endp = eight_bit ? eight_bit : endp + 2;
- else
- /* Hmmm, we can't skip the tail. */
- endp = endp_orig;
- }
- else if (eight_bit)
- endp = eight_bit;
- }
+ *dst++ = c;
+ }
}
- break;
-
- default:
- abort ();
+ coding->consumed = coding->src_bytes;
+ coding->consumed_char = coding->src_chars;
}
- *beg += begp - begp_orig;
- *end += endp - endp_orig;
- return;
+
+ produced = dst - (coding->destination + coding->produced);
+ if (BUFFERP (coding->dst_object) && produced_chars > 0)
+ insert_from_gap (produced_chars, produced);
+ coding->produced += produced;
+ coding->produced_char += produced_chars;
+ return carryover;
}
-/* Like shrink_decoding_region but for encoding. */
+/* Compose text in CODING->object according to the annotation data at
+ CHARBUF. CHARBUF is an array:
+ [ -LENGTH ANNOTATION_MASK FROM TO METHOD COMP_LEN [ COMPONENTS... ] ]
+ */
-static void
-shrink_encoding_region (beg, end, coding, str)
- int *beg, *end;
+static INLINE void
+produce_composition (coding, charbuf, pos)
struct coding_system *coding;
- unsigned char *str;
+ int *charbuf;
+ EMACS_INT pos;
{
- unsigned char *begp_orig, *begp, *endp_orig, *endp;
- int eol_conversion;
- Lisp_Object translation_table;
+ int len;
+ EMACS_INT to;
+ enum composition_method method;
+ Lisp_Object components;
- if (coding->type == coding_type_ccl
- || coding->eol_type == CODING_EOL_CRLF
- || coding->eol_type == CODING_EOL_CR
- || (coding->cmp_data && coding->cmp_data->used > 0))
- {
- /* We can't skip any data. */
- return;
- }
- if (coding->type == coding_type_no_conversion
- || coding->type == coding_type_raw_text
- || coding->type == coding_type_emacs_mule
- || coding->type == coding_type_undecided)
- {
- /* We need no conversion, but don't have to skip any data here.
- Encoding routine handles them effectively anyway. */
- return;
- }
+ len = -charbuf[0];
+ to = pos + charbuf[2];
+ if (to <= pos)
+ return;
+ method = (enum composition_method) (charbuf[3]);
- translation_table = coding->translation_table_for_encode;
- if (NILP (translation_table) && !NILP (Venable_character_translation))
- translation_table = Vstandard_translation_table_for_encode;
- if (CHAR_TABLE_P (translation_table))
+ if (method == COMPOSITION_RELATIVE)
+ components = Qnil;
+ else if (method >= COMPOSITION_WITH_RULE
+ && method <= COMPOSITION_WITH_RULE_ALTCHARS)
{
+ Lisp_Object args[MAX_COMPOSITION_COMPONENTS * 2 - 1];
int i;
- for (i = 0; i < 128; i++)
- if (!NILP (CHAR_TABLE_REF (translation_table, i)))
- break;
- if (i < 128)
- /* Some ASCII character should be translated. We give up
- shrinking. */
- return;
- }
- if (str)
- {
- begp_orig = begp = str + *beg;
- endp_orig = endp = str + *end;
+ len -= 4;
+ charbuf += 4;
+ for (i = 0; i < len; i++)
+ {
+ args[i] = make_number (charbuf[i]);
+ if (charbuf[i] < 0)
+ return;
+ }
+ components = (method == COMPOSITION_WITH_ALTCHARS
+ ? Fstring (len, args) : Fvector (len, args));
}
else
- {
- begp_orig = begp = BYTE_POS_ADDR (*beg);
- endp_orig = endp = begp + *end - *beg;
- }
-
- eol_conversion = (coding->eol_type == CODING_EOL_CR
- || coding->eol_type == CODING_EOL_CRLF);
+ return;
+ compose_text (pos, to, components, Qnil, coding->dst_object);
+}
- /* Here, we don't have to check coding->pre_write_conversion because
- the caller is expected to have handled it already. */
- switch (coding->type)
- {
- case coding_type_iso2022:
- if (CODING_SPEC_ISO_INITIAL_DESIGNATION (coding, 0) != CHARSET_ASCII)
- /* We can't skip any data. */
- break;
- if (coding->flags & CODING_FLAG_ISO_DESIGNATE_AT_BOL)
- {
- unsigned char *bol = begp;
- while (begp < endp && *begp < 0x80)
- {
- begp++;
- if (begp[-1] == '\n')
- bol = begp;
- }
- begp = bol;
- goto label_skip_tail;
- }
- /* fall down ... */
- case coding_type_sjis:
- case coding_type_big5:
- /* We can skip all ASCII characters at the head and tail. */
- if (eol_conversion)
- while (begp < endp && *begp < 0x80 && *begp != '\n') begp++;
- else
- while (begp < endp && *begp < 0x80) begp++;
- label_skip_tail:
- if (eol_conversion)
- while (begp < endp && endp[-1] < 0x80 && endp[-1] != '\n') endp--;
- else
- while (begp < endp && *(endp - 1) < 0x80) endp--;
- break;
+/* Put `charset' property on text in CODING->object according to
+ the annotation data at CHARBUF. CHARBUF is an array:
+ [ -LENGTH ANNOTATION_MASK NCHARS CHARSET-ID ]
+ */
- default:
- abort ();
- }
+static INLINE void
+produce_charset (coding, charbuf, pos)
+ struct coding_system *coding;
+ int *charbuf;
+ EMACS_INT pos;
+{
+ EMACS_INT from = pos - charbuf[2];
+ struct charset *charset = CHARSET_FROM_ID (charbuf[3]);
- *beg += begp - begp_orig;
- *end += endp - endp_orig;
- return;
+ Fput_text_property (make_number (from), make_number (pos),
+ Qcharset, CHARSET_NAME (charset),
+ coding->dst_object);
}
-/* As shrinking conversion region requires some overhead, we don't try
- shrinking if the length of conversion region is less than this
- value. */
-static int shrink_conversion_region_threshhold = 1024;
-#define SHRINK_CONVERSION_REGION(beg, end, coding, str, encodep) \
+#define CHARBUF_SIZE 0x4000
+
+#define ALLOC_CONVERSION_WORK_AREA(coding) \
do { \
- if (*(end) - *(beg) > shrink_conversion_region_threshhold) \
+ int size = CHARBUF_SIZE;; \
+ \
+ coding->charbuf = NULL; \
+ while (size > 1024) \
{ \
- if (encodep) shrink_encoding_region (beg, end, coding, str); \
- else shrink_decoding_region (beg, end, coding, str); \
+ coding->charbuf = (int *) alloca (sizeof (int) * size); \
+ if (coding->charbuf) \
+ break; \
+ size >>= 1; \
} \
+ if (! coding->charbuf) \
+ { \
+ record_conversion_result (coding, CODING_RESULT_INSUFFICIENT_MEM); \
+ return coding->result; \
+ } \
+ coding->charbuf_size = size; \
} while (0)
-/* ARG is (CODING BUFFER ...) where CODING is what to be set in
- Vlast_coding_system_used and the remaining elements are buffers to
- kill. */
-static Lisp_Object
-code_convert_region_unwind (arg)
- Lisp_Object arg;
-{
- struct gcpro gcpro1;
- GCPRO1 (arg);
-
- inhibit_pre_post_conversion = 0;
- Vlast_coding_system_used = XCAR (arg);
- for (arg = XCDR (arg); CONSP (arg); arg = XCDR (arg))
- Fkill_buffer (XCAR (arg));
-
- UNGCPRO;
- return Qnil;
-}
-
-/* Store information about all compositions in the range FROM and TO
- of OBJ in memory blocks pointed by CODING->cmp_data. OBJ is a
- buffer or a string, defaults to the current buffer. */
-void
-coding_save_composition (coding, from, to, obj)
+static void
+produce_annotation (coding, pos)
struct coding_system *coding;
- int from, to;
- Lisp_Object obj;
+ EMACS_INT pos;
{
- Lisp_Object prop;
- int start, end;
+ int *charbuf = coding->charbuf;
+ int *charbuf_end = charbuf + coding->charbuf_used;
- if (coding->composing == COMPOSITION_DISABLED)
- return;
- if (!coding->cmp_data)
- coding_allocate_composition_data (coding, from);
- if (!find_composition (from, to, &start, &end, &prop, obj)
- || end > to)
+ if (NILP (coding->dst_object))
return;
- if (start < from
- && (!find_composition (end, to, &start, &end, &prop, obj)
- || end > to))
- return;
- coding->composing = COMPOSITION_NO;
- do
+
+ while (charbuf < charbuf_end)
{
- if (COMPOSITION_VALID_P (start, end, prop))
+ if (*charbuf >= 0)
+ pos += *charbuf++;
+ else
{
- enum composition_method method = COMPOSITION_METHOD (prop);
- if (coding->cmp_data->used + COMPOSITION_DATA_MAX_BUNCH_LENGTH
- >= COMPOSITION_DATA_SIZE)
- coding_allocate_composition_data (coding, from);
- /* For relative composition, we remember start and end
- positions, for the other compositions, we also remember
- components. */
- CODING_ADD_COMPOSITION_START (coding, start - from, method);
- if (method != COMPOSITION_RELATIVE)
+ int len = -*charbuf;
+ switch (charbuf[1])
{
- /* We must store a*/
- Lisp_Object val, ch;
-
- val = COMPOSITION_COMPONENTS (prop);
- if (CONSP (val))
- while (CONSP (val))
- {
- ch = XCAR (val), val = XCDR (val);
- CODING_ADD_COMPOSITION_COMPONENT (coding, XINT (ch));
- }
- else if (VECTORP (val) || STRINGP (val))
- {
- int len = (VECTORP (val)
- ? XVECTOR (val)->size : SCHARS (val));
- int i;
- for (i = 0; i < len; i++)
- {
- ch = (STRINGP (val)
- ? Faref (val, make_number (i))
- : XVECTOR (val)->contents[i]);
- CODING_ADD_COMPOSITION_COMPONENT (coding, XINT (ch));
- }
- }
- else /* INTEGERP (val) */
- CODING_ADD_COMPOSITION_COMPONENT (coding, XINT (val));
+ case CODING_ANNOTATE_COMPOSITION_MASK:
+ produce_composition (coding, charbuf, pos);
+ break;
+ case CODING_ANNOTATE_CHARSET_MASK:
+ produce_charset (coding, charbuf, pos);
+ break;
+ default:
+ abort ();
}
- CODING_ADD_COMPOSITION_END (coding, end - from);
+ charbuf += len;
}
- start = end;
}
- while (start < to
- && find_composition (start, to, &start, &end, &prop, obj)
- && end <= to);
-
- /* Make coding->cmp_data point to the first memory block. */
- while (coding->cmp_data->prev)
- coding->cmp_data = coding->cmp_data->prev;
- coding->cmp_data_start = 0;
}
-/* Reflect the saved information about compositions to OBJ.
- CODING->cmp_data points to a memory block for the information. OBJ
- is a buffer or a string, defaults to the current buffer. */
+/* Decode the data at CODING->src_object into CODING->dst_object.
+ CODING->src_object is a buffer, a string, or nil.
+ CODING->dst_object is a buffer.
-void
-coding_restore_composition (coding, obj)
- struct coding_system *coding;
- Lisp_Object obj;
-{
- struct composition_data *cmp_data = coding->cmp_data;
+ If CODING->src_object is a buffer, it must be the current buffer.
+ In this case, if CODING->src_pos is positive, it is a position of
+ the source text in the buffer, otherwise, the source text is in the
+ gap area of the buffer, and CODING->src_pos specifies the offset of
+ the text from GPT (which must be the same as PT). If this is the
+ same buffer as CODING->dst_object, CODING->src_pos must be
+ negative.
- if (!cmp_data)
- return;
+ If CODING->src_object is a string, CODING->src_pos is an index to
+ that string.
- while (cmp_data->prev)
- cmp_data = cmp_data->prev;
+ If CODING->src_object is nil, CODING->source must already point to
+ the non-relocatable memory area. In this case, CODING->src_pos is
+ an offset from CODING->source.
- while (cmp_data)
- {
- int i;
+ The decoded data is inserted at the current point of the buffer
+ CODING->dst_object.
+*/
- for (i = 0; i < cmp_data->used && cmp_data->data[i] > 0;
- i += cmp_data->data[i])
- {
- int *data = cmp_data->data + i;
- enum composition_method method = (enum composition_method) data[3];
- Lisp_Object components;
+static int
+decode_coding (coding)
+ struct coding_system *coding;
+{
+ Lisp_Object attrs;
+ Lisp_Object undo_list;
+ Lisp_Object translation_table;
+ int carryover;
+ int i;
- if (data[0] < 0 || i + data[0] > cmp_data->used)
- /* Invalid composition data. */
- break;
+ if (BUFFERP (coding->src_object)
+ && coding->src_pos > 0
+ && coding->src_pos < GPT
+ && coding->src_pos + coding->src_chars > GPT)
+ move_gap_both (coding->src_pos, coding->src_pos_byte);
- if (method == COMPOSITION_RELATIVE)
- components = Qnil;
- else
- {
- int len = data[0] - 4, j;
- Lisp_Object args[MAX_COMPOSITION_COMPONENTS * 2 - 1];
-
- if (method == COMPOSITION_WITH_RULE_ALTCHARS
- && len % 2 == 0)
- len --;
- if (len < 1)
- /* Invalid composition data. */
- break;
- for (j = 0; j < len; j++)
- args[j] = make_number (data[4 + j]);
- components = (method == COMPOSITION_WITH_ALTCHARS
- ? Fstring (len, args)
- : Fvector (len, args));
- }
- compose_text (data[1], data[2], components, Qnil, obj);
- }
- cmp_data = cmp_data->next;
+ undo_list = Qt;
+ if (BUFFERP (coding->dst_object))
+ {
+ if (current_buffer != XBUFFER (coding->dst_object))
+ set_buffer_internal (XBUFFER (coding->dst_object));
+ if (GPT != PT)
+ move_gap_both (PT, PT_BYTE);
+ undo_list = current_buffer->undo_list;
+ current_buffer->undo_list = Qt;
}
-}
-/* Decode (if ENCODEP is zero) or encode (if ENCODEP is nonzero) the
- text from FROM to TO (byte positions are FROM_BYTE and TO_BYTE) by
- coding system CODING, and return the status code of code conversion
- (currently, this value has no meaning).
-
- How many characters (and bytes) are converted to how many
- characters (and bytes) are recorded in members of the structure
- CODING.
-
- If REPLACE is nonzero, we do various things as if the original text
- is deleted and a new text is inserted. See the comments in
- replace_range (insdel.c) to know what we are doing.
-
- If REPLACE is zero, it is assumed that the source text is unibyte.
- Otherwise, it is assumed that the source text is multibyte. */
+ coding->consumed = coding->consumed_char = 0;
+ coding->produced = coding->produced_char = 0;
+ coding->chars_at_source = 0;
+ record_conversion_result (coding, CODING_RESULT_SUCCESS);
+ coding->errors = 0;
-int
-code_convert_region (from, from_byte, to, to_byte, coding, encodep, replace)
- int from, from_byte, to, to_byte, encodep, replace;
- struct coding_system *coding;
-{
- int len = to - from, len_byte = to_byte - from_byte;
- int nchars_del = 0, nbytes_del = 0;
- int require, inserted, inserted_byte;
- int head_skip, tail_skip, total_skip = 0;
- Lisp_Object saved_coding_symbol;
- int first = 1;
- unsigned char *src, *dst;
- Lisp_Object deletion;
- int orig_point = PT, orig_len = len;
- int prev_Z;
- int multibyte_p = !NILP (current_buffer->enable_multibyte_characters);
+ ALLOC_CONVERSION_WORK_AREA (coding);
- deletion = Qnil;
- saved_coding_symbol = coding->symbol;
+ attrs = CODING_ID_ATTRS (coding->id);
+ translation_table = get_translation_table (attrs, 0, NULL);
- if (from < PT && PT < to)
+ carryover = 0;
+ do
{
- TEMP_SET_PT_BOTH (from, from_byte);
- orig_point = from;
+ EMACS_INT pos = coding->dst_pos + coding->produced_char;
+
+ coding_set_source (coding);
+ coding->annotated = 0;
+ coding->charbuf_used = carryover;
+ (*(coding->decoder)) (coding);
+ coding_set_destination (coding);
+ carryover = produce_chars (coding, translation_table, 0);
+ if (coding->annotated)
+ produce_annotation (coding, pos);
+ for (i = 0; i < carryover; i++)
+ coding->charbuf[i]
+ = coding->charbuf[coding->charbuf_used - carryover + i];
}
+ while (coding->consumed < coding->src_bytes
+ && (coding->result == CODING_RESULT_SUCCESS
+ || coding->result == CODING_RESULT_INVALID_SRC));
- if (replace)
+ if (carryover > 0)
{
- int saved_from = from;
- int saved_inhibit_modification_hooks;
-
- prepare_to_modify_buffer (from, to, &from);
- if (saved_from != from)
- {
- to = from + len;
- from_byte = CHAR_TO_BYTE (from), to_byte = CHAR_TO_BYTE (to);
- len_byte = to_byte - from_byte;
- }
-
- /* The code conversion routine can not preserve text properties
- for now. So, we must remove all text properties in the
- region. Here, we must suppress all modification hooks. */
- saved_inhibit_modification_hooks = inhibit_modification_hooks;
- inhibit_modification_hooks = 1;
- Fset_text_properties (make_number (from), make_number (to), Qnil, Qnil);
- inhibit_modification_hooks = saved_inhibit_modification_hooks;
+ coding_set_destination (coding);
+ coding->charbuf_used = carryover;
+ produce_chars (coding, translation_table, 1);
}
- coding->heading_ascii = 0;
-
- if (! encodep && CODING_REQUIRE_DETECTION (coding))
+ coding->carryover_bytes = 0;
+ if (coding->consumed < coding->src_bytes)
{
- /* We must detect encoding of text and eol format. */
+ int nbytes = coding->src_bytes - coding->consumed;
+ const unsigned char *src;
- if (from < GPT && to > GPT)
- move_gap_both (from, from_byte);
- if (coding->type == coding_type_undecided)
+ coding_set_source (coding);
+ coding_set_destination (coding);
+ src = coding->source + coding->consumed;
+
+ if (coding->mode & CODING_MODE_LAST_BLOCK)
{
- detect_coding (coding, BYTE_POS_ADDR (from_byte), len_byte);
- if (coding->type == coding_type_undecided)
+ /* Flush out unprocessed data as binary chars. We are sure
+ that the number of data is less than the size of
+ coding->charbuf. */
+ coding->charbuf_used = 0;
+ while (nbytes-- > 0)
{
- /* It seems that the text contains only ASCII, but we
- should not leave it undecided because the deeper
- decoding routine (decode_coding) tries to detect the
- encodings again in vain. */
- coding->type = coding_type_emacs_mule;
- coding->category_idx = CODING_CATEGORY_IDX_EMACS_MULE;
- /* As emacs-mule decoder will handle composition, we
- need this setting to allocate coding->cmp_data
- later. */
- coding->composing = COMPOSITION_NO;
+ int c = *src++;
+
+ if (c & 0x80)
+ c = BYTE8_TO_CHAR (c);
+ coding->charbuf[coding->charbuf_used++] = c;
}
+ produce_chars (coding, Qnil, 1);
}
- if (coding->eol_type == CODING_EOL_UNDECIDED
- && coding->type != coding_type_ccl)
+ else
{
- detect_eol (coding, BYTE_POS_ADDR (from_byte), len_byte);
- if (coding->eol_type == CODING_EOL_UNDECIDED)
- coding->eol_type = CODING_EOL_LF;
- /* We had better recover the original eol format if we
- encounter an inconsistent eol format while decoding. */
- coding->mode |= CODING_MODE_INHIBIT_INCONSISTENT_EOL;
+ /* Record unprocessed bytes in coding->carryover. We are
+ sure that the number of data is less than the size of
+ coding->carryover. */
+ unsigned char *p = coding->carryover;
+
+ coding->carryover_bytes = nbytes;
+ while (nbytes-- > 0)
+ *p++ = *src++;
}
+ coding->consumed = coding->src_bytes;
}
- /* Now we convert the text. */
-
- /* For encoding, we must process pre-write-conversion in advance. */
- if (! inhibit_pre_post_conversion
- && encodep
- && SYMBOLP (coding->pre_write_conversion)
- && ! NILP (Ffboundp (coding->pre_write_conversion)))
+ if (! EQ (CODING_ID_EOL_TYPE (coding->id), Qunix))
+ decode_eol (coding);
+ if (BUFFERP (coding->dst_object))
{
- /* The function in pre-write-conversion may put a new text in a
- new buffer. */
- struct buffer *prev = current_buffer;
- Lisp_Object new;
+ current_buffer->undo_list = undo_list;
+ record_insert (coding->dst_pos, coding->produced_char);
+ }
+ return coding->result;
+}
- record_unwind_protect (code_convert_region_unwind,
- Fcons (Vlast_coding_system_used, Qnil));
- /* We should not call any more pre-write/post-read-conversion
- functions while this pre-write-conversion is running. */
- inhibit_pre_post_conversion = 1;
- call2 (coding->pre_write_conversion,
- make_number (from), make_number (to));
- inhibit_pre_post_conversion = 0;
- /* Discard the unwind protect. */
- specpdl_ptr--;
- if (current_buffer != prev)
- {
- len = ZV - BEGV;
- new = Fcurrent_buffer ();
- set_buffer_internal_1 (prev);
- del_range_2 (from, from_byte, to, to_byte, 0);
- TEMP_SET_PT_BOTH (from, from_byte);
- insert_from_buffer (XBUFFER (new), 1, len, 0);
- Fkill_buffer (new);
- if (orig_point >= to)
- orig_point += len - orig_len;
- else if (orig_point > from)
- orig_point = from;
- orig_len = len;
- to = from + len;
- from_byte = CHAR_TO_BYTE (from);
- to_byte = CHAR_TO_BYTE (to);
- len_byte = to_byte - from_byte;
- TEMP_SET_PT_BOTH (from, from_byte);
- }
- }
+/* Extract an annotation datum from a composition starting at POS and
+ ending before LIMIT of CODING->src_object (buffer or string), store
+ the data in BUF, set *STOP to a starting position of the next
+ composition (if any) or to LIMIT, and return the address of the
+ next element of BUF.
+
+ If such an annotation is not found, set *STOP to a starting
+ position of a composition after POS (if any) or to LIMIT, and
+ return BUF. */
+
+static INLINE int *
+handle_composition_annotation (pos, limit, coding, buf, stop)
+ EMACS_INT pos, limit;
+ struct coding_system *coding;
+ int *buf;
+ EMACS_INT *stop;
+{
+ EMACS_INT start, end;
+ Lisp_Object prop;
- if (replace)
+ if (! find_composition (pos, limit, &start, &end, &prop, coding->src_object)
+ || end > limit)
+ *stop = limit;
+ else if (start > pos)
+ *stop = start;
+ else
{
- if (! EQ (current_buffer->undo_list, Qt))
- deletion = make_buffer_string_both (from, from_byte, to, to_byte, 1);
- else
+ if (start == pos)
{
- nchars_del = to - from;
- nbytes_del = to_byte - from_byte;
+ /* We found a composition. Store the corresponding
+ annotation data in BUF. */
+ int *head = buf;
+ enum composition_method method = COMPOSITION_METHOD (prop);
+ int nchars = COMPOSITION_LENGTH (prop);
+
+ ADD_COMPOSITION_DATA (buf, nchars, method);
+ if (method != COMPOSITION_RELATIVE)
+ {
+ Lisp_Object components;
+ int len, i, i_byte;
+
+ components = COMPOSITION_COMPONENTS (prop);
+ if (VECTORP (components))
+ {
+ len = XVECTOR (components)->size;
+ for (i = 0; i < len; i++)
+ *buf++ = XINT (AREF (components, i));
+ }
+ else if (STRINGP (components))
+ {
+ len = SCHARS (components);
+ i = i_byte = 0;
+ while (i < len)
+ {
+ FETCH_STRING_CHAR_ADVANCE (*buf, components, i, i_byte);
+ buf++;
+ }
+ }
+ else if (INTEGERP (components))
+ {
+ len = 1;
+ *buf++ = XINT (components);
+ }
+ else if (CONSP (components))
+ {
+ for (len = 0; CONSP (components);
+ len++, components = XCDR (components))
+ *buf++ = XINT (XCAR (components));
+ }
+ else
+ abort ();
+ *head -= len;
+ }
}
- }
- if (coding->composing != COMPOSITION_DISABLED)
- {
- if (encodep)
- coding_save_composition (coding, from, to, Fcurrent_buffer ());
+ if (find_composition (end, limit, &start, &end, &prop,
+ coding->src_object)
+ && end <= limit)
+ *stop = start;
else
- coding_allocate_composition_data (coding, from);
+ *stop = limit;
}
+ return buf;
+}
- /* Try to skip the heading and tailing ASCIIs. We can't skip them
- if we must run CCL program or there are compositions to
- encode. */
- if (coding->type != coding_type_ccl
- && (! coding->cmp_data || coding->cmp_data->used == 0))
- {
- int from_byte_orig = from_byte, to_byte_orig = to_byte;
- if (from < GPT && GPT < to)
- move_gap_both (from, from_byte);
- SHRINK_CONVERSION_REGION (&from_byte, &to_byte, coding, NULL, encodep);
- if (from_byte == to_byte
- && (encodep || NILP (coding->post_read_conversion))
- && ! CODING_REQUIRE_FLUSHING (coding))
- {
- coding->produced = len_byte;
- coding->produced_char = len;
- if (!replace)
- /* We must record and adjust for this new text now. */
- adjust_after_insert (from, from_byte_orig, to, to_byte_orig, len);
- coding_free_composition_data (coding);
- return 0;
- }
-
- head_skip = from_byte - from_byte_orig;
- tail_skip = to_byte_orig - to_byte;
- total_skip = head_skip + tail_skip;
- from += head_skip;
- to -= tail_skip;
- len -= total_skip; len_byte -= total_skip;
- }
-
- /* For conversion, we must put the gap before the text in addition to
- making the gap larger for efficient decoding. The required gap
- size starts from 2000 which is the magic number used in make_gap.
- But, after one batch of conversion, it will be incremented if we
- find that it is not enough . */
- require = 2000;
-
- if (GAP_SIZE < require)
- make_gap (require - GAP_SIZE);
- move_gap_both (from, from_byte);
-
- inserted = inserted_byte = 0;
-
- GAP_SIZE += len_byte;
- ZV -= len;
- Z -= len;
- ZV_BYTE -= len_byte;
- Z_BYTE -= len_byte;
-
- if (GPT - BEG < BEG_UNCHANGED)
- BEG_UNCHANGED = GPT - BEG;
- if (Z - GPT < END_UNCHANGED)
- END_UNCHANGED = Z - GPT;
-
- if (!encodep && coding->src_multibyte)
- {
- /* Decoding routines expects that the source text is unibyte.
- We must convert 8-bit characters of multibyte form to
- unibyte. */
- int len_byte_orig = len_byte;
- len_byte = str_as_unibyte (GAP_END_ADDR - len_byte, len_byte);
- if (len_byte < len_byte_orig)
- safe_bcopy (GAP_END_ADDR - len_byte_orig, GAP_END_ADDR - len_byte,
- len_byte);
- coding->src_multibyte = 0;
- }
-
- for (;;)
- {
- int result;
-
- /* The buffer memory is now:
- +--------+converted-text+---------+-------original-text-------+---+
- |<-from->|<--inserted-->|---------|<--------len_byte--------->|---|
- |<---------------------- GAP ----------------------->| */
- src = GAP_END_ADDR - len_byte;
- dst = GPT_ADDR + inserted_byte;
-
- if (encodep)
- result = encode_coding (coding, src, dst, len_byte, 0);
- else
- {
- if (coding->composing != COMPOSITION_DISABLED)
- coding->cmp_data->char_offset = from + inserted;
- result = decode_coding (coding, src, dst, len_byte, 0);
- }
+/* Extract an annotation datum from a text property `charset' at POS of
+ CODING->src_object (buffer of string), store the data in BUF, set
+ *STOP to the position where the value of `charset' property changes
+ (limiting by LIMIT), and return the address of the next element of
+ BUF.
- /* The buffer memory is now:
- +--------+-------converted-text----+--+------original-text----+---+
- |<-from->|<-inserted->|<-produced->|--|<-(len_byte-consumed)->|---|
- |<---------------------- GAP ----------------------->| */
+ If the property value is nil, set *STOP to the position where the
+ property value is non-nil (limiting by LIMIT), and return BUF. */
+
+static INLINE int *
+handle_charset_annotation (pos, limit, coding, buf, stop)
+ EMACS_INT pos, limit;
+ struct coding_system *coding;
+ int *buf;
+ EMACS_INT *stop;
+{
+ Lisp_Object val, next;
+ int id;
- inserted += coding->produced_char;
- inserted_byte += coding->produced;
- len_byte -= coding->consumed;
+ val = Fget_text_property (make_number (pos), Qcharset, coding->src_object);
+ if (! NILP (val) && CHARSETP (val))
+ id = XINT (CHARSET_SYMBOL_ID (val));
+ else
+ id = -1;
+ ADD_CHARSET_DATA (buf, 0, id);
+ next = Fnext_single_property_change (make_number (pos), Qcharset,
+ coding->src_object,
+ make_number (limit));
+ *stop = XINT (next);
+ return buf;
+}
- if (result == CODING_FINISH_INSUFFICIENT_CMP)
- {
- coding_allocate_composition_data (coding, from + inserted);
- continue;
- }
- src += coding->consumed;
- dst += coding->produced;
+static void
+consume_chars (coding, translation_table, max_lookup)
+ struct coding_system *coding;
+ Lisp_Object translation_table;
+ int max_lookup;
+{
+ int *buf = coding->charbuf;
+ int *buf_end = coding->charbuf + coding->charbuf_size;
+ const unsigned char *src = coding->source + coding->consumed;
+ const unsigned char *src_end = coding->source + coding->src_bytes;
+ EMACS_INT pos = coding->src_pos + coding->consumed_char;
+ EMACS_INT end_pos = coding->src_pos + coding->src_chars;
+ int multibytep = coding->src_multibyte;
+ Lisp_Object eol_type;
+ int c;
+ EMACS_INT stop, stop_composition, stop_charset;
+ int *lookup_buf = NULL;
- if (result == CODING_FINISH_NORMAL)
- {
- src += len_byte;
- break;
- }
- if (! encodep && result == CODING_FINISH_INCONSISTENT_EOL)
- {
- unsigned char *pend = dst, *p = pend - inserted_byte;
- Lisp_Object eol_type;
+ if (! NILP (translation_table))
+ lookup_buf = alloca (sizeof (int) * max_lookup);
- /* Encode LFs back to the original eol format (CR or CRLF). */
- if (coding->eol_type == CODING_EOL_CR)
- {
- while (p < pend) if (*p++ == '\n') p[-1] = '\r';
- }
- else
- {
- int count = 0;
+ eol_type = CODING_ID_EOL_TYPE (coding->id);
+ if (VECTORP (eol_type))
+ eol_type = Qunix;
- while (p < pend) if (*p++ == '\n') count++;
- if (src - dst < count)
- {
- /* We don't have sufficient room for encoding LFs
- back to CRLF. We must record converted and
- not-yet-converted text back to the buffer
- content, enlarge the gap, then record them out of
- the buffer contents again. */
- int add = len_byte + inserted_byte;
-
- GAP_SIZE -= add;
- ZV += add; Z += add; ZV_BYTE += add; Z_BYTE += add;
- GPT += inserted_byte; GPT_BYTE += inserted_byte;
- make_gap (count - GAP_SIZE);
- GAP_SIZE += add;
- ZV -= add; Z -= add; ZV_BYTE -= add; Z_BYTE -= add;
- GPT -= inserted_byte; GPT_BYTE -= inserted_byte;
- /* Don't forget to update SRC, DST, and PEND. */
- src = GAP_END_ADDR - len_byte;
- dst = GPT_ADDR + inserted_byte;
- pend = dst;
- }
- inserted += count;
- inserted_byte += count;
- coding->produced += count;
- p = dst = pend + count;
- while (count)
- {
- *--p = *--pend;
- if (*p == '\n') count--, *--p = '\r';
- }
- }
+ /* Note: composition handling is not yet implemented. */
+ coding->common_flags &= ~CODING_ANNOTATE_COMPOSITION_MASK;
- /* Suppress eol-format conversion in the further conversion. */
- coding->eol_type = CODING_EOL_LF;
+ if (NILP (coding->src_object))
+ stop = stop_composition = stop_charset = end_pos;
+ else
+ {
+ if (coding->common_flags & CODING_ANNOTATE_COMPOSITION_MASK)
+ stop = stop_composition = pos;
+ else
+ stop = stop_composition = end_pos;
+ if (coding->common_flags & CODING_ANNOTATE_CHARSET_MASK)
+ stop = stop_charset = pos;
+ else
+ stop_charset = end_pos;
+ }
- /* Set the coding system symbol to that for Unix-like EOL. */
- eol_type = Fget (saved_coding_symbol, Qeol_type);
- if (VECTORP (eol_type)
- && XVECTOR (eol_type)->size == 3
- && SYMBOLP (XVECTOR (eol_type)->contents[CODING_EOL_LF]))
- coding->symbol = XVECTOR (eol_type)->contents[CODING_EOL_LF];
- else
- coding->symbol = saved_coding_symbol;
+ /* Compensate for CRLF and conversion. */
+ buf_end -= 1 + MAX_ANNOTATION_LENGTH;
+ while (buf < buf_end)
+ {
+ Lisp_Object trans;
- continue;
- }
- if (len_byte <= 0)
+ if (pos == stop)
{
- if (coding->type != coding_type_ccl
- || coding->mode & CODING_MODE_LAST_BLOCK)
+ if (pos == end_pos)
break;
- coding->mode |= CODING_MODE_LAST_BLOCK;
- continue;
+ if (pos == stop_composition)
+ buf = handle_composition_annotation (pos, end_pos, coding,
+ buf, &stop_composition);
+ if (pos == stop_charset)
+ buf = handle_charset_annotation (pos, end_pos, coding,
+ buf, &stop_charset);
+ stop = (stop_composition < stop_charset
+ ? stop_composition : stop_charset);
}
- if (result == CODING_FINISH_INSUFFICIENT_SRC)
- {
- /* The source text ends in invalid codes. Let's just
- make them valid buffer contents, and finish conversion. */
- if (multibyte_p)
- {
- unsigned char *start = dst;
- inserted += len_byte;
- while (len_byte--)
- {
- int c = *src++;
- dst += CHAR_STRING (c, dst);
- }
+ if (! multibytep)
+ {
+ EMACS_INT bytes;
- inserted_byte += dst - start;
- }
+ if (coding->encoder == encode_coding_raw_text)
+ c = *src++, pos++;
+ else if ((bytes = MULTIBYTE_LENGTH (src, src_end)) > 0)
+ c = STRING_CHAR_ADVANCE (src), pos += bytes;
else
- {
- inserted += len_byte;
- inserted_byte += len_byte;
- while (len_byte--)
- *dst++ = *src++;
- }
- break;
- }
- if (result == CODING_FINISH_INTERRUPT)
- {
- /* The conversion procedure was interrupted by a user. */
- break;
- }
- /* Now RESULT == CODING_FINISH_INSUFFICIENT_DST */
- if (coding->consumed < 1)
- {
- /* It's quite strange to require more memory without
- consuming any bytes. Perhaps CCL program bug. */
- break;
+ c = BYTE8_TO_CHAR (*src), src++, pos++;
}
- if (first)
+ else
+ c = STRING_CHAR_ADVANCE (src), pos++;
+ if ((c == '\r') && (coding->mode & CODING_MODE_SELECTIVE_DISPLAY))
+ c = '\n';
+ if (! EQ (eol_type, Qunix))
{
- /* We have just done the first batch of conversion which was
- stopped because of insufficient gap. Let's reconsider the
- required gap size (i.e. SRT - DST) now.
-
- We have converted ORIG bytes (== coding->consumed) into
- NEW bytes (coding->produced). To convert the remaining
- LEN bytes, we may need REQUIRE bytes of gap, where:
- REQUIRE + LEN_BYTE = LEN_BYTE * (NEW / ORIG)
- REQUIRE = LEN_BYTE * (NEW - ORIG) / ORIG
- Here, we are sure that NEW >= ORIG. */
-
- if (coding->produced <= coding->consumed)
- {
- /* This happens because of CCL-based coding system with
- eol-type CRLF. */
- require = 0;
- }
- else
+ if (c == '\n')
{
- float ratio = coding->produced - coding->consumed;
- ratio /= coding->consumed;
- require = len_byte * ratio;
+ if (EQ (eol_type, Qdos))
+ *buf++ = '\r';
+ else
+ c = '\r';
}
- first = 0;
- }
- if ((src - dst) < (require + 2000))
- {
- /* See the comment above the previous call of make_gap. */
- int add = len_byte + inserted_byte;
-
- GAP_SIZE -= add;
- ZV += add; Z += add; ZV_BYTE += add; Z_BYTE += add;
- GPT += inserted_byte; GPT_BYTE += inserted_byte;
- make_gap (require + 2000);
- GAP_SIZE += add;
- ZV -= add; Z -= add; ZV_BYTE -= add; Z_BYTE -= add;
- GPT -= inserted_byte; GPT_BYTE -= inserted_byte;
}
- }
- if (src - dst > 0) *dst = 0; /* Put an anchor. */
- if (encodep && coding->dst_multibyte)
- {
- /* The output is unibyte. We must convert 8-bit characters to
- multibyte form. */
- if (inserted_byte * 2 > GAP_SIZE)
+ trans = Qnil;
+ LOOKUP_TRANSLATION_TABLE (translation_table, c, trans);
+ if (NILP (trans))
+ *buf++ = c;
+ else
{
- GAP_SIZE -= inserted_byte;
- ZV += inserted_byte; Z += inserted_byte;
- ZV_BYTE += inserted_byte; Z_BYTE += inserted_byte;
- GPT += inserted_byte; GPT_BYTE += inserted_byte;
- make_gap (inserted_byte - GAP_SIZE);
- GAP_SIZE += inserted_byte;
- ZV -= inserted_byte; Z -= inserted_byte;
- ZV_BYTE -= inserted_byte; Z_BYTE -= inserted_byte;
- GPT -= inserted_byte; GPT_BYTE -= inserted_byte;
+ int from_nchars = 1, to_nchars = 1;
+ int *lookup_buf_end;
+ const unsigned char *p = src;
+ int i;
+
+ lookup_buf[0] = c;
+ for (i = 1; i < max_lookup && p < src_end; i++)
+ lookup_buf[i] = STRING_CHAR_ADVANCE (p);
+ lookup_buf_end = lookup_buf + i;
+ trans = get_translation (trans, lookup_buf, lookup_buf_end, 1,
+ &from_nchars, &to_nchars);
+ if (EQ (trans, Qt)
+ || buf + to_nchars > buf_end)
+ break;
+ *buf++ = *lookup_buf;
+ for (i = 1; i < to_nchars; i++)
+ *buf++ = XINT (AREF (trans, i));
+ for (i = 1; i < from_nchars; i++, pos++)
+ src += MULTIBYTE_LENGTH_NO_CHECK (src);
}
- inserted_byte = str_to_multibyte (GPT_ADDR, GAP_SIZE, inserted_byte);
}
- /* If we shrank the conversion area, adjust it now. */
- if (total_skip > 0)
- {
- if (tail_skip > 0)
- safe_bcopy (GAP_END_ADDR, GPT_ADDR + inserted_byte, tail_skip);
- inserted += total_skip; inserted_byte += total_skip;
- GAP_SIZE += total_skip;
- GPT -= head_skip; GPT_BYTE -= head_skip;
- ZV -= total_skip; ZV_BYTE -= total_skip;
- Z -= total_skip; Z_BYTE -= total_skip;
- from -= head_skip; from_byte -= head_skip;
- to += tail_skip; to_byte += tail_skip;
- }
+ coding->consumed = src - coding->source;
+ coding->consumed_char = pos - coding->src_pos;
+ coding->charbuf_used = buf - coding->charbuf;
+ coding->chars_at_source = 0;
+}
- prev_Z = Z;
- if (! EQ (current_buffer->undo_list, Qt))
- adjust_after_replace (from, from_byte, deletion, inserted, inserted_byte);
- else
- adjust_after_replace_noundo (from, from_byte, nchars_del, nbytes_del,
- inserted, inserted_byte);
- inserted = Z - prev_Z;
- if (!encodep && coding->cmp_data && coding->cmp_data->used)
- coding_restore_composition (coding, Fcurrent_buffer ());
- coding_free_composition_data (coding);
+/* Encode the text at CODING->src_object into CODING->dst_object.
+ CODING->src_object is a buffer or a string.
+ CODING->dst_object is a buffer or nil.
- if (! inhibit_pre_post_conversion
- && ! encodep && ! NILP (coding->post_read_conversion))
- {
- Lisp_Object val;
- Lisp_Object saved_coding_system;
+ If CODING->src_object is a buffer, it must be the current buffer.
+ In this case, if CODING->src_pos is positive, it is a position of
+ the source text in the buffer, otherwise. the source text is in the
+ gap area of the buffer, and coding->src_pos specifies the offset of
+ the text from GPT (which must be the same as PT). If this is the
+ same buffer as CODING->dst_object, CODING->src_pos must be
+ negative and CODING should not have `pre-write-conversion'.
- if (from != PT)
- TEMP_SET_PT_BOTH (from, from_byte);
- prev_Z = Z;
- record_unwind_protect (code_convert_region_unwind,
- Fcons (Vlast_coding_system_used, Qnil));
- saved_coding_system = Vlast_coding_system_used;
- Vlast_coding_system_used = coding->symbol;
- /* We should not call any more pre-write/post-read-conversion
- functions while this post-read-conversion is running. */
- inhibit_pre_post_conversion = 1;
- val = call1 (coding->post_read_conversion, make_number (inserted));
- inhibit_pre_post_conversion = 0;
- coding->symbol = Vlast_coding_system_used;
- Vlast_coding_system_used = saved_coding_system;
- /* Discard the unwind protect. */
- specpdl_ptr--;
- CHECK_NUMBER (val);
- inserted += Z - prev_Z;
- }
-
- if (orig_point >= from)
- {
- if (orig_point >= from + orig_len)
- orig_point += inserted - orig_len;
- else
- orig_point = from;
- TEMP_SET_PT (orig_point);
- }
+ If CODING->src_object is a string, CODING should not have
+ `pre-write-conversion'.
+
+ If CODING->dst_object is a buffer, the encoded data is inserted at
+ the current point of that buffer.
+
+ If CODING->dst_object is nil, the encoded data is placed at the
+ memory area specified by CODING->destination. */
+
+static int
+encode_coding (coding)
+ struct coding_system *coding;
+{
+ Lisp_Object attrs;
+ Lisp_Object translation_table;
+ int max_lookup;
+
+ attrs = CODING_ID_ATTRS (coding->id);
+ if (coding->encoder == encode_coding_raw_text)
+ translation_table = Qnil, max_lookup = 0;
+ else
+ translation_table = get_translation_table (attrs, 1, &max_lookup);
- if (replace)
+ if (BUFFERP (coding->dst_object))
{
- signal_after_change (from, to - from, inserted);
- update_compositions (from, from + inserted, CHECK_BORDER);
+ set_buffer_internal (XBUFFER (coding->dst_object));
+ coding->dst_multibyte
+ = ! NILP (current_buffer->enable_multibyte_characters);
}
- {
- coding->consumed = to_byte - from_byte;
- coding->consumed_char = to - from;
- coding->produced = inserted_byte;
- coding->produced_char = inserted;
- }
+ coding->consumed = coding->consumed_char = 0;
+ coding->produced = coding->produced_char = 0;
+ record_conversion_result (coding, CODING_RESULT_SUCCESS);
+ coding->errors = 0;
- return 0;
+ ALLOC_CONVERSION_WORK_AREA (coding);
+
+ do {
+ coding_set_source (coding);
+ consume_chars (coding, translation_table, max_lookup);
+ coding_set_destination (coding);
+ (*(coding->encoder)) (coding);
+ } while (coding->consumed_char < coding->src_chars);
+
+ if (BUFFERP (coding->dst_object) && coding->produced_char > 0)
+ insert_from_gap (coding->produced_char, coding->produced);
+
+ return (coding->result);
}
+
/* Name (or base name) of work buffer for code conversion. */
static Lisp_Object Vcode_conversion_workbuf_name;
-/* Set the current buffer to the working buffer prepared for
- code-conversion. MULTIBYTE specifies the multibyteness of the
- buffer. Return the buffer we set if it must be killed after use.
- Otherwise return Qnil. */
+/* A working buffer used by the top level conversion. Once it is
+ created, it is never destroyed. It has the name
+ Vcode_conversion_workbuf_name. The other working buffers are
+ destroyed after the use is finished, and their names are modified
+ versions of Vcode_conversion_workbuf_name. */
+static Lisp_Object Vcode_conversion_reused_workbuf;
+
+/* 1 iff Vcode_conversion_reused_workbuf is already in use. */
+static int reused_workbuf_in_use;
+
+
+/* Return a working buffer of code convesion. MULTIBYTE specifies the
+ multibyteness of returning buffer. */
static Lisp_Object
-set_conversion_work_buffer (multibyte)
+make_conversion_work_buffer (multibyte)
int multibyte;
{
- Lisp_Object buffer, buffer_to_kill;
- struct buffer *buf;
+ Lisp_Object name, workbuf;
+ struct buffer *current;
- buffer = Fget_buffer_create (Vcode_conversion_workbuf_name);
- buf = XBUFFER (buffer);
- if (buf == current_buffer)
+ if (reused_workbuf_in_use++)
{
- /* As we are already in the work buffer, we must generate a new
- buffer for the work. */
- Lisp_Object name;
-
name = Fgenerate_new_buffer_name (Vcode_conversion_workbuf_name, Qnil);
- buffer = buffer_to_kill = Fget_buffer_create (name);
- buf = XBUFFER (buffer);
+ workbuf = Fget_buffer_create (name);
}
else
- buffer_to_kill = Qnil;
-
- delete_all_overlays (buf);
- buf->directory = current_buffer->directory;
- buf->read_only = Qnil;
- buf->filename = Qnil;
- buf->undo_list = Qt;
- eassert (buf->overlays_before == NULL);
- eassert (buf->overlays_after == NULL);
- set_buffer_internal (buf);
- if (BEG != BEGV || Z != ZV)
- Fwiden ();
- del_range_2 (BEG, BEG_BYTE, Z, Z_BYTE, 0);
- buf->enable_multibyte_characters = multibyte ? Qt : Qnil;
- return buffer_to_kill;
+ {
+ name = Vcode_conversion_workbuf_name;
+ workbuf = Fget_buffer_create (name);
+ if (NILP (Vcode_conversion_reused_workbuf))
+ Vcode_conversion_reused_workbuf = workbuf;
+ }
+ current = current_buffer;
+ set_buffer_internal (XBUFFER (workbuf));
+ Ferase_buffer ();
+ current_buffer->undo_list = Qt;
+ current_buffer->enable_multibyte_characters = multibyte ? Qt : Qnil;
+ set_buffer_internal (current);
+ return workbuf;
+}
+
+
+static Lisp_Object
+code_conversion_restore (arg)
+ Lisp_Object arg;
+{
+ Lisp_Object current, workbuf;
+ struct gcpro gcpro1;
+
+ GCPRO1 (arg);
+ current = XCAR (arg);
+ workbuf = XCDR (arg);
+ if (! NILP (workbuf))
+ {
+ if (EQ (workbuf, Vcode_conversion_reused_workbuf))
+ reused_workbuf_in_use = 0;
+ else if (! NILP (Fbuffer_live_p (workbuf)))
+ Fkill_buffer (workbuf);
+ }
+ set_buffer_internal (XBUFFER (current));
+ UNGCPRO;
+ return Qnil;
}
Lisp_Object
-run_pre_post_conversion_on_str (str, coding, encodep)
- Lisp_Object str;
+code_conversion_save (with_work_buf, multibyte)
+ int with_work_buf, multibyte;
+{
+ Lisp_Object workbuf = Qnil;
+
+ if (with_work_buf)
+ workbuf = make_conversion_work_buffer (multibyte);
+ record_unwind_protect (code_conversion_restore,
+ Fcons (Fcurrent_buffer (), workbuf));
+ return workbuf;
+}
+
+int
+decode_coding_gap (coding, chars, bytes)
struct coding_system *coding;
- int encodep;
+ EMACS_INT chars, bytes;
{
- int count = SPECPDL_INDEX ();
- struct gcpro gcpro1, gcpro2;
- int multibyte = STRING_MULTIBYTE (str);
- Lisp_Object old_deactivate_mark;
- Lisp_Object buffer_to_kill;
- Lisp_Object unwind_arg;
-
- record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
- /* It is not crucial to specbind this. */
- old_deactivate_mark = Vdeactivate_mark;
- GCPRO2 (str, old_deactivate_mark);
-
- /* We must insert the contents of STR as is without
- unibyte<->multibyte conversion. For that, we adjust the
- multibyteness of the working buffer to that of STR. */
- buffer_to_kill = set_conversion_work_buffer (multibyte);
- if (NILP (buffer_to_kill))
- unwind_arg = Fcons (Vlast_coding_system_used, Qnil);
- else
- unwind_arg = list2 (Vlast_coding_system_used, buffer_to_kill);
- record_unwind_protect (code_convert_region_unwind, unwind_arg);
+ int count = specpdl_ptr - specpdl;
+ Lisp_Object attrs;
+
+ code_conversion_save (0, 0);
+
+ coding->src_object = Fcurrent_buffer ();
+ coding->src_chars = chars;
+ coding->src_bytes = bytes;
+ coding->src_pos = -chars;
+ coding->src_pos_byte = -bytes;
+ coding->src_multibyte = chars < bytes;
+ coding->dst_object = coding->src_object;
+ coding->dst_pos = PT;
+ coding->dst_pos_byte = PT_BYTE;
+ coding->dst_multibyte = ! NILP (current_buffer->enable_multibyte_characters);
- insert_from_string (str, 0, 0,
- SCHARS (str), SBYTES (str), 0);
- UNGCPRO;
- inhibit_pre_post_conversion = 1;
- if (encodep)
- {
- struct buffer *prev = current_buffer;
+ if (CODING_REQUIRE_DETECTION (coding))
+ detect_coding (coding);
- call2 (coding->pre_write_conversion, make_number (BEG), make_number (Z));
- if (prev != current_buffer)
- /* We must kill the current buffer too. */
- Fsetcdr (unwind_arg, Fcons (Fcurrent_buffer (), XCDR (unwind_arg)));
- }
- else
+ coding->mode |= CODING_MODE_LAST_BLOCK;
+ current_buffer->text->inhibit_shrinking = 1;
+ decode_coding (coding);
+ current_buffer->text->inhibit_shrinking = 0;
+
+ attrs = CODING_ID_ATTRS (coding->id);
+ if (! NILP (CODING_ATTR_POST_READ (attrs)))
{
- Vlast_coding_system_used = coding->symbol;
- TEMP_SET_PT_BOTH (BEG, BEG_BYTE);
- call1 (coding->post_read_conversion, make_number (Z - BEG));
- coding->symbol = Vlast_coding_system_used;
+ EMACS_INT prev_Z = Z, prev_Z_BYTE = Z_BYTE;
+ Lisp_Object val;
+
+ TEMP_SET_PT_BOTH (coding->dst_pos, coding->dst_pos_byte);
+ val = call1 (CODING_ATTR_POST_READ (attrs),
+ make_number (coding->produced_char));
+ CHECK_NATNUM (val);
+ coding->produced_char += Z - prev_Z;
+ coding->produced += Z_BYTE - prev_Z_BYTE;
}
- inhibit_pre_post_conversion = 0;
- Vdeactivate_mark = old_deactivate_mark;
- str = make_buffer_string (BEG, Z, 1);
- return unbind_to (count, str);
+
+ unbind_to (count, Qnil);
+ return coding->result;
}
+int
+encode_coding_gap (coding, chars, bytes)
+ struct coding_system *coding;
+ EMACS_INT chars, bytes;
+{
+ int count = specpdl_ptr - specpdl;
-/* Run pre-write-conversion function of CODING on NCHARS/NBYTES
- text in *STR. *SIZE is the allocated bytes for STR. As it
- is intended that this function is called from encode_terminal_code,
- the pre-write-conversion function is run by safe_call and thus
- "Error during redisplay: ..." is logged when an error occurs.
+ code_conversion_save (0, 0);
- Store the resulting text in *STR and set CODING->produced_char and
- CODING->produced to the number of characters and bytes
- respectively. If the size of *STR is too small, enlarge it by
- xrealloc and update *STR and *SIZE. */
+ coding->src_object = Fcurrent_buffer ();
+ coding->src_chars = chars;
+ coding->src_bytes = bytes;
+ coding->src_pos = -chars;
+ coding->src_pos_byte = -bytes;
+ coding->src_multibyte = chars < bytes;
+ coding->dst_object = coding->src_object;
+ coding->dst_pos = PT;
+ coding->dst_pos_byte = PT_BYTE;
-void
-run_pre_write_conversin_on_c_str (str, size, nchars, nbytes, coding)
- unsigned char **str;
- int *size, nchars, nbytes;
- struct coding_system *coding;
-{
- struct gcpro gcpro1, gcpro2;
- struct buffer *cur = current_buffer;
- struct buffer *prev;
- Lisp_Object old_deactivate_mark, old_last_coding_system_used;
- Lisp_Object args[3];
- Lisp_Object buffer_to_kill;
-
- /* It is not crucial to specbind this. */
- old_deactivate_mark = Vdeactivate_mark;
- old_last_coding_system_used = Vlast_coding_system_used;
- GCPRO2 (old_deactivate_mark, old_last_coding_system_used);
-
- /* We must insert the contents of STR as is without
- unibyte<->multibyte conversion. For that, we adjust the
- multibyteness of the working buffer to that of STR. */
- buffer_to_kill = set_conversion_work_buffer (coding->src_multibyte);
- insert_1_both (*str, nchars, nbytes, 0, 0, 0);
- UNGCPRO;
- inhibit_pre_post_conversion = 1;
- prev = current_buffer;
- args[0] = coding->pre_write_conversion;
- args[1] = make_number (BEG);
- args[2] = make_number (Z);
- safe_call (3, args);
- inhibit_pre_post_conversion = 0;
- Vdeactivate_mark = old_deactivate_mark;
- Vlast_coding_system_used = old_last_coding_system_used;
- coding->produced_char = Z - BEG;
- coding->produced = Z_BYTE - BEG_BYTE;
- if (coding->produced > *size)
- {
- *size = coding->produced;
- *str = xrealloc (*str, *size);
- }
- if (BEG < GPT && GPT < Z)
- move_gap (BEG);
- bcopy (BEG_ADDR, *str, coding->produced);
- coding->src_multibyte
- = ! NILP (current_buffer->enable_multibyte_characters);
- if (prev != current_buffer)
- Fkill_buffer (Fcurrent_buffer ());
- set_buffer_internal (cur);
- if (! NILP (buffer_to_kill))
- Fkill_buffer (buffer_to_kill);
+ encode_coding (coding);
+
+ unbind_to (count, Qnil);
+ return coding->result;
}
-Lisp_Object
-decode_coding_string (str, coding, nocopy)
- Lisp_Object str;
+/* Decode the text in the range FROM/FROM_BYTE and TO/TO_BYTE in
+ SRC_OBJECT into DST_OBJECT by coding context CODING.
+
+ SRC_OBJECT is a buffer, a string, or Qnil.
+
+ If it is a buffer, the text is at point of the buffer. FROM and TO
+ are positions in the buffer.
+
+ If it is a string, the text is at the beginning of the string.
+ FROM and TO are indices to the string.
+
+ If it is nil, the text is at coding->source. FROM and TO are
+ indices to coding->source.
+
+ DST_OBJECT is a buffer, Qt, or Qnil.
+
+ If it is a buffer, the decoded text is inserted at point of the
+ buffer. If the buffer is the same as SRC_OBJECT, the source text
+ is deleted.
+
+ If it is Qt, a string is made from the decoded text, and
+ set in CODING->dst_object.
+
+ If it is Qnil, the decoded text is stored at CODING->destination.
+ The caller must allocate CODING->dst_bytes bytes at
+ CODING->destination by xmalloc. If the decoded text is longer than
+ CODING->dst_bytes, CODING->destination is relocated by xrealloc.
+ */
+
+void
+decode_coding_object (coding, src_object, from, from_byte, to, to_byte,
+ dst_object)
struct coding_system *coding;
- int nocopy;
+ Lisp_Object src_object;
+ EMACS_INT from, from_byte, to, to_byte;
+ Lisp_Object dst_object;
{
- int len;
- struct conversion_buffer buf;
- int from, to_byte;
- Lisp_Object saved_coding_symbol;
- int result;
- int require_decoding;
- int shrinked_bytes = 0;
- Lisp_Object newstr;
- int consumed, consumed_char, produced, produced_char;
-
- from = 0;
- to_byte = SBYTES (str);
-
- saved_coding_symbol = coding->symbol;
- coding->src_multibyte = STRING_MULTIBYTE (str);
- coding->dst_multibyte = 1;
- coding->heading_ascii = 0;
+ int count = specpdl_ptr - specpdl;
+ unsigned char *destination;
+ EMACS_INT dst_bytes;
+ EMACS_INT chars = to - from;
+ EMACS_INT bytes = to_byte - from_byte;
+ Lisp_Object attrs;
+ Lisp_Object buffer;
+ int saved_pt = -1, saved_pt_byte;
- if (CODING_REQUIRE_DETECTION (coding))
+ buffer = Fcurrent_buffer ();
+
+ if (NILP (dst_object))
+ {
+ destination = coding->destination;
+ dst_bytes = coding->dst_bytes;
+ }
+
+ coding->src_object = src_object;
+ coding->src_chars = chars;
+ coding->src_bytes = bytes;
+ coding->src_multibyte = chars < bytes;
+
+ if (STRINGP (src_object))
{
- /* See the comments in code_convert_region. */
- if (coding->type == coding_type_undecided)
+ coding->src_pos = from;
+ coding->src_pos_byte = from_byte;
+ }
+ else if (BUFFERP (src_object))
+ {
+ set_buffer_internal (XBUFFER (src_object));
+ if (from != GPT)
+ move_gap_both (from, from_byte);
+ if (EQ (src_object, dst_object))
{
- detect_coding (coding, SDATA (str), to_byte);
- if (coding->type == coding_type_undecided)
- {
- coding->type = coding_type_emacs_mule;
- coding->category_idx = CODING_CATEGORY_IDX_EMACS_MULE;
- /* As emacs-mule decoder will handle composition, we
- need this setting to allocate coding->cmp_data
- later. */
- coding->composing = COMPOSITION_NO;
- }
+ saved_pt = PT, saved_pt_byte = PT_BYTE;
+ TEMP_SET_PT_BOTH (from, from_byte);
+ del_range_both (from, from_byte, to, to_byte, 1);
+ coding->src_pos = -chars;
+ coding->src_pos_byte = -bytes;
}
- if (coding->eol_type == CODING_EOL_UNDECIDED
- && coding->type != coding_type_ccl)
+ else
{
- saved_coding_symbol = coding->symbol;
- detect_eol (coding, SDATA (str), to_byte);
- if (coding->eol_type == CODING_EOL_UNDECIDED)
- coding->eol_type = CODING_EOL_LF;
- /* We had better recover the original eol format if we
- encounter an inconsistent eol format while decoding. */
- coding->mode |= CODING_MODE_INHIBIT_INCONSISTENT_EOL;
+ coding->src_pos = from;
+ coding->src_pos_byte = from_byte;
}
}
- if (coding->type == coding_type_no_conversion
- || coding->type == coding_type_raw_text)
- coding->dst_multibyte = 0;
-
- require_decoding = CODING_REQUIRE_DECODING (coding);
+ if (CODING_REQUIRE_DETECTION (coding))
+ detect_coding (coding);
+ attrs = CODING_ID_ATTRS (coding->id);
- if (STRING_MULTIBYTE (str))
+ if (EQ (dst_object, Qt)
+ || (! NILP (CODING_ATTR_POST_READ (attrs))
+ && NILP (dst_object)))
{
- /* Decoding routines expect the source text to be unibyte. */
- str = Fstring_as_unibyte (str);
- to_byte = SBYTES (str);
- nocopy = 1;
- coding->src_multibyte = 0;
+ coding->dst_object = code_conversion_save (1, 1);
+ coding->dst_pos = BEG;
+ coding->dst_pos_byte = BEG_BYTE;
+ coding->dst_multibyte = 1;
}
-
- /* Try to skip the heading and tailing ASCIIs. */
- if (require_decoding && coding->type != coding_type_ccl)
+ else if (BUFFERP (dst_object))
{
- SHRINK_CONVERSION_REGION (&from, &to_byte, coding, SDATA (str),
- 0);
- if (from == to_byte)
- require_decoding = 0;
- shrinked_bytes = from + (SBYTES (str) - to_byte);
+ code_conversion_save (0, 0);
+ coding->dst_object = dst_object;
+ coding->dst_pos = BUF_PT (XBUFFER (dst_object));
+ coding->dst_pos_byte = BUF_PT_BYTE (XBUFFER (dst_object));
+ coding->dst_multibyte
+ = ! NILP (XBUFFER (dst_object)->enable_multibyte_characters);
}
-
- if (!require_decoding
- && !(SYMBOLP (coding->post_read_conversion)
- && !NILP (Ffboundp (coding->post_read_conversion))))
+ else
{
- coding->consumed = SBYTES (str);
- coding->consumed_char = SCHARS (str);
- if (coding->dst_multibyte)
- {
- str = Fstring_as_multibyte (str);
- nocopy = 1;
- }
- coding->produced = SBYTES (str);
- coding->produced_char = SCHARS (str);
- return (nocopy ? str : Fcopy_sequence (str));
+ code_conversion_save (0, 0);
+ coding->dst_object = Qnil;
+ coding->dst_multibyte = 1;
}
- if (coding->composing != COMPOSITION_DISABLED)
- coding_allocate_composition_data (coding, from);
- len = decoding_buffer_size (coding, to_byte - from);
- allocate_conversion_buffer (buf, len);
+ decode_coding (coding);
- consumed = consumed_char = produced = produced_char = 0;
- while (1)
+ if (BUFFERP (coding->dst_object))
+ set_buffer_internal (XBUFFER (coding->dst_object));
+
+ if (! NILP (CODING_ATTR_POST_READ (attrs)))
{
- result = decode_coding (coding, SDATA (str) + from + consumed,
- buf.data + produced, to_byte - from - consumed,
- buf.size - produced);
- consumed += coding->consumed;
- consumed_char += coding->consumed_char;
- produced += coding->produced;
- produced_char += coding->produced_char;
- if (result == CODING_FINISH_NORMAL
- || result == CODING_FINISH_INTERRUPT
- || (result == CODING_FINISH_INSUFFICIENT_SRC
- && coding->consumed == 0))
- break;
- if (result == CODING_FINISH_INSUFFICIENT_CMP)
- coding_allocate_composition_data (coding, from + produced_char);
- else if (result == CODING_FINISH_INSUFFICIENT_DST)
- extend_conversion_buffer (&buf);
- else if (result == CODING_FINISH_INCONSISTENT_EOL)
- {
- Lisp_Object eol_type;
+ struct gcpro gcpro1, gcpro2;
+ EMACS_INT prev_Z = Z, prev_Z_BYTE = Z_BYTE;
+ Lisp_Object val;
- /* Recover the original EOL format. */
- if (coding->eol_type == CODING_EOL_CR)
- {
- unsigned char *p;
- for (p = buf.data; p < buf.data + produced; p++)
- if (*p == '\n') *p = '\r';
- }
- else if (coding->eol_type == CODING_EOL_CRLF)
+ TEMP_SET_PT_BOTH (coding->dst_pos, coding->dst_pos_byte);
+ GCPRO2 (coding->src_object, coding->dst_object);
+ val = safe_call1 (CODING_ATTR_POST_READ (attrs),
+ make_number (coding->produced_char));
+ UNGCPRO;
+ CHECK_NATNUM (val);
+ coding->produced_char += Z - prev_Z;
+ coding->produced += Z_BYTE - prev_Z_BYTE;
+ }
+
+ if (EQ (dst_object, Qt))
+ {
+ coding->dst_object = Fbuffer_string ();
+ }
+ else if (NILP (dst_object) && BUFFERP (coding->dst_object))
+ {
+ set_buffer_internal (XBUFFER (coding->dst_object));
+ if (dst_bytes < coding->produced)
+ {
+ destination
+ = (unsigned char *) xrealloc (destination, coding->produced);
+ if (! destination)
{
- int num_eol = 0;
- unsigned char *p0, *p1;
- for (p0 = buf.data, p1 = p0 + produced; p0 < p1; p0++)
- if (*p0 == '\n') num_eol++;
- if (produced + num_eol >= buf.size)
- extend_conversion_buffer (&buf);
- for (p0 = buf.data + produced, p1 = p0 + num_eol; p0 > buf.data;)
- {
- *--p1 = *--p0;
- if (*p0 == '\n') *--p1 = '\r';
- }
- produced += num_eol;
- produced_char += num_eol;
+ record_conversion_result (coding,
+ CODING_RESULT_INSUFFICIENT_DST);
+ unbind_to (count, Qnil);
+ return;
}
- /* Suppress eol-format conversion in the further conversion. */
- coding->eol_type = CODING_EOL_LF;
-
- /* Set the coding system symbol to that for Unix-like EOL. */
- eol_type = Fget (saved_coding_symbol, Qeol_type);
- if (VECTORP (eol_type)
- && XVECTOR (eol_type)->size == 3
- && SYMBOLP (XVECTOR (eol_type)->contents[CODING_EOL_LF]))
- coding->symbol = XVECTOR (eol_type)->contents[CODING_EOL_LF];
- else
- coding->symbol = saved_coding_symbol;
-
-
+ if (BEGV < GPT && GPT < BEGV + coding->produced_char)
+ move_gap_both (BEGV, BEGV_BYTE);
+ bcopy (BEGV_ADDR, destination, coding->produced);
+ coding->destination = destination;
}
}
- coding->consumed = consumed;
- coding->consumed_char = consumed_char;
- coding->produced = produced;
- coding->produced_char = produced_char;
+ if (saved_pt >= 0)
+ {
+ /* This is the case of:
+ (BUFFERP (src_object) && EQ (src_object, dst_object))
+ As we have moved PT while replacing the original buffer
+ contents, we must recover it now. */
+ set_buffer_internal (XBUFFER (src_object));
+ if (saved_pt < from)
+ TEMP_SET_PT_BOTH (saved_pt, saved_pt_byte);
+ else if (saved_pt < from + chars)
+ TEMP_SET_PT_BOTH (from, from_byte);
+ else if (! NILP (current_buffer->enable_multibyte_characters))
+ TEMP_SET_PT_BOTH (saved_pt + (coding->produced_char - chars),
+ saved_pt_byte + (coding->produced - bytes));
+ else
+ TEMP_SET_PT_BOTH (saved_pt + (coding->produced - bytes),
+ saved_pt_byte + (coding->produced - bytes));
+ }
- if (coding->dst_multibyte)
- newstr = make_uninit_multibyte_string (produced_char + shrinked_bytes,
- produced + shrinked_bytes);
- else
- newstr = make_uninit_string (produced + shrinked_bytes);
- if (from > 0)
- STRING_COPYIN (newstr, 0, SDATA (str), from);
- STRING_COPYIN (newstr, from, buf.data, produced);
- if (shrinked_bytes > from)
- STRING_COPYIN (newstr, from + produced,
- SDATA (str) + to_byte,
- shrinked_bytes - from);
- free_conversion_buffer (&buf);
-
- coding->consumed += shrinked_bytes;
- coding->consumed_char += shrinked_bytes;
- coding->produced += shrinked_bytes;
- coding->produced_char += shrinked_bytes;
-
- if (coding->cmp_data && coding->cmp_data->used)
- coding_restore_composition (coding, newstr);
- coding_free_composition_data (coding);
-
- if (SYMBOLP (coding->post_read_conversion)
- && !NILP (Ffboundp (coding->post_read_conversion)))
- newstr = run_pre_post_conversion_on_str (newstr, coding, 0);
-
- return newstr;
+ unbind_to (count, coding->dst_object);
}
-Lisp_Object
-encode_coding_string (str, coding, nocopy)
- Lisp_Object str;
+
+void
+encode_coding_object (coding, src_object, from, from_byte, to, to_byte,
+ dst_object)
struct coding_system *coding;
- int nocopy;
+ Lisp_Object src_object;
+ EMACS_INT from, from_byte, to, to_byte;
+ Lisp_Object dst_object;
{
- int len;
- struct conversion_buffer buf;
- int from, to, to_byte;
- int result;
- int shrinked_bytes = 0;
- Lisp_Object newstr;
- int consumed, consumed_char, produced, produced_char;
-
- if (SYMBOLP (coding->pre_write_conversion)
- && !NILP (Ffboundp (coding->pre_write_conversion)))
- {
- str = run_pre_post_conversion_on_str (str, coding, 1);
- /* As STR is just newly generated, we don't have to copy it
- anymore. */
- nocopy = 1;
- }
+ int count = specpdl_ptr - specpdl;
+ EMACS_INT chars = to - from;
+ EMACS_INT bytes = to_byte - from_byte;
+ Lisp_Object attrs;
+ Lisp_Object buffer;
+ int saved_pt = -1, saved_pt_byte;
+ int kill_src_buffer = 0;
+
+ buffer = Fcurrent_buffer ();
+
+ coding->src_object = src_object;
+ coding->src_chars = chars;
+ coding->src_bytes = bytes;
+ coding->src_multibyte = chars < bytes;
+
+ attrs = CODING_ID_ATTRS (coding->id);
+
+ if (! NILP (CODING_ATTR_PRE_WRITE (attrs)))
+ {
+ coding->src_object = code_conversion_save (1, coding->src_multibyte);
+ set_buffer_internal (XBUFFER (coding->src_object));
+ if (STRINGP (src_object))
+ insert_from_string (src_object, from, from_byte, chars, bytes, 0);
+ else if (BUFFERP (src_object))
+ insert_from_buffer (XBUFFER (src_object), from, chars, 0);
+ else
+ insert_1_both (coding->source + from, chars, bytes, 0, 0, 0);
- from = 0;
- to = SCHARS (str);
- to_byte = SBYTES (str);
+ if (EQ (src_object, dst_object))
+ {
+ set_buffer_internal (XBUFFER (src_object));
+ saved_pt = PT, saved_pt_byte = PT_BYTE;
+ del_range_both (from, from_byte, to, to_byte, 1);
+ set_buffer_internal (XBUFFER (coding->src_object));
+ }
- /* Encoding routines determine the multibyteness of the source text
- by coding->src_multibyte. */
- coding->src_multibyte = SCHARS (str) < SBYTES (str);
- coding->dst_multibyte = 0;
- if (! CODING_REQUIRE_ENCODING (coding))
- goto no_need_of_encoding;
+ {
+ Lisp_Object args[3];
- if (coding->composing != COMPOSITION_DISABLED)
- coding_save_composition (coding, from, to, str);
+ args[0] = CODING_ATTR_PRE_WRITE (attrs);
+ args[1] = make_number (BEG);
+ args[2] = make_number (Z);
+ safe_call (3, args);
+ }
+ if (XBUFFER (coding->src_object) != current_buffer)
+ kill_src_buffer = 1;
+ coding->src_object = Fcurrent_buffer ();
+ if (BEG != GPT)
+ move_gap_both (BEG, BEG_BYTE);
+ coding->src_chars = Z - BEG;
+ coding->src_bytes = Z_BYTE - BEG_BYTE;
+ coding->src_pos = BEG;
+ coding->src_pos_byte = BEG_BYTE;
+ coding->src_multibyte = Z < Z_BYTE;
+ }
+ else if (STRINGP (src_object))
+ {
+ code_conversion_save (0, 0);
+ coding->src_pos = from;
+ coding->src_pos_byte = from_byte;
+ }
+ else if (BUFFERP (src_object))
+ {
+ code_conversion_save (0, 0);
+ set_buffer_internal (XBUFFER (src_object));
+ if (EQ (src_object, dst_object))
+ {
+ saved_pt = PT, saved_pt_byte = PT_BYTE;
+ coding->src_object = del_range_1 (from, to, 1, 1);
+ coding->src_pos = 0;
+ coding->src_pos_byte = 0;
+ }
+ else
+ {
+ if (from < GPT && to >= GPT)
+ move_gap_both (from, from_byte);
+ coding->src_pos = from;
+ coding->src_pos_byte = from_byte;
+ }
+ }
+ else
+ code_conversion_save (0, 0);
- /* Try to skip the heading and tailing ASCIIs. We can't skip them
- if we must run CCL program or there are compositions to
- encode. */
- coding->heading_ascii = 0;
- if (coding->type != coding_type_ccl
- && (! coding->cmp_data || coding->cmp_data->used == 0))
+ if (BUFFERP (dst_object))
{
- SHRINK_CONVERSION_REGION (&from, &to_byte, coding, SDATA (str),
- 1);
- if (from == to_byte)
+ coding->dst_object = dst_object;
+ if (EQ (src_object, dst_object))
{
- coding_free_composition_data (coding);
- goto no_need_of_encoding;
+ coding->dst_pos = from;
+ coding->dst_pos_byte = from_byte;
}
- shrinked_bytes = from + (SBYTES (str) - to_byte);
+ else
+ {
+ coding->dst_pos = BUF_PT (XBUFFER (dst_object));
+ coding->dst_pos_byte = BUF_PT_BYTE (XBUFFER (dst_object));
+ }
+ coding->dst_multibyte
+ = ! NILP (XBUFFER (dst_object)->enable_multibyte_characters);
+ }
+ else if (EQ (dst_object, Qt))
+ {
+ coding->dst_object = Qnil;
+ coding->dst_bytes = coding->src_chars;
+ if (coding->dst_bytes == 0)
+ coding->dst_bytes = 1;
+ coding->destination = (unsigned char *) xmalloc (coding->dst_bytes);
+ coding->dst_multibyte = 0;
+ }
+ else
+ {
+ coding->dst_object = Qnil;
+ coding->dst_multibyte = 0;
}
- len = encoding_buffer_size (coding, to_byte - from);
- allocate_conversion_buffer (buf, len);
+ encode_coding (coding);
- consumed = consumed_char = produced = produced_char = 0;
- while (1)
+ if (EQ (dst_object, Qt))
{
- result = encode_coding (coding, SDATA (str) + from + consumed,
- buf.data + produced, to_byte - from - consumed,
- buf.size - produced);
- consumed += coding->consumed;
- consumed_char += coding->consumed_char;
- produced += coding->produced;
- produced_char += coding->produced_char;
- if (result == CODING_FINISH_NORMAL
- || result == CODING_FINISH_INTERRUPT
- || (result == CODING_FINISH_INSUFFICIENT_SRC
- && coding->consumed == 0))
- break;
- /* Now result should be CODING_FINISH_INSUFFICIENT_DST. */
- extend_conversion_buffer (&buf);
- }
-
- coding->consumed = consumed;
- coding->consumed_char = consumed_char;
- coding->produced = produced;
- coding->produced_char = produced_char;
-
- newstr = make_uninit_string (produced + shrinked_bytes);
- if (from > 0)
- STRING_COPYIN (newstr, 0, SDATA (str), from);
- STRING_COPYIN (newstr, from, buf.data, produced);
- if (shrinked_bytes > from)
- STRING_COPYIN (newstr, from + produced,
- SDATA (str) + to_byte,
- shrinked_bytes - from);
-
- free_conversion_buffer (&buf);
- coding_free_composition_data (coding);
-
- return newstr;
-
- no_need_of_encoding:
- coding->consumed = SBYTES (str);
- coding->consumed_char = SCHARS (str);
- if (STRING_MULTIBYTE (str))
- {
- if (nocopy)
- /* We are sure that STR doesn't contain a multibyte
- character. */
- STRING_SET_UNIBYTE (str);
+ if (BUFFERP (coding->dst_object))
+ coding->dst_object = Fbuffer_string ();
else
{
- str = Fstring_as_unibyte (str);
- nocopy = 1;
+ coding->dst_object
+ = make_unibyte_string ((char *) coding->destination,
+ coding->produced);
+ xfree (coding->destination);
}
}
- coding->produced = SBYTES (str);
- coding->produced_char = SCHARS (str);
- return (nocopy ? str : Fcopy_sequence (str));
+
+ if (saved_pt >= 0)
+ {
+ /* This is the case of:
+ (BUFFERP (src_object) && EQ (src_object, dst_object))
+ As we have moved PT while replacing the original buffer
+ contents, we must recover it now. */
+ set_buffer_internal (XBUFFER (src_object));
+ if (saved_pt < from)
+ TEMP_SET_PT_BOTH (saved_pt, saved_pt_byte);
+ else if (saved_pt < from + chars)
+ TEMP_SET_PT_BOTH (from, from_byte);
+ else if (! NILP (current_buffer->enable_multibyte_characters))
+ TEMP_SET_PT_BOTH (saved_pt + (coding->produced_char - chars),
+ saved_pt_byte + (coding->produced - bytes));
+ else
+ TEMP_SET_PT_BOTH (saved_pt + (coding->produced - bytes),
+ saved_pt_byte + (coding->produced - bytes));
+ }
+
+ if (kill_src_buffer)
+ Fkill_buffer (coding->src_object);
+ unbind_to (count, Qnil);
+}
+
+
+Lisp_Object
+preferred_coding_system ()
+{
+ int id = coding_categories[coding_priorities[0]].id;
+
+ return CODING_ID_NAME (id);
}
\f
DEFUN ("coding-system-p", Fcoding_system_p, Scoding_system_p, 1, 1, 0,
doc: /* Return t if OBJECT is nil or a coding-system.
-See the documentation of `make-coding-system' for information
+See the documentation of `define-coding-system' for information
about coding-system objects. */)
(obj)
Lisp_Object obj;
{
- if (NILP (obj))
+ if (NILP (obj)
+ || CODING_SYSTEM_ID (obj) >= 0)
return Qt;
- if (!SYMBOLP (obj))
+ if (! SYMBOLP (obj)
+ || NILP (Fget (obj, Qcoding_system_define_form)))
return Qnil;
- if (! NILP (Fget (obj, Qcoding_system_define_form)))
- return Qt;
- /* Get coding-spec vector for OBJ. */
- obj = Fget (obj, Qcoding_system);
- return ((VECTORP (obj) && XVECTOR (obj)->size == 5)
- ? Qt : Qnil);
+ return Qt;
}
DEFUN ("read-non-nil-coding-system", Fread_non_nil_coding_system,
1, 1, 0,
doc: /* Check validity of CODING-SYSTEM.
If valid, return CODING-SYSTEM, else signal a `coding-system-error' error.
-It is valid if it is nil or a symbol with a non-nil `coding-system' property.
-The value of this property should be a vector of length 5. */)
- (coding_system)
+It is valid if it is nil or a symbol defined as a coding system by the
+function `define-coding-system'. */)
+ (coding_system)
Lisp_Object coding_system;
{
Lisp_Object define_form;
return coding_system;
xsignal1 (Qcoding_system_error, coding_system);
}
+
\f
+/* Detect how the bytes at SRC of length SRC_BYTES are encoded. If
+ HIGHEST is nonzero, return the coding system of the highest
+ priority among the detected coding systems. Otherwize return a
+ list of detected coding systems sorted by their priorities. If
+ MULTIBYTEP is nonzero, it is assumed that the bytes are in correct
+ multibyte form but contains only ASCII and eight-bit chars.
+ Otherwise, the bytes are raw bytes.
+
+ CODING-SYSTEM controls the detection as below:
+
+ If it is nil, detect both text-format and eol-format. If the
+ text-format part of CODING-SYSTEM is already specified
+ (e.g. `iso-latin-1'), detect only eol-format. If the eol-format
+ part of CODING-SYSTEM is already specified (e.g. `undecided-unix'),
+ detect only text-format. */
+
Lisp_Object
-detect_coding_system (src, src_bytes, highest, multibytep)
+detect_coding_system (src, src_chars, src_bytes, highest, multibytep,
+ coding_system)
const unsigned char *src;
- int src_bytes, highest;
+ int src_chars, src_bytes, highest;
int multibytep;
+ Lisp_Object coding_system;
{
- int coding_mask, eol_type;
- Lisp_Object val, tmp;
- int dummy;
+ const unsigned char *src_end = src + src_bytes;
+ Lisp_Object attrs, eol_type;
+ Lisp_Object val;
+ struct coding_system coding;
+ int id;
+ struct coding_detection_info detect_info;
+ enum coding_category base_category;
+
+ if (NILP (coding_system))
+ coding_system = Qundecided;
+ setup_coding_system (coding_system, &coding);
+ attrs = CODING_ID_ATTRS (coding.id);
+ eol_type = CODING_ID_EOL_TYPE (coding.id);
+ coding_system = CODING_ATTR_BASE_NAME (attrs);
+
+ coding.source = src;
+ coding.src_chars = src_chars;
+ coding.src_bytes = src_bytes;
+ coding.src_multibyte = multibytep;
+ coding.consumed = 0;
+ coding.mode |= CODING_MODE_LAST_BLOCK;
- coding_mask = detect_coding_mask (src, src_bytes, NULL, &dummy, multibytep);
- eol_type = detect_eol_type (src, src_bytes, &dummy);
- if (eol_type == CODING_EOL_INCONSISTENT)
- eol_type = CODING_EOL_UNDECIDED;
+ detect_info.checked = detect_info.found = detect_info.rejected = 0;
- if (!coding_mask)
+ /* At first, detect text-format if necessary. */
+ base_category = XINT (CODING_ATTR_CATEGORY (attrs));
+ if (base_category == coding_category_undecided)
{
- val = Qundecided;
- if (eol_type != CODING_EOL_UNDECIDED)
+ enum coding_category category;
+ struct coding_system *this;
+ int c, i;
+
+ /* Skip all ASCII bytes except for a few ISO2022 controls. */
+ for (i = 0; src < src_end; i++, src++)
+ {
+ c = *src;
+ if (c & 0x80)
+ break;
+ if (c < 0x20
+ && (c == ISO_CODE_ESC || c == ISO_CODE_SI || c == ISO_CODE_SO)
+ && ! inhibit_iso_escape_detection)
+ {
+ coding.head_ascii = src - coding.source;
+ if (detect_coding_iso_2022 (&coding, &detect_info))
+ {
+ /* We have scanned the whole data. */
+ if (! (detect_info.rejected & CATEGORY_MASK_ISO_7_ELSE))
+ /* We didn't find an 8-bit code. */
+ src = src_end;
+ break;
+ }
+ }
+ }
+ coding.head_ascii = src - coding.source;
+
+ if (src < src_end
+ || detect_info.found)
+ {
+ if (src == src_end)
+ /* As all bytes are 7-bit, we can ignore non-ISO-2022 codings. */
+ for (i = 0; i < coding_category_raw_text; i++)
+ {
+ category = coding_priorities[i];
+ this = coding_categories + category;
+ if (detect_info.found & (1 << category))
+ break;
+ }
+ else
+ for (i = 0; i < coding_category_raw_text; i++)
+ {
+ category = coding_priorities[i];
+ this = coding_categories + category;
+
+ if (this->id < 0)
+ {
+ /* No coding system of this category is defined. */
+ detect_info.rejected |= (1 << category);
+ }
+ else if (category >= coding_category_raw_text)
+ continue;
+ else if (detect_info.checked & (1 << category))
+ {
+ if (highest
+ && (detect_info.found & (1 << category)))
+ break;
+ }
+ else
+ {
+ if ((*(this->detector)) (&coding, &detect_info)
+ && highest
+ && (detect_info.found & (1 << category)))
+ {
+ if (category == coding_category_utf_16_auto)
+ {
+ if (detect_info.found & CATEGORY_MASK_UTF_16_LE)
+ category = coding_category_utf_16_le;
+ else
+ category = coding_category_utf_16_be;
+ }
+ break;
+ }
+ }
+ }
+ }
+
+ if (detect_info.rejected == CATEGORY_MASK_ANY)
+ {
+ detect_info.found = CATEGORY_MASK_RAW_TEXT;
+ id = coding_categories[coding_category_raw_text].id;
+ val = Fcons (make_number (id), Qnil);
+ }
+ else if (! detect_info.rejected && ! detect_info.found)
+ {
+ detect_info.found = CATEGORY_MASK_ANY;
+ id = coding_categories[coding_category_undecided].id;
+ val = Fcons (make_number (id), Qnil);
+ }
+ else if (highest)
+ {
+ if (detect_info.found)
+ {
+ detect_info.found = 1 << category;
+ val = Fcons (make_number (this->id), Qnil);
+ }
+ else
+ for (i = 0; i < coding_category_raw_text; i++)
+ if (! (detect_info.rejected & (1 << coding_priorities[i])))
+ {
+ detect_info.found = 1 << coding_priorities[i];
+ id = coding_categories[coding_priorities[i]].id;
+ val = Fcons (make_number (id), Qnil);
+ break;
+ }
+ }
+ else
{
- Lisp_Object val2;
- val2 = Fget (Qundecided, Qeol_type);
- if (VECTORP (val2))
- val = XVECTOR (val2)->contents[eol_type];
+ int mask = detect_info.rejected | detect_info.found;
+ int found = 0;
+ val = Qnil;
+
+ for (i = coding_category_raw_text - 1; i >= 0; i--)
+ {
+ category = coding_priorities[i];
+ if (! (mask & (1 << category)))
+ {
+ found |= 1 << category;
+ id = coding_categories[category].id;
+ if (id >= 0)
+ val = Fcons (make_number (id), val);
+ }
+ }
+ for (i = coding_category_raw_text - 1; i >= 0; i--)
+ {
+ category = coding_priorities[i];
+ if (detect_info.found & (1 << category))
+ {
+ id = coding_categories[category].id;
+ val = Fcons (make_number (id), val);
+ }
+ }
+ detect_info.found |= found;
}
- return (highest ? val : Fcons (val, Qnil));
}
-
- /* At first, gather possible coding systems in VAL. */
- val = Qnil;
- for (tmp = Vcoding_category_list; CONSP (tmp); tmp = XCDR (tmp))
+ else if (base_category == coding_category_utf_16_auto)
{
- Lisp_Object category_val, category_index;
-
- category_index = Fget (XCAR (tmp), Qcoding_category_index);
- category_val = Fsymbol_value (XCAR (tmp));
- if (!NILP (category_val)
- && NATNUMP (category_index)
- && (coding_mask & (1 << XFASTINT (category_index))))
+ if (detect_coding_utf_16 (&coding, &detect_info))
{
- val = Fcons (category_val, val);
- if (highest)
- break;
+ struct coding_system *this;
+
+ if (detect_info.found & CATEGORY_MASK_UTF_16_LE)
+ this = coding_categories + coding_category_utf_16_le;
+ else if (detect_info.found & CATEGORY_MASK_UTF_16_BE)
+ this = coding_categories + coding_category_utf_16_be;
+ else if (detect_info.rejected & CATEGORY_MASK_UTF_16_LE_NOSIG)
+ this = coding_categories + coding_category_utf_16_be_nosig;
+ else
+ this = coding_categories + coding_category_utf_16_le_nosig;
+ val = Fcons (make_number (this->id), Qnil);
}
}
- if (!highest)
- val = Fnreverse (val);
-
- /* Then, replace the elements with subsidiary coding systems. */
- for (tmp = val; CONSP (tmp); tmp = XCDR (tmp))
+ else
{
- if (eol_type != CODING_EOL_UNDECIDED
- && eol_type != CODING_EOL_INCONSISTENT)
- {
- Lisp_Object eol;
- eol = Fget (XCAR (tmp), Qeol_type);
- if (VECTORP (eol))
- XSETCAR (tmp, XVECTOR (eol)->contents[eol_type]);
- }
+ detect_info.found = 1 << XINT (CODING_ATTR_CATEGORY (attrs));
+ val = Fcons (make_number (coding.id), Qnil);
}
+
+ /* Then, detect eol-format if necessary. */
+ {
+ int normal_eol = -1, utf_16_be_eol = -1, utf_16_le_eol;
+ Lisp_Object tail;
+
+ if (VECTORP (eol_type))
+ {
+ if (detect_info.found & ~CATEGORY_MASK_UTF_16)
+ normal_eol = detect_eol (coding.source, src_bytes,
+ coding_category_raw_text);
+ if (detect_info.found & (CATEGORY_MASK_UTF_16_BE
+ | CATEGORY_MASK_UTF_16_BE_NOSIG))
+ utf_16_be_eol = detect_eol (coding.source, src_bytes,
+ coding_category_utf_16_be);
+ if (detect_info.found & (CATEGORY_MASK_UTF_16_LE
+ | CATEGORY_MASK_UTF_16_LE_NOSIG))
+ utf_16_le_eol = detect_eol (coding.source, src_bytes,
+ coding_category_utf_16_le);
+ }
+ else
+ {
+ if (EQ (eol_type, Qunix))
+ normal_eol = utf_16_be_eol = utf_16_le_eol = EOL_SEEN_LF;
+ else if (EQ (eol_type, Qdos))
+ normal_eol = utf_16_be_eol = utf_16_le_eol = EOL_SEEN_CRLF;
+ else
+ normal_eol = utf_16_be_eol = utf_16_le_eol = EOL_SEEN_CR;
+ }
+
+ for (tail = val; CONSP (tail); tail = XCDR (tail))
+ {
+ enum coding_category category;
+ int this_eol;
+
+ id = XINT (XCAR (tail));
+ attrs = CODING_ID_ATTRS (id);
+ category = XINT (CODING_ATTR_CATEGORY (attrs));
+ eol_type = CODING_ID_EOL_TYPE (id);
+ if (VECTORP (eol_type))
+ {
+ if (category == coding_category_utf_16_be
+ || category == coding_category_utf_16_be_nosig)
+ this_eol = utf_16_be_eol;
+ else if (category == coding_category_utf_16_le
+ || category == coding_category_utf_16_le_nosig)
+ this_eol = utf_16_le_eol;
+ else
+ this_eol = normal_eol;
+
+ if (this_eol == EOL_SEEN_LF)
+ XSETCAR (tail, AREF (eol_type, 0));
+ else if (this_eol == EOL_SEEN_CRLF)
+ XSETCAR (tail, AREF (eol_type, 1));
+ else if (this_eol == EOL_SEEN_CR)
+ XSETCAR (tail, AREF (eol_type, 2));
+ else
+ XSETCAR (tail, CODING_ID_NAME (id));
+ }
+ else
+ XSETCAR (tail, CODING_ID_NAME (id));
+ }
+ }
+
return (highest ? XCAR (val) : val);
}
+
DEFUN ("detect-coding-region", Fdetect_coding_region, Sdetect_coding_region,
2, 3, 0,
- doc: /* Detect how the byte sequence in the region is encoded.
-Return a list of possible coding systems used on decoding a byte
-sequence containing the bytes in the region between START and END when
-the coding system `undecided' is specified. The list is ordered by
-priority decided in the current language environment.
+ doc: /* Detect coding system of the text in the region between START and END.
+Return a list of possible coding systems ordered by priority.
If only ASCII characters are found (except for such ISO-2022 control
characters ISO-2022 as ESC), it returns a list of single element
{
int from, to;
int from_byte, to_byte;
- int include_anchor_byte = 0;
CHECK_NUMBER_COERCE_MARKER (start);
CHECK_NUMBER_COERCE_MARKER (end);
if (from < GPT && to >= GPT)
move_gap_both (to, to_byte);
- /* If we an anchor byte `\0' follows the region, we include it in
- the detecting source. Then code detectors can handle the tailing
- byte sequence more accurately.
- Fix me: This is not a perfect solution. It is better that we
- add one more argument, say LAST_BLOCK, to all detect_coding_XXX.
- */
- if (to == Z || (to == GPT && GAP_SIZE > 0))
- include_anchor_byte = 1;
return detect_coding_system (BYTE_POS_ADDR (from_byte),
- to_byte - from_byte + include_anchor_byte,
+ to - from, to_byte - from_byte,
!NILP (highest),
!NILP (current_buffer
- ->enable_multibyte_characters));
+ ->enable_multibyte_characters),
+ Qnil);
}
DEFUN ("detect-coding-string", Fdetect_coding_string, Sdetect_coding_string,
1, 2, 0,
- doc: /* Detect how the byte sequence in STRING is encoded.
-Return a list of possible coding systems used on decoding a byte
-sequence containing the bytes in STRING when the coding system
-`undecided' is specified. The list is ordered by priority decided in
-the current language environment.
+ doc: /* Detect coding system of the text in STRING.
+Return a list of possible coding systems ordered by priority.
If only ASCII characters are found (except for such ISO-2022 control
characters ISO-2022 as ESC), it returns a list of single element
CHECK_STRING (string);
return detect_coding_system (SDATA (string),
- /* "+ 1" is to include the anchor byte
- `\0'. With this, code detectors can
- handle the tailing bytes more
- accurately. */
- SBYTES (string) + 1,
- !NILP (highest),
- STRING_MULTIBYTE (string));
+ SCHARS (string), SBYTES (string),
+ !NILP (highest), STRING_MULTIBYTE (string),
+ Qnil);
}
-/* Subroutine for Ffind_coding_systems_region_internal.
- Return a list of coding systems that safely encode the multibyte
- text between P and PEND. SAFE_CODINGS, if non-nil, is an alist of
- possible coding systems. If it is nil, it means that we have not
- yet found any coding systems.
-
- WORK_TABLE a char-table of which element is set to t once the
- element is looked up.
-
- If a non-ASCII single byte char is found, set
- *single_byte_char_found to 1. */
-
-static Lisp_Object
-find_safe_codings (p, pend, safe_codings, work_table, single_byte_char_found)
- unsigned char *p, *pend;
- Lisp_Object safe_codings, work_table;
- int *single_byte_char_found;
+static INLINE int
+char_encodable_p (c, attrs)
+ int c;
+ Lisp_Object attrs;
{
- int c, len;
- Lisp_Object val, ch;
- Lisp_Object prev, tail;
+ Lisp_Object tail;
+ struct charset *charset;
+ Lisp_Object translation_table;
- if (NILP (safe_codings))
- goto done_safe_codings;
- while (p < pend)
+ translation_table = CODING_ATTR_TRANS_TBL (attrs);
+ if (! NILP (translation_table))
+ c = translate_char (translation_table, c);
+ for (tail = CODING_ATTR_CHARSET_LIST (attrs);
+ CONSP (tail); tail = XCDR (tail))
{
- c = STRING_CHAR_AND_LENGTH (p, pend - p, len);
- p += len;
- if (ASCII_BYTE_P (c))
- /* We can ignore ASCII characters here. */
- continue;
- if (SINGLE_BYTE_CHAR_P (c))
- *single_byte_char_found = 1;
- /* Check the safe coding systems for C. */
- ch = make_number (c);
- val = Faref (work_table, ch);
- if (EQ (val, Qt))
- /* This element was already checked. Ignore it. */
- continue;
- /* Remember that we checked this element. */
- Faset (work_table, ch, Qt);
-
- for (prev = tail = safe_codings; CONSP (tail); tail = XCDR (tail))
- {
- Lisp_Object elt, translation_table, hash_table, accept_latin_extra;
- int encodable;
-
- elt = XCAR (tail);
- if (CONSP (XCDR (elt)))
- {
- /* This entry has this format now:
- ( CODING SAFE-CHARS TRANSLATION-TABLE HASH-TABLE
- ACCEPT-LATIN-EXTRA ) */
- val = XCDR (elt);
- encodable = ! NILP (Faref (XCAR (val), ch));
- if (! encodable)
- {
- val = XCDR (val);
- translation_table = XCAR (val);
- hash_table = XCAR (XCDR (val));
- accept_latin_extra = XCAR (XCDR (XCDR (val)));
- }
- }
- else
- {
- /* This entry has this format now: ( CODING . SAFE-CHARS) */
- encodable = ! NILP (Faref (XCDR (elt), ch));
- if (! encodable)
- {
- /* Transform the format to:
- ( CODING SAFE-CHARS TRANSLATION-TABLE HASH-TABLE
- ACCEPT-LATIN-EXTRA ) */
- val = Fget (XCAR (elt), Qcoding_system);
- translation_table
- = Fplist_get (AREF (val, 3),
- Qtranslation_table_for_encode);
- if (SYMBOLP (translation_table))
- translation_table = Fget (translation_table,
- Qtranslation_table);
- hash_table
- = (CHAR_TABLE_P (translation_table)
- ? XCHAR_TABLE (translation_table)->extras[1]
- : Qnil);
- accept_latin_extra
- = ((EQ (AREF (val, 0), make_number (2))
- && VECTORP (AREF (val, 4)))
- ? AREF (AREF (val, 4), 16)
- : Qnil);
- XSETCAR (tail, list5 (XCAR (elt), XCDR (elt),
- translation_table, hash_table,
- accept_latin_extra));
- }
- }
-
- if (! encodable
- && ((CHAR_TABLE_P (translation_table)
- && ! NILP (Faref (translation_table, ch)))
- || (HASH_TABLE_P (hash_table)
- && ! NILP (Fgethash (ch, hash_table, Qnil)))
- || (SINGLE_BYTE_CHAR_P (c)
- && ! NILP (accept_latin_extra)
- && VECTORP (Vlatin_extra_code_table)
- && ! NILP (AREF (Vlatin_extra_code_table, c)))))
- encodable = 1;
- if (encodable)
- prev = tail;
- else
- {
- /* Exclude this coding system from SAFE_CODINGS. */
- if (EQ (tail, safe_codings))
- {
- safe_codings = XCDR (safe_codings);
- if (NILP (safe_codings))
- goto done_safe_codings;
- }
- else
- XSETCDR (prev, XCDR (tail));
- }
- }
+ charset = CHARSET_FROM_ID (XINT (XCAR (tail)));
+ if (CHAR_CHARSET_P (c, charset))
+ break;
}
-
- done_safe_codings:
- /* If the above loop was terminated before P reaches PEND, it means
- SAFE_CODINGS was set to nil. If we have not yet found an
- non-ASCII single-byte char, check it now. */
- if (! *single_byte_char_found)
- while (p < pend)
- {
- c = STRING_CHAR_AND_LENGTH (p, pend - p, len);
- p += len;
- if (! ASCII_BYTE_P (c)
- && SINGLE_BYTE_CHAR_P (c))
- {
- *single_byte_char_found = 1;
- break;
- }
- }
- return safe_codings;
+ return (! NILP (tail));
}
+
+/* Return a list of coding systems that safely encode the text between
+ START and END. If EXCLUDE is non-nil, it is a list of coding
+ systems not to check. The returned list doesn't contain any such
+ coding systems. In any case, if the text contains only ASCII or is
+ unibyte, return t. */
+
DEFUN ("find-coding-systems-region-internal",
Ffind_coding_systems_region_internal,
- Sfind_coding_systems_region_internal, 2, 2, 0,
+ Sfind_coding_systems_region_internal, 2, 3, 0,
doc: /* Internal use only. */)
- (start, end)
- Lisp_Object start, end;
+ (start, end, exclude)
+ Lisp_Object start, end, exclude;
{
- Lisp_Object work_table, safe_codings;
- int non_ascii_p = 0;
- int single_byte_char_found = 0;
- const unsigned char *p1, *p1end, *p2, *p2end, *p;
+ Lisp_Object coding_attrs_list, safe_codings;
+ EMACS_INT start_byte, end_byte;
+ const unsigned char *p, *pbeg, *pend;
+ int c;
+ Lisp_Object tail, elt;
if (STRINGP (start))
{
- if (!STRING_MULTIBYTE (start))
+ if (!STRING_MULTIBYTE (start)
+ || SCHARS (start) == SBYTES (start))
return Qt;
- p1 = SDATA (start), p1end = p1 + SBYTES (start);
- p2 = p2end = p1end;
- if (SCHARS (start) != SBYTES (start))
- non_ascii_p = 1;
+ start_byte = 0;
+ end_byte = SBYTES (start);
}
else
{
- int from, to, stop;
-
CHECK_NUMBER_COERCE_MARKER (start);
CHECK_NUMBER_COERCE_MARKER (end);
if (XINT (start) < BEG || XINT (end) > Z || XINT (start) > XINT (end))
args_out_of_range (start, end);
if (NILP (current_buffer->enable_multibyte_characters))
return Qt;
- from = CHAR_TO_BYTE (XINT (start));
- to = CHAR_TO_BYTE (XINT (end));
- stop = from < GPT_BYTE && GPT_BYTE < to ? GPT_BYTE : to;
- p1 = BYTE_POS_ADDR (from), p1end = p1 + (stop - from);
- if (stop == to)
- p2 = p2end = p1end;
- else
- p2 = BYTE_POS_ADDR (stop), p2end = p2 + (to - stop);
- if (XINT (end) - XINT (start) != to - from)
- non_ascii_p = 1;
- }
+ start_byte = CHAR_TO_BYTE (XINT (start));
+ end_byte = CHAR_TO_BYTE (XINT (end));
+ if (XINT (end) - XINT (start) == end_byte - start_byte)
+ return Qt;
- if (!non_ascii_p)
- {
- /* We are sure that the text contains no multibyte character.
- Check if it contains eight-bit-graphic. */
- p = p1;
- for (p = p1; p < p1end && ASCII_BYTE_P (*p); p++);
- if (p == p1end)
+ if (XINT (start) < GPT && XINT (end) > GPT)
{
- for (p = p2; p < p2end && ASCII_BYTE_P (*p); p++);
- if (p == p2end)
- return Qt;
+ if ((GPT - XINT (start)) < (XINT (end) - GPT))
+ move_gap_both (XINT (start), start_byte);
+ else
+ move_gap_both (XINT (end), end_byte);
}
}
- /* The text contains non-ASCII characters. */
+ coding_attrs_list = Qnil;
+ for (tail = Vcoding_system_list; CONSP (tail); tail = XCDR (tail))
+ if (NILP (exclude)
+ || NILP (Fmemq (XCAR (tail), exclude)))
+ {
+ Lisp_Object attrs;
- work_table = Fmake_char_table (Qchar_coding_system, Qnil);
- safe_codings = Fcopy_sequence (XCDR (Vcoding_system_safe_chars));
+ attrs = AREF (CODING_SYSTEM_SPEC (XCAR (tail)), 0);
+ if (EQ (XCAR (tail), CODING_ATTR_BASE_NAME (attrs))
+ && ! EQ (CODING_ATTR_TYPE (attrs), Qundecided))
+ {
+ ASET (attrs, coding_attr_trans_tbl,
+ get_translation_table (attrs, 1, NULL));
+ coding_attrs_list = Fcons (attrs, coding_attrs_list);
+ }
+ }
- safe_codings = find_safe_codings (p1, p1end, safe_codings, work_table,
- &single_byte_char_found);
- if (p2 < p2end)
- safe_codings = find_safe_codings (p2, p2end, safe_codings, work_table,
- &single_byte_char_found);
- if (EQ (safe_codings, XCDR (Vcoding_system_safe_chars)))
- safe_codings = Qt;
+ if (STRINGP (start))
+ p = pbeg = SDATA (start);
else
- {
- /* Turn safe_codings to a list of coding systems... */
- Lisp_Object val;
-
- if (single_byte_char_found)
- /* ... and append these for eight-bit chars. */
- val = Fcons (Qraw_text,
- Fcons (Qemacs_mule, Fcons (Qno_conversion, Qnil)));
- else
- /* ... and append generic coding systems. */
- val = Fcopy_sequence (XCAR (Vcoding_system_safe_chars));
-
- for (; CONSP (safe_codings); safe_codings = XCDR (safe_codings))
- val = Fcons (XCAR (XCAR (safe_codings)), val);
- safe_codings = val;
- }
-
- return safe_codings;
-}
-
-
-/* Search from position POS for such characters that are unencodable
- accoding to SAFE_CHARS, and return a list of their positions. P
- points where in the memory the character at POS exists. Limit the
- search at PEND or when Nth unencodable characters are found.
-
- If SAFE_CHARS is a char table, an element for an unencodable
- character is nil.
-
- If SAFE_CHARS is nil, all non-ASCII characters are unencodable.
+ p = pbeg = BYTE_POS_ADDR (start_byte);
+ pend = p + (end_byte - start_byte);
- Otherwise, SAFE_CHARS is t, and only eight-bit-contrl and
- eight-bit-graphic characters are unencodable. */
+ while (p < pend && ASCII_BYTE_P (*p)) p++;
+ while (p < pend && ASCII_BYTE_P (*(pend - 1))) pend--;
-static Lisp_Object
-unencodable_char_position (safe_chars, pos, p, pend, n)
- Lisp_Object safe_chars;
- int pos;
- unsigned char *p, *pend;
- int n;
-{
- Lisp_Object pos_list;
-
- pos_list = Qnil;
while (p < pend)
{
- int len;
- int c = STRING_CHAR_AND_LENGTH (p, MAX_MULTIBYTE_LENGTH, len);
-
- if (c >= 128
- && (CHAR_TABLE_P (safe_chars)
- ? NILP (CHAR_TABLE_REF (safe_chars, c))
- : (NILP (safe_chars) || c < 256)))
+ if (ASCII_BYTE_P (*p))
+ p++;
+ else
{
- pos_list = Fcons (make_number (pos), pos_list);
- if (--n <= 0)
- break;
+ c = STRING_CHAR_ADVANCE (p);
+
+ charset_map_loaded = 0;
+ for (tail = coding_attrs_list; CONSP (tail);)
+ {
+ elt = XCAR (tail);
+ if (NILP (elt))
+ tail = XCDR (tail);
+ else if (char_encodable_p (c, elt))
+ tail = XCDR (tail);
+ else if (CONSP (XCDR (tail)))
+ {
+ XSETCAR (tail, XCAR (XCDR (tail)));
+ XSETCDR (tail, XCDR (XCDR (tail)));
+ }
+ else
+ {
+ XSETCAR (tail, Qnil);
+ tail = XCDR (tail);
+ }
+ }
+ if (charset_map_loaded)
+ {
+ EMACS_INT p_offset = p - pbeg, pend_offset = pend - pbeg;
+
+ if (STRINGP (start))
+ pbeg = SDATA (start);
+ else
+ pbeg = BYTE_POS_ADDR (start_byte);
+ p = pbeg + p_offset;
+ pend = pbeg + pend_offset;
+ }
}
- pos++;
- p += len;
}
- return Fnreverse (pos_list);
+
+ safe_codings = list2 (Qraw_text, Qno_conversion);
+ for (tail = coding_attrs_list; CONSP (tail); tail = XCDR (tail))
+ if (! NILP (XCAR (tail)))
+ safe_codings = Fcons (CODING_ATTR_BASE_NAME (XCAR (tail)), safe_codings);
+
+ return safe_codings;
}
Lisp_Object start, end, coding_system, count, string;
{
int n;
- Lisp_Object safe_chars;
struct coding_system coding;
+ Lisp_Object attrs, charset_list, translation_table;
Lisp_Object positions;
int from, to;
- unsigned char *p, *pend;
+ const unsigned char *p, *stop, *pend;
+ int ascii_compatible;
+
+ setup_coding_system (Fcheck_coding_system (coding_system), &coding);
+ attrs = CODING_ID_ATTRS (coding.id);
+ if (EQ (CODING_ATTR_TYPE (attrs), Qraw_text))
+ return Qnil;
+ ascii_compatible = ! NILP (CODING_ATTR_ASCII_COMPAT (attrs));
+ charset_list = CODING_ATTR_CHARSET_LIST (attrs);
+ translation_table = get_translation_table (attrs, 1, NULL);
if (NILP (string))
{
validate_region (&start, &end);
from = XINT (start);
to = XINT (end);
- if (NILP (current_buffer->enable_multibyte_characters))
+ if (NILP (current_buffer->enable_multibyte_characters)
+ || (ascii_compatible
+ && (to - from) == (CHAR_TO_BYTE (to) - (CHAR_TO_BYTE (from)))))
return Qnil;
p = CHAR_POS_ADDR (from);
- if (to == GPT)
- pend = GPT_ADDR;
+ pend = CHAR_POS_ADDR (to);
+ if (from < GPT && to >= GPT)
+ stop = GPT_ADDR;
else
- pend = CHAR_POS_ADDR (to);
+ stop = pend;
}
else
{
if (! STRING_MULTIBYTE (string))
return Qnil;
p = SDATA (string) + string_char_to_byte (string, from);
- pend = SDATA (string) + string_char_to_byte (string, to);
+ stop = pend = SDATA (string) + string_char_to_byte (string, to);
+ if (ascii_compatible && (to - from) == (pend - p))
+ return Qnil;
}
- setup_coding_system (Fcheck_coding_system (coding_system), &coding);
-
if (NILP (count))
n = 1;
else
n = XINT (count);
}
- if (coding.type == coding_type_no_conversion
- || coding.type == coding_type_raw_text)
- return Qnil;
+ positions = Qnil;
+ while (1)
+ {
+ int c;
- if (coding.type == coding_type_undecided)
- safe_chars = Qnil;
- else
- safe_chars = coding_safe_chars (coding_system);
+ if (ascii_compatible)
+ while (p < stop && ASCII_BYTE_P (*p))
+ p++, from++;
+ if (p >= stop)
+ {
+ if (p >= pend)
+ break;
+ stop = pend;
+ p = GAP_END_ADDR;
+ }
+
+ c = STRING_CHAR_ADVANCE (p);
+ if (! (ASCII_CHAR_P (c) && ascii_compatible)
+ && ! char_charset (translate_char (translation_table, c),
+ charset_list, NULL))
+ {
+ positions = Fcons (make_number (from), positions);
+ n--;
+ if (n == 0)
+ break;
+ }
+
+ from++;
+ }
+
+ return (NILP (count) ? Fcar (positions) : Fnreverse (positions));
+}
+
+
+DEFUN ("check-coding-systems-region", Fcheck_coding_systems_region,
+ Scheck_coding_systems_region, 3, 3, 0,
+ doc: /* Check if the region is encodable by coding systems.
- if (STRINGP (string)
- || from >= GPT || to <= GPT)
- positions = unencodable_char_position (safe_chars, from, p, pend, n);
+START and END are buffer positions specifying the region.
+CODING-SYSTEM-LIST is a list of coding systems to check.
+
+The value is an alist ((CODING-SYSTEM POS0 POS1 ...) ...), where
+CODING-SYSTEM is a member of CODING-SYSTEM-LIst and can't encode the
+whole region, POS0, POS1, ... are buffer positions where non-encodable
+characters are found.
+
+If all coding systems in CODING-SYSTEM-LIST can encode the region, the
+value is nil.
+
+START may be a string. In that case, check if the string is
+encodable, and the value contains indices to the string instead of
+buffer positions. END is ignored. */)
+ (start, end, coding_system_list)
+ Lisp_Object start, end, coding_system_list;
+{
+ Lisp_Object list;
+ EMACS_INT start_byte, end_byte;
+ int pos;
+ const unsigned char *p, *pbeg, *pend;
+ int c;
+ Lisp_Object tail, elt, attrs;
+
+ if (STRINGP (start))
+ {
+ if (!STRING_MULTIBYTE (start)
+ && SCHARS (start) != SBYTES (start))
+ return Qnil;
+ start_byte = 0;
+ end_byte = SBYTES (start);
+ pos = 0;
+ }
else
{
- Lisp_Object args[2];
+ CHECK_NUMBER_COERCE_MARKER (start);
+ CHECK_NUMBER_COERCE_MARKER (end);
+ if (XINT (start) < BEG || XINT (end) > Z || XINT (start) > XINT (end))
+ args_out_of_range (start, end);
+ if (NILP (current_buffer->enable_multibyte_characters))
+ return Qnil;
+ start_byte = CHAR_TO_BYTE (XINT (start));
+ end_byte = CHAR_TO_BYTE (XINT (end));
+ if (XINT (end) - XINT (start) == end_byte - start_byte)
+ return Qt;
+
+ if (XINT (start) < GPT && XINT (end) > GPT)
+ {
+ if ((GPT - XINT (start)) < (XINT (end) - GPT))
+ move_gap_both (XINT (start), start_byte);
+ else
+ move_gap_both (XINT (end), end_byte);
+ }
+ pos = XINT (start);
+ }
+
+ list = Qnil;
+ for (tail = coding_system_list; CONSP (tail); tail = XCDR (tail))
+ {
+ elt = XCAR (tail);
+ attrs = AREF (CODING_SYSTEM_SPEC (elt), 0);
+ ASET (attrs, coding_attr_trans_tbl,
+ get_translation_table (attrs, 1, NULL));
+ list = Fcons (Fcons (elt, Fcons (attrs, Qnil)), list);
+ }
+
+ if (STRINGP (start))
+ p = pbeg = SDATA (start);
+ else
+ p = pbeg = BYTE_POS_ADDR (start_byte);
+ pend = p + (end_byte - start_byte);
- args[0] = unencodable_char_position (safe_chars, from, p, GPT_ADDR, n);
- n -= XINT (Flength (args[0]));
- if (n <= 0)
- positions = args[0];
+ while (p < pend && ASCII_BYTE_P (*p)) p++, pos++;
+ while (p < pend && ASCII_BYTE_P (*(pend - 1))) pend--;
+
+ while (p < pend)
+ {
+ if (ASCII_BYTE_P (*p))
+ p++;
else
{
- args[1] = unencodable_char_position (safe_chars, GPT, GAP_END_ADDR,
- pend, n);
- positions = Fappend (2, args);
+ c = STRING_CHAR_ADVANCE (p);
+
+ charset_map_loaded = 0;
+ for (tail = list; CONSP (tail); tail = XCDR (tail))
+ {
+ elt = XCDR (XCAR (tail));
+ if (! char_encodable_p (c, XCAR (elt)))
+ XSETCDR (elt, Fcons (make_number (pos), XCDR (elt)));
+ }
+ if (charset_map_loaded)
+ {
+ EMACS_INT p_offset = p - pbeg, pend_offset = pend - pbeg;
+
+ if (STRINGP (start))
+ pbeg = SDATA (start);
+ else
+ pbeg = BYTE_POS_ADDR (start_byte);
+ p = pbeg + p_offset;
+ pend = pbeg + pend_offset;
+ }
}
+ pos++;
+ }
+
+ tail = list;
+ list = Qnil;
+ for (; CONSP (tail); tail = XCDR (tail))
+ {
+ elt = XCAR (tail);
+ if (CONSP (XCDR (XCDR (elt))))
+ list = Fcons (Fcons (XCAR (elt), Fnreverse (XCDR (XCDR (elt)))),
+ list);
}
- return (NILP (count) ? Fcar (positions) : positions);
+ return list;
}
Lisp_Object
-code_convert_region1 (start, end, coding_system, encodep)
- Lisp_Object start, end, coding_system;
- int encodep;
+code_convert_region (start, end, coding_system, dst_object, encodep, norecord)
+ Lisp_Object start, end, coding_system, dst_object;
+ int encodep, norecord;
{
struct coding_system coding;
- int from, to;
+ EMACS_INT from, from_byte, to, to_byte;
+ Lisp_Object src_object;
CHECK_NUMBER_COERCE_MARKER (start);
CHECK_NUMBER_COERCE_MARKER (end);
- CHECK_SYMBOL (coding_system);
+ if (NILP (coding_system))
+ coding_system = Qno_conversion;
+ else
+ CHECK_CODING_SYSTEM (coding_system);
+ src_object = Fcurrent_buffer ();
+ if (NILP (dst_object))
+ dst_object = src_object;
+ else if (! EQ (dst_object, Qt))
+ CHECK_BUFFER (dst_object);
validate_region (&start, &end);
from = XFASTINT (start);
+ from_byte = CHAR_TO_BYTE (from);
to = XFASTINT (end);
+ to_byte = CHAR_TO_BYTE (to);
- if (NILP (coding_system))
- return make_number (to - from);
-
- if (setup_coding_system (Fcheck_coding_system (coding_system), &coding) < 0)
- error ("Invalid coding system: %s", SDATA (SYMBOL_NAME (coding_system)));
-
+ setup_coding_system (coding_system, &coding);
coding.mode |= CODING_MODE_LAST_BLOCK;
- coding.src_multibyte = coding.dst_multibyte
- = !NILP (current_buffer->enable_multibyte_characters);
- code_convert_region (from, CHAR_TO_BYTE (from), to, CHAR_TO_BYTE (to),
- &coding, encodep, 1);
- Vlast_coding_system_used = coding.symbol;
- return make_number (coding.produced_char);
+
+ if (encodep)
+ encode_coding_object (&coding, src_object, from, from_byte, to, to_byte,
+ dst_object);
+ else
+ decode_coding_object (&coding, src_object, from, from_byte, to, to_byte,
+ dst_object);
+ if (! norecord)
+ Vlast_coding_system_used = CODING_ID_NAME (coding.id);
+
+ return (BUFFERP (dst_object)
+ ? make_number (coding.produced_char)
+ : coding.dst_object);
}
+
DEFUN ("decode-coding-region", Fdecode_coding_region, Sdecode_coding_region,
- 3, 3, "r\nzCoding system: ",
+ 3, 4, "r\nzCoding system: ",
doc: /* Decode the current region from the specified coding system.
-When called from a program, takes three arguments:
-START, END, and CODING-SYSTEM. START and END are buffer positions.
+When called from a program, takes four arguments:
+ START, END, CODING-SYSTEM, and DESTINATION.
+START and END are buffer positions.
+
+Optional 4th arguments DESTINATION specifies where the decoded text goes.
+If nil, the region between START and END is replaced by the decoded text.
+If buffer, the decoded text is inserted in the buffer.
+If t, the decoded text is returned.
+
This function sets `last-coding-system-used' to the precise coding system
used (which may be different from CODING-SYSTEM if CODING-SYSTEM is
not fully specified.)
It returns the length of the decoded text. */)
- (start, end, coding_system)
- Lisp_Object start, end, coding_system;
+ (start, end, coding_system, destination)
+ Lisp_Object start, end, coding_system, destination;
{
- return code_convert_region1 (start, end, coding_system, 0);
+ return code_convert_region (start, end, coding_system, destination, 0, 0);
}
DEFUN ("encode-coding-region", Fencode_coding_region, Sencode_coding_region,
- 3, 3, "r\nzCoding system: ",
- doc: /* Encode the current region into the specified coding system.
+ 3, 4, "r\nzCoding system: ",
+ doc: /* Encode the current region by specified coding system.
When called from a program, takes three arguments:
START, END, and CODING-SYSTEM. START and END are buffer positions.
+
+Optional 4th arguments DESTINATION specifies where the encoded text goes.
+If nil, the region between START and END is replace by the encoded text.
+If buffer, the encoded text is inserted in the buffer.
+If t, the encoded text is returned.
+
This function sets `last-coding-system-used' to the precise coding system
used (which may be different from CODING-SYSTEM if CODING-SYSTEM is
not fully specified.)
It returns the length of the encoded text. */)
- (start, end, coding_system)
- Lisp_Object start, end, coding_system;
+ (start, end, coding_system, destination)
+ Lisp_Object start, end, coding_system, destination;
{
- return code_convert_region1 (start, end, coding_system, 1);
+ return code_convert_region (start, end, coding_system, destination, 1, 0);
}
Lisp_Object
-code_convert_string1 (string, coding_system, nocopy, encodep)
- Lisp_Object string, coding_system, nocopy;
- int encodep;
+code_convert_string (string, coding_system, dst_object,
+ encodep, nocopy, norecord)
+ Lisp_Object string, coding_system, dst_object;
+ int encodep, nocopy, norecord;
{
struct coding_system coding;
+ EMACS_INT chars, bytes;
CHECK_STRING (string);
- CHECK_SYMBOL (coding_system);
-
if (NILP (coding_system))
- return (NILP (nocopy) ? Fcopy_sequence (string) : string);
+ {
+ if (! norecord)
+ Vlast_coding_system_used = Qno_conversion;
+ if (NILP (dst_object))
+ return (nocopy ? Fcopy_sequence (string) : string);
+ }
- if (setup_coding_system (Fcheck_coding_system (coding_system), &coding) < 0)
- error ("Invalid coding system: %s", SDATA (SYMBOL_NAME (coding_system)));
+ if (NILP (coding_system))
+ coding_system = Qno_conversion;
+ else
+ CHECK_CODING_SYSTEM (coding_system);
+ if (NILP (dst_object))
+ dst_object = Qt;
+ else if (! EQ (dst_object, Qt))
+ CHECK_BUFFER (dst_object);
+ setup_coding_system (coding_system, &coding);
coding.mode |= CODING_MODE_LAST_BLOCK;
- string = (encodep
- ? encode_coding_string (string, &coding, !NILP (nocopy))
- : decode_coding_string (string, &coding, !NILP (nocopy)));
- Vlast_coding_system_used = coding.symbol;
-
- return string;
-}
+ chars = SCHARS (string);
+ bytes = SBYTES (string);
+ if (encodep)
+ encode_coding_object (&coding, string, 0, 0, chars, bytes, dst_object);
+ else
+ decode_coding_object (&coding, string, 0, 0, chars, bytes, dst_object);
+ if (! norecord)
+ Vlast_coding_system_used = CODING_ID_NAME (coding.id);
-DEFUN ("decode-coding-string", Fdecode_coding_string, Sdecode_coding_string,
- 2, 3, 0,
- doc: /* Decode STRING which is encoded in CODING-SYSTEM, and return the result.
-Optional arg NOCOPY non-nil means it is OK to return STRING itself
-if the decoding operation is trivial.
-This function sets `last-coding-system-used' to the precise coding system
-used (which may be different from CODING-SYSTEM if CODING-SYSTEM is
-not fully specified.) */)
- (string, coding_system, nocopy)
- Lisp_Object string, coding_system, nocopy;
-{
- return code_convert_string1 (string, coding_system, nocopy, 0);
+ return (BUFFERP (dst_object)
+ ? make_number (coding.produced_char)
+ : coding.dst_object);
}
-DEFUN ("encode-coding-string", Fencode_coding_string, Sencode_coding_string,
- 2, 3, 0,
- doc: /* Encode STRING to CODING-SYSTEM, and return the result.
-Optional arg NOCOPY non-nil means it is OK to return STRING itself
-if the encoding operation is trivial.
-This function sets `last-coding-system-used' to the precise coding system
-used (which may be different from CODING-SYSTEM if CODING-SYSTEM is
-not fully specified.) */)
- (string, coding_system, nocopy)
- Lisp_Object string, coding_system, nocopy;
-{
- return code_convert_string1 (string, coding_system, nocopy, 1);
-}
/* Encode or decode STRING according to CODING_SYSTEM.
Do not set Vlast_coding_system_used.
Lisp_Object string, coding_system;
int encodep;
{
- struct coding_system coding;
+ return code_convert_string (string, coding_system, Qt, encodep, 0, 1);
+}
- CHECK_STRING (string);
- CHECK_SYMBOL (coding_system);
- if (NILP (coding_system))
- return string;
+DEFUN ("decode-coding-string", Fdecode_coding_string, Sdecode_coding_string,
+ 2, 4, 0,
+ doc: /* Decode STRING which is encoded in CODING-SYSTEM, and return the result.
+
+Optional third arg NOCOPY non-nil means it is OK to return STRING itself
+if the decoding operation is trivial.
+
+Optional fourth arg BUFFER non-nil meant that the decoded text is
+inserted in BUFFER instead of returned as a string. In this case,
+the return value is BUFFER.
+
+This function sets `last-coding-system-used' to the precise coding system
+used (which may be different from CODING-SYSTEM if CODING-SYSTEM is
+not fully specified. */)
+ (string, coding_system, nocopy, buffer)
+ Lisp_Object string, coding_system, nocopy, buffer;
+{
+ return code_convert_string (string, coding_system, buffer,
+ 0, ! NILP (nocopy), 0);
+}
+
+DEFUN ("encode-coding-string", Fencode_coding_string, Sencode_coding_string,
+ 2, 4, 0,
+ doc: /* Encode STRING to CODING-SYSTEM, and return the result.
- if (setup_coding_system (Fcheck_coding_system (coding_system), &coding) < 0)
- error ("Invalid coding system: %s", SDATA (SYMBOL_NAME (coding_system)));
+Optional third arg NOCOPY non-nil means it is OK to return STRING
+itself if the encoding operation is trivial.
- coding.composing = COMPOSITION_DISABLED;
- coding.mode |= CODING_MODE_LAST_BLOCK;
- return (encodep
- ? encode_coding_string (string, &coding, 1)
- : decode_coding_string (string, &coding, 1));
+Optional fourth arg BUFFER non-nil meant that the encoded text is
+inserted in BUFFER instead of returned as a string. In this case,
+the return value is BUFFER.
+
+This function sets `last-coding-system-used' to the precise coding system
+used (which may be different from CODING-SYSTEM if CODING-SYSTEM is
+not fully specified.) */)
+ (string, coding_system, nocopy, buffer)
+ Lisp_Object string, coding_system, nocopy, buffer;
+{
+ return code_convert_string (string, coding_system, buffer,
+ 1, ! NILP (nocopy), 1);
}
+
\f
DEFUN ("decode-sjis-char", Fdecode_sjis_char, Sdecode_sjis_char, 1, 1, 0,
doc: /* Decode a Japanese character which has CODE in shift_jis encoding.
(code)
Lisp_Object code;
{
- unsigned char c1, c2, s1, s2;
- Lisp_Object val;
+ Lisp_Object spec, attrs, val;
+ struct charset *charset_roman, *charset_kanji, *charset_kana, *charset;
+ int c;
- CHECK_NUMBER (code);
- s1 = (XFASTINT (code)) >> 8, s2 = (XFASTINT (code)) & 0xFF;
- if (s1 == 0)
+ CHECK_NATNUM (code);
+ c = XFASTINT (code);
+ CHECK_CODING_SYSTEM_GET_SPEC (Vsjis_coding_system, spec);
+ attrs = AREF (spec, 0);
+
+ if (ASCII_BYTE_P (c)
+ && ! NILP (CODING_ATTR_ASCII_COMPAT (attrs)))
+ return code;
+
+ val = CODING_ATTR_CHARSET_LIST (attrs);
+ charset_roman = CHARSET_FROM_ID (XINT (XCAR (val))), val = XCDR (val);
+ charset_kana = CHARSET_FROM_ID (XINT (XCAR (val))), val = XCDR (val);
+ charset_kanji = CHARSET_FROM_ID (XINT (XCAR (val)));
+
+ if (c <= 0x7F)
+ charset = charset_roman;
+ else if (c >= 0xA0 && c < 0xDF)
{
- if (s2 < 0x80)
- XSETFASTINT (val, s2);
- else if (s2 >= 0xA0 || s2 <= 0xDF)
- XSETFASTINT (val, MAKE_CHAR (charset_katakana_jisx0201, s2, 0));
- else
- error ("Invalid Shift JIS code: %x", XFASTINT (code));
+ charset = charset_kana;
+ c -= 0x80;
}
else
{
- if ((s1 < 0x80 || (s1 > 0x9F && s1 < 0xE0) || s1 > 0xEF)
- || (s2 < 0x40 || s2 == 0x7F || s2 > 0xFC))
- error ("Invalid Shift JIS code: %x", XFASTINT (code));
- DECODE_SJIS (s1, s2, c1, c2);
- XSETFASTINT (val, MAKE_CHAR (charset_jisx0208, c1, c2));
+ int s1 = c >> 8, s2 = c & 0xFF;
+
+ if (s1 < 0x81 || (s1 > 0x9F && s1 < 0xE0) || s1 > 0xEF
+ || s2 < 0x40 || s2 == 0x7F || s2 > 0xFC)
+ error ("Invalid code: %d", code);
+ SJIS_TO_JIS (c);
+ charset = charset_kanji;
}
- return val;
+ c = DECODE_CHAR (charset, c);
+ if (c < 0)
+ error ("Invalid code: %d", code);
+ return make_number (c);
}
+
DEFUN ("encode-sjis-char", Fencode_sjis_char, Sencode_sjis_char, 1, 1, 0,
doc: /* Encode a Japanese character CH to shift_jis encoding.
Return the corresponding code in SJIS. */)
(ch)
- Lisp_Object ch;
+ Lisp_Object ch;
{
- int charset, c1, c2, s1, s2;
- Lisp_Object val;
+ Lisp_Object spec, attrs, charset_list;
+ int c;
+ struct charset *charset;
+ unsigned code;
- CHECK_NUMBER (ch);
- SPLIT_CHAR (XFASTINT (ch), charset, c1, c2);
- if (charset == CHARSET_ASCII)
- {
- val = ch;
- }
- else if (charset == charset_jisx0208
- && c1 > 0x20 && c1 < 0x7F && c2 > 0x20 && c2 < 0x7F)
- {
- ENCODE_SJIS (c1, c2, s1, s2);
- XSETFASTINT (val, (s1 << 8) | s2);
- }
- else if (charset == charset_katakana_jisx0201
- && c1 > 0x20 && c2 < 0xE0)
- {
- XSETFASTINT (val, c1 | 0x80);
- }
- else
- error ("Can't encode to shift_jis: %d", XFASTINT (ch));
- return val;
+ CHECK_CHARACTER (ch);
+ c = XFASTINT (ch);
+ CHECK_CODING_SYSTEM_GET_SPEC (Vsjis_coding_system, spec);
+ attrs = AREF (spec, 0);
+
+ if (ASCII_CHAR_P (c)
+ && ! NILP (CODING_ATTR_ASCII_COMPAT (attrs)))
+ return ch;
+
+ charset_list = CODING_ATTR_CHARSET_LIST (attrs);
+ charset = char_charset (c, charset_list, &code);
+ if (code == CHARSET_INVALID_CODE (charset))
+ error ("Can't encode by shift_jis encoding: %d", c);
+ JIS_TO_SJIS (code);
+
+ return make_number (code);
}
DEFUN ("decode-big5-char", Fdecode_big5_char, Sdecode_big5_char, 1, 1, 0,
(code)
Lisp_Object code;
{
- int charset;
- unsigned char b1, b2, c1, c2;
- Lisp_Object val;
+ Lisp_Object spec, attrs, val;
+ struct charset *charset_roman, *charset_big5, *charset;
+ int c;
- CHECK_NUMBER (code);
- b1 = (XFASTINT (code)) >> 8, b2 = (XFASTINT (code)) & 0xFF;
- if (b1 == 0)
- {
- if (b2 >= 0x80)
- error ("Invalid BIG5 code: %x", XFASTINT (code));
- val = code;
- }
+ CHECK_NATNUM (code);
+ c = XFASTINT (code);
+ CHECK_CODING_SYSTEM_GET_SPEC (Vbig5_coding_system, spec);
+ attrs = AREF (spec, 0);
+
+ if (ASCII_BYTE_P (c)
+ && ! NILP (CODING_ATTR_ASCII_COMPAT (attrs)))
+ return code;
+
+ val = CODING_ATTR_CHARSET_LIST (attrs);
+ charset_roman = CHARSET_FROM_ID (XINT (XCAR (val))), val = XCDR (val);
+ charset_big5 = CHARSET_FROM_ID (XINT (XCAR (val)));
+
+ if (c <= 0x7F)
+ charset = charset_roman;
else
{
- if ((b1 < 0xA1 || b1 > 0xFE)
- || (b2 < 0x40 || (b2 > 0x7E && b2 < 0xA1) || b2 > 0xFE))
- error ("Invalid BIG5 code: %x", XFASTINT (code));
- DECODE_BIG5 (b1, b2, charset, c1, c2);
- XSETFASTINT (val, MAKE_CHAR (charset, c1, c2));
+ int b1 = c >> 8, b2 = c & 0x7F;
+ if (b1 < 0xA1 || b1 > 0xFE
+ || b2 < 0x40 || (b2 > 0x7E && b2 < 0xA1) || b2 > 0xFE)
+ error ("Invalid code: %d", code);
+ charset = charset_big5;
}
- return val;
+ c = DECODE_CHAR (charset, (unsigned )c);
+ if (c < 0)
+ error ("Invalid code: %d", code);
+ return make_number (c);
}
DEFUN ("encode-big5-char", Fencode_big5_char, Sencode_big5_char, 1, 1, 0,
(ch)
Lisp_Object ch;
{
- int charset, c1, c2, b1, b2;
- Lisp_Object val;
-
- CHECK_NUMBER (ch);
- SPLIT_CHAR (XFASTINT (ch), charset, c1, c2);
- if (charset == CHARSET_ASCII)
- {
- val = ch;
- }
- else if ((charset == charset_big5_1
- && (XFASTINT (ch) >= 0x250a1 && XFASTINT (ch) <= 0x271ec))
- || (charset == charset_big5_2
- && XFASTINT (ch) >= 0x290a1 && XFASTINT (ch) <= 0x2bdb2))
- {
- ENCODE_BIG5 (charset, c1, c2, b1, b2);
- XSETFASTINT (val, (b1 << 8) | b2);
- }
- else
- error ("Can't encode to Big5: %d", XFASTINT (ch));
- return val;
+ Lisp_Object spec, attrs, charset_list;
+ struct charset *charset;
+ int c;
+ unsigned code;
+
+ CHECK_CHARACTER (ch);
+ c = XFASTINT (ch);
+ CHECK_CODING_SYSTEM_GET_SPEC (Vbig5_coding_system, spec);
+ attrs = AREF (spec, 0);
+ if (ASCII_CHAR_P (c)
+ && ! NILP (CODING_ATTR_ASCII_COMPAT (attrs)))
+ return ch;
+
+ charset_list = CODING_ATTR_CHARSET_LIST (attrs);
+ charset = char_charset (c, charset_list, &code);
+ if (code == CHARSET_INVALID_CODE (charset))
+ error ("Can't encode by Big5 encoding: %d", c);
+
+ return make_number (code);
}
+
\f
DEFUN ("set-terminal-coding-system-internal", Fset_terminal_coding_system_internal,
Sset_terminal_coding_system_internal, 1, 2, 0,
CHECK_SYMBOL (coding_system);
setup_coding_system (Fcheck_coding_system (coding_system), terminal_coding);
/* We had better not send unsafe characters to terminal. */
- terminal_coding->mode |= CODING_MODE_INHIBIT_UNENCODABLE_CHAR;
- /* Character composition should be disabled. */
- terminal_coding->composing = COMPOSITION_DISABLED;
- /* Error notification should be suppressed. */
- terminal_coding->suppress_error = 1;
+ terminal_coding->mode |= CODING_MODE_SAFE_ENCODING;
+ /* Characer composition should be disabled. */
+ terminal_coding->common_flags &= ~CODING_ANNOTATE_COMPOSITION_MASK;
terminal_coding->src_multibyte = 1;
terminal_coding->dst_multibyte = 0;
return Qnil;
}
-DEFUN ("set-safe-terminal-coding-system-internal", Fset_safe_terminal_coding_system_internal,
+DEFUN ("set-safe-terminal-coding-system-internal",
+ Fset_safe_terminal_coding_system_internal,
Sset_safe_terminal_coding_system_internal, 1, 1, 0,
doc: /* Internal use only. */)
(coding_system)
CHECK_SYMBOL (coding_system);
setup_coding_system (Fcheck_coding_system (coding_system),
&safe_terminal_coding);
- /* Character composition should be disabled. */
- safe_terminal_coding.composing = COMPOSITION_DISABLED;
- /* Error notification should be suppressed. */
- safe_terminal_coding.suppress_error = 1;
+ /* Characer composition should be disabled. */
+ safe_terminal_coding.common_flags &= ~CODING_ANNOTATE_COMPOSITION_MASK;
safe_terminal_coding.src_multibyte = 1;
safe_terminal_coding.dst_multibyte = 0;
return Qnil;
(terminal)
Lisp_Object terminal;
{
- return TERMINAL_TERMINAL_CODING (get_terminal (terminal, 1))->symbol;
+ struct coding_system *terminal_coding
+ = TERMINAL_TERMINAL_CODING (get_terminal (terminal, 1));
+ Lisp_Object coding_system = CODING_ID_NAME (terminal_coding->id);
+
+ /* For backward compatibility, return nil if it is `undecided'. */
+ return (! EQ (coding_system, Qundecided) ? coding_system : Qnil);
}
DEFUN ("set-keyboard-coding-system-internal", Fset_keyboard_coding_system_internal,
{
struct terminal *t = get_terminal (terminal, 1);
CHECK_SYMBOL (coding_system);
-
setup_coding_system (Fcheck_coding_system (coding_system),
- TERMINAL_KEYBOARD_CODING (t));
- /* Character composition should be disabled. */
- TERMINAL_KEYBOARD_CODING (t)->composing = COMPOSITION_DISABLED;
+ TERMINAL_KEYBOARD_CODING (t));
+ /* Characer composition should be disabled. */
+ TERMINAL_KEYBOARD_CODING (t)->common_flags
+ &= ~CODING_ANNOTATE_COMPOSITION_MASK;
return Qnil;
}
-DEFUN ("keyboard-coding-system", Fkeyboard_coding_system,
- Skeyboard_coding_system, 0, 1, 0,
- doc: /* Return coding system for decoding keyboard input on TERMINAL.
-TERMINAL may be a terminal id, a frame, or nil for the selected
-frame's terminal device. */)
+DEFUN ("keyboard-coding-system",
+ Fkeyboard_coding_system, Skeyboard_coding_system, 0, 1, 0,
+ doc: /* Return coding system specified for decoding keyboard input. */)
(terminal)
Lisp_Object terminal;
{
- return TERMINAL_KEYBOARD_CODING (get_terminal (terminal, 1))->symbol;
+ return CODING_ID_NAME (TERMINAL_KEYBOARD_CODING
+ (get_terminal (terminal, 1))->id);
}
\f
For process I/O, `call-process', `call-process-region', or `start-process'.
For network I/O, `open-network-stream'.
-The remaining arguments should be the same arguments that were passed
-to the primitive. Depending on which primitive, one of those arguments
-is selected as the TARGET. For example, if OPERATION does file I/O,
-whichever argument specifies the file name is TARGET.
+The remaining arguments should be the same arguments that were passed
+to the primitive. Depending on which primitive, one of those arguments
+is selected as the TARGET. For example, if OPERATION does file I/O,
+whichever argument specifies the file name is TARGET.
+
+TARGET has a meaning which depends on OPERATION:
+ For file I/O, TARGET is a file name (except for the special case below).
+ For process I/O, TARGET is a process name.
+ For network I/O, TARGET is a service name or a port number
+
+This function looks up what specified for TARGET in,
+`file-coding-system-alist', `process-coding-system-alist',
+or `network-coding-system-alist' depending on OPERATION.
+They may specify a coding system, a cons of coding systems,
+or a function symbol to call.
+In the last case, we call the function with one argument,
+which is a list of all the arguments given to this function.
+If the function can't decide a coding system, it can return
+`undecided' so that the normal code-detection is performed.
+
+If OPERATION is `insert-file-contents', the argument corresponding to
+TARGET may be a cons (FILENAME . BUFFER). In that case, FILENAME is a
+file name to look up, and BUFFER is a buffer that contains the file's
+contents (not yet decoded). If `file-coding-system-alist' specifies a
+function to call for FILENAME, that function should examine the
+contents of BUFFER instead of reading the file.
+
+usage: (find-operation-coding-system OPERATION ARGUMENTS...) */)
+ (nargs, args)
+ int nargs;
+ Lisp_Object *args;
+{
+ Lisp_Object operation, target_idx, target, val;
+ register Lisp_Object chain;
+
+ if (nargs < 2)
+ error ("Too few arguments");
+ operation = args[0];
+ if (!SYMBOLP (operation)
+ || !INTEGERP (target_idx = Fget (operation, Qtarget_idx)))
+ error ("Invalid first arguement");
+ if (nargs < 1 + XINT (target_idx))
+ error ("Too few arguments for operation: %s",
+ SDATA (SYMBOL_NAME (operation)));
+ target = args[XINT (target_idx) + 1];
+ if (!(STRINGP (target)
+ || (EQ (operation, Qinsert_file_contents) && CONSP (target)
+ && STRINGP (XCAR (target)) && BUFFERP (XCDR (target)))
+ || (EQ (operation, Qopen_network_stream) && INTEGERP (target))))
+ error ("Invalid %dth argument", XINT (target_idx) + 1);
+ if (CONSP (target))
+ target = XCAR (target);
+
+ chain = ((EQ (operation, Qinsert_file_contents)
+ || EQ (operation, Qwrite_region))
+ ? Vfile_coding_system_alist
+ : (EQ (operation, Qopen_network_stream)
+ ? Vnetwork_coding_system_alist
+ : Vprocess_coding_system_alist));
+ if (NILP (chain))
+ return Qnil;
+
+ for (; CONSP (chain); chain = XCDR (chain))
+ {
+ Lisp_Object elt;
+
+ elt = XCAR (chain);
+ if (CONSP (elt)
+ && ((STRINGP (target)
+ && STRINGP (XCAR (elt))
+ && fast_string_match (XCAR (elt), target) >= 0)
+ || (INTEGERP (target) && EQ (target, XCAR (elt)))))
+ {
+ val = XCDR (elt);
+ /* Here, if VAL is both a valid coding system and a valid
+ function symbol, we return VAL as a coding system. */
+ if (CONSP (val))
+ return val;
+ if (! SYMBOLP (val))
+ return Qnil;
+ if (! NILP (Fcoding_system_p (val)))
+ return Fcons (val, val);
+ if (! NILP (Ffboundp (val)))
+ {
+ /* We use call1 rather than safe_call1
+ so as to get bug reports about functions called here
+ which don't handle the current interface. */
+ val = call1 (val, Flist (nargs, args));
+ if (CONSP (val))
+ return val;
+ if (SYMBOLP (val) && ! NILP (Fcoding_system_p (val)))
+ return Fcons (val, val);
+ }
+ return Qnil;
+ }
+ }
+ return Qnil;
+}
+
+DEFUN ("set-coding-system-priority", Fset_coding_system_priority,
+ Sset_coding_system_priority, 0, MANY, 0,
+ doc: /* Assign higher priority to the coding systems given as arguments.
+If multiple coding systems belongs to the same category,
+all but the first one are ignored.
+
+usage: (set-coding-system-priority ...) */)
+ (nargs, args)
+ int nargs;
+ Lisp_Object *args;
+{
+ int i, j;
+ int changed[coding_category_max];
+ enum coding_category priorities[coding_category_max];
+
+ bzero (changed, sizeof changed);
+
+ for (i = j = 0; i < nargs; i++)
+ {
+ enum coding_category category;
+ Lisp_Object spec, attrs;
+
+ CHECK_CODING_SYSTEM_GET_SPEC (args[i], spec);
+ attrs = AREF (spec, 0);
+ category = XINT (CODING_ATTR_CATEGORY (attrs));
+ if (changed[category])
+ /* Ignore this coding system because a coding system of the
+ same category already had a higher priority. */
+ continue;
+ changed[category] = 1;
+ priorities[j++] = category;
+ if (coding_categories[category].id >= 0
+ && ! EQ (args[i], CODING_ID_NAME (coding_categories[category].id)))
+ setup_coding_system (args[i], &coding_categories[category]);
+ Fset (AREF (Vcoding_category_table, category), args[i]);
+ }
+
+ /* Now we have decided top J priorities. Reflect the order of the
+ original priorities to the remaining priorities. */
+
+ for (i = j, j = 0; i < coding_category_max; i++, j++)
+ {
+ while (j < coding_category_max
+ && changed[coding_priorities[j]])
+ j++;
+ if (j == coding_category_max)
+ abort ();
+ priorities[i] = coding_priorities[j];
+ }
+
+ bcopy (priorities, coding_priorities, sizeof priorities);
+
+ /* Update `coding-category-list'. */
+ Vcoding_category_list = Qnil;
+ for (i = coding_category_max - 1; i >= 0; i--)
+ Vcoding_category_list
+ = Fcons (AREF (Vcoding_category_table, priorities[i]),
+ Vcoding_category_list);
+
+ return Qnil;
+}
+
+DEFUN ("coding-system-priority-list", Fcoding_system_priority_list,
+ Scoding_system_priority_list, 0, 1, 0,
+ doc: /* Return a list of coding systems ordered by their priorities.
+HIGHESTP non-nil means just return the highest priority one. */)
+ (highestp)
+ Lisp_Object highestp;
+{
+ int i;
+ Lisp_Object val;
+
+ for (i = 0, val = Qnil; i < coding_category_max; i++)
+ {
+ enum coding_category category = coding_priorities[i];
+ int id = coding_categories[category].id;
+ Lisp_Object attrs;
+
+ if (id < 0)
+ continue;
+ attrs = CODING_ID_ATTRS (id);
+ if (! NILP (highestp))
+ return CODING_ATTR_BASE_NAME (attrs);
+ val = Fcons (CODING_ATTR_BASE_NAME (attrs), val);
+ }
+ return Fnreverse (val);
+}
+
+static char *suffixes[] = { "-unix", "-dos", "-mac" };
+
+static Lisp_Object
+make_subsidiaries (base)
+ Lisp_Object base;
+{
+ Lisp_Object subsidiaries;
+ int base_name_len = SBYTES (SYMBOL_NAME (base));
+ char *buf = (char *) alloca (base_name_len + 6);
+ int i;
+
+ bcopy (SDATA (SYMBOL_NAME (base)), buf, base_name_len);
+ subsidiaries = Fmake_vector (make_number (3), Qnil);
+ for (i = 0; i < 3; i++)
+ {
+ bcopy (suffixes[i], buf + base_name_len, strlen (suffixes[i]) + 1);
+ ASET (subsidiaries, i, intern (buf));
+ }
+ return subsidiaries;
+}
+
+
+DEFUN ("define-coding-system-internal", Fdefine_coding_system_internal,
+ Sdefine_coding_system_internal, coding_arg_max, MANY, 0,
+ doc: /* For internal use only.
+usage: (define-coding-system-internal ...) */)
+ (nargs, args)
+ int nargs;
+ Lisp_Object *args;
+{
+ Lisp_Object name;
+ Lisp_Object spec_vec; /* [ ATTRS ALIASE EOL_TYPE ] */
+ Lisp_Object attrs; /* Vector of attributes. */
+ Lisp_Object eol_type;
+ Lisp_Object aliases;
+ Lisp_Object coding_type, charset_list, safe_charsets;
+ enum coding_category category;
+ Lisp_Object tail, val;
+ int max_charset_id = 0;
+ int i;
+
+ if (nargs < coding_arg_max)
+ goto short_args;
+
+ attrs = Fmake_vector (make_number (coding_attr_last_index), Qnil);
+
+ name = args[coding_arg_name];
+ CHECK_SYMBOL (name);
+ CODING_ATTR_BASE_NAME (attrs) = name;
+
+ val = args[coding_arg_mnemonic];
+ if (! STRINGP (val))
+ CHECK_CHARACTER (val);
+ CODING_ATTR_MNEMONIC (attrs) = val;
+
+ coding_type = args[coding_arg_coding_type];
+ CHECK_SYMBOL (coding_type);
+ CODING_ATTR_TYPE (attrs) = coding_type;
+
+ charset_list = args[coding_arg_charset_list];
+ if (SYMBOLP (charset_list))
+ {
+ if (EQ (charset_list, Qiso_2022))
+ {
+ if (! EQ (coding_type, Qiso_2022))
+ error ("Invalid charset-list");
+ charset_list = Viso_2022_charset_list;
+ }
+ else if (EQ (charset_list, Qemacs_mule))
+ {
+ if (! EQ (coding_type, Qemacs_mule))
+ error ("Invalid charset-list");
+ charset_list = Vemacs_mule_charset_list;
+ }
+ for (tail = charset_list; CONSP (tail); tail = XCDR (tail))
+ if (max_charset_id < XFASTINT (XCAR (tail)))
+ max_charset_id = XFASTINT (XCAR (tail));
+ }
+ else
+ {
+ charset_list = Fcopy_sequence (charset_list);
+ for (tail = charset_list; CONSP (tail); tail = XCDR (tail))
+ {
+ struct charset *charset;
+
+ val = XCAR (tail);
+ CHECK_CHARSET_GET_CHARSET (val, charset);
+ if (EQ (coding_type, Qiso_2022)
+ ? CHARSET_ISO_FINAL (charset) < 0
+ : EQ (coding_type, Qemacs_mule)
+ ? CHARSET_EMACS_MULE_ID (charset) < 0
+ : 0)
+ error ("Can't handle charset `%s'",
+ SDATA (SYMBOL_NAME (CHARSET_NAME (charset))));
+
+ XSETCAR (tail, make_number (charset->id));
+ if (max_charset_id < charset->id)
+ max_charset_id = charset->id;
+ }
+ }
+ CODING_ATTR_CHARSET_LIST (attrs) = charset_list;
+
+ safe_charsets = Fmake_string (make_number (max_charset_id + 1),
+ make_number (255));
+ for (tail = charset_list; CONSP (tail); tail = XCDR (tail))
+ SSET (safe_charsets, XFASTINT (XCAR (tail)), 0);
+ CODING_ATTR_SAFE_CHARSETS (attrs) = safe_charsets;
+
+ CODING_ATTR_ASCII_COMPAT (attrs) = args[coding_arg_ascii_compatible_p];
+
+ val = args[coding_arg_decode_translation_table];
+ if (! CHAR_TABLE_P (val) && ! CONSP (val))
+ CHECK_SYMBOL (val);
+ CODING_ATTR_DECODE_TBL (attrs) = val;
+
+ val = args[coding_arg_encode_translation_table];
+ if (! CHAR_TABLE_P (val) && ! CONSP (val))
+ CHECK_SYMBOL (val);
+ CODING_ATTR_ENCODE_TBL (attrs) = val;
+
+ val = args[coding_arg_post_read_conversion];
+ CHECK_SYMBOL (val);
+ CODING_ATTR_POST_READ (attrs) = val;
+
+ val = args[coding_arg_pre_write_conversion];
+ CHECK_SYMBOL (val);
+ CODING_ATTR_PRE_WRITE (attrs) = val;
+
+ val = args[coding_arg_default_char];
+ if (NILP (val))
+ CODING_ATTR_DEFAULT_CHAR (attrs) = make_number (' ');
+ else
+ {
+ CHECK_CHARACTER (val);
+ CODING_ATTR_DEFAULT_CHAR (attrs) = val;
+ }
+
+ val = args[coding_arg_for_unibyte];
+ CODING_ATTR_FOR_UNIBYTE (attrs) = NILP (val) ? Qnil : Qt;
+
+ val = args[coding_arg_plist];
+ CHECK_LIST (val);
+ CODING_ATTR_PLIST (attrs) = val;
+
+ if (EQ (coding_type, Qcharset))
+ {
+ /* Generate a lisp vector of 256 elements. Each element is nil,
+ integer, or a list of charset IDs.
+
+ If Nth element is nil, the byte code N is invalid in this
+ coding system.
+
+ If Nth element is a number NUM, N is the first byte of a
+ charset whose ID is NUM.
+
+ If Nth element is a list of charset IDs, N is the first byte
+ of one of them. The list is sorted by dimensions of the
+ charsets. A charset of smaller dimension comes firtst. */
+ val = Fmake_vector (make_number (256), Qnil);
+
+ for (tail = charset_list; CONSP (tail); tail = XCDR (tail))
+ {
+ struct charset *charset = CHARSET_FROM_ID (XFASTINT (XCAR (tail)));
+ int dim = CHARSET_DIMENSION (charset);
+ int idx = (dim - 1) * 4;
+
+ if (CHARSET_ASCII_COMPATIBLE_P (charset))
+ CODING_ATTR_ASCII_COMPAT (attrs) = Qt;
+
+ for (i = charset->code_space[idx];
+ i <= charset->code_space[idx + 1]; i++)
+ {
+ Lisp_Object tmp, tmp2;
+ int dim2;
+
+ tmp = AREF (val, i);
+ if (NILP (tmp))
+ tmp = XCAR (tail);
+ else if (NUMBERP (tmp))
+ {
+ dim2 = CHARSET_DIMENSION (CHARSET_FROM_ID (XFASTINT (tmp)));
+ if (dim < dim2)
+ tmp = Fcons (XCAR (tail), Fcons (tmp, Qnil));
+ else
+ tmp = Fcons (tmp, Fcons (XCAR (tail), Qnil));
+ }
+ else
+ {
+ for (tmp2 = tmp; CONSP (tmp2); tmp2 = XCDR (tmp2))
+ {
+ dim2 = CHARSET_DIMENSION (CHARSET_FROM_ID (XFASTINT (XCAR (tmp2))));
+ if (dim < dim2)
+ break;
+ }
+ if (NILP (tmp2))
+ tmp = nconc2 (tmp, Fcons (XCAR (tail), Qnil));
+ else
+ {
+ XSETCDR (tmp2, Fcons (XCAR (tmp2), XCDR (tmp2)));
+ XSETCAR (tmp2, XCAR (tail));
+ }
+ }
+ ASET (val, i, tmp);
+ }
+ }
+ ASET (attrs, coding_attr_charset_valids, val);
+ category = coding_category_charset;
+ }
+ else if (EQ (coding_type, Qccl))
+ {
+ Lisp_Object valids;
+
+ if (nargs < coding_arg_ccl_max)
+ goto short_args;
-TARGET has a meaning which depends on OPERATION:
- For file I/O, TARGET is a file name (except for the special case below).
- For process I/O, TARGET is a process name.
- For network I/O, TARGET is a service name or a port number
+ val = args[coding_arg_ccl_decoder];
+ CHECK_CCL_PROGRAM (val);
+ if (VECTORP (val))
+ val = Fcopy_sequence (val);
+ ASET (attrs, coding_attr_ccl_decoder, val);
-This function looks up what specified for TARGET in,
-`file-coding-system-alist', `process-coding-system-alist',
-or `network-coding-system-alist' depending on OPERATION.
-They may specify a coding system, a cons of coding systems,
-or a function symbol to call.
-In the last case, we call the function with one argument,
-which is a list of all the arguments given to this function.
-If the function can't decide a coding system, it can return
-`undecided' so that the normal code-detection is performed.
+ val = args[coding_arg_ccl_encoder];
+ CHECK_CCL_PROGRAM (val);
+ if (VECTORP (val))
+ val = Fcopy_sequence (val);
+ ASET (attrs, coding_attr_ccl_encoder, val);
-If OPERATION is `insert-file-contents', the argument corresponding to
-TARGET may be a cons (FILENAME . BUFFER). In that case, FILENAME is a
-file name to look up, and BUFFER is a buffer that contains the file's
-contents (not yet decoded). If `file-coding-system-alist' specifies a
-function to call for FILENAME, that function should examine the
-contents of BUFFER instead of reading the file.
+ val = args[coding_arg_ccl_valids];
+ valids = Fmake_string (make_number (256), make_number (0));
+ for (tail = val; !NILP (tail); tail = Fcdr (tail))
+ {
+ int from, to;
-usage: (find-operation-coding-system OPERATION ARGUMENTS...) */)
- (nargs, args)
- int nargs;
- Lisp_Object *args;
-{
- Lisp_Object operation, target_idx, target, val;
- register Lisp_Object chain;
+ val = Fcar (tail);
+ if (INTEGERP (val))
+ {
+ from = to = XINT (val);
+ if (from < 0 || from > 255)
+ args_out_of_range_3 (val, make_number (0), make_number (255));
+ }
+ else
+ {
+ CHECK_CONS (val);
+ CHECK_NATNUM_CAR (val);
+ CHECK_NATNUM_CDR (val);
+ from = XINT (XCAR (val));
+ if (from > 255)
+ args_out_of_range_3 (XCAR (val),
+ make_number (0), make_number (255));
+ to = XINT (XCDR (val));
+ if (to < from || to > 255)
+ args_out_of_range_3 (XCDR (val),
+ XCAR (val), make_number (255));
+ }
+ for (i = from; i <= to; i++)
+ SSET (valids, i, 1);
+ }
+ ASET (attrs, coding_attr_ccl_valids, valids);
- if (nargs < 2)
- error ("Too few arguments");
- operation = args[0];
- if (!SYMBOLP (operation)
- || !INTEGERP (target_idx = Fget (operation, Qtarget_idx)))
- error ("Invalid first argument");
- if (nargs < 1 + XINT (target_idx))
- error ("Too few arguments for operation: %s",
- SDATA (SYMBOL_NAME (operation)));
- /* For write-region, if the 6th argument (i.e. VISIT, the 5th
- argument to write-region) is string, it must be treated as a
- target file name. */
- if (EQ (operation, Qwrite_region)
- && nargs > 5
- && STRINGP (args[5]))
- target_idx = make_number (4);
- target = args[XINT (target_idx) + 1];
- if (!(STRINGP (target)
- || (EQ (operation, Qinsert_file_contents) && CONSP (target)
- && STRINGP (XCAR (target)) && BUFFERP (XCDR (target)))
- || (EQ (operation, Qopen_network_stream) && INTEGERP (target))))
- error ("Invalid argument %d", XINT (target_idx) + 1);
- if (CONSP (target))
- target = XCAR (target);
+ category = coding_category_ccl;
+ }
+ else if (EQ (coding_type, Qutf_16))
+ {
+ Lisp_Object bom, endian;
- chain = ((EQ (operation, Qinsert_file_contents)
- || EQ (operation, Qwrite_region))
- ? Vfile_coding_system_alist
- : (EQ (operation, Qopen_network_stream)
- ? Vnetwork_coding_system_alist
- : Vprocess_coding_system_alist));
- if (NILP (chain))
- return Qnil;
+ CODING_ATTR_ASCII_COMPAT (attrs) = Qnil;
- for (; CONSP (chain); chain = XCDR (chain))
- {
- Lisp_Object elt;
- elt = XCAR (chain);
+ if (nargs < coding_arg_utf16_max)
+ goto short_args;
- if (CONSP (elt)
- && ((STRINGP (target)
- && STRINGP (XCAR (elt))
- && fast_string_match (XCAR (elt), target) >= 0)
- || (INTEGERP (target) && EQ (target, XCAR (elt)))))
+ bom = args[coding_arg_utf16_bom];
+ if (! NILP (bom) && ! EQ (bom, Qt))
{
- val = XCDR (elt);
- /* Here, if VAL is both a valid coding system and a valid
- function symbol, we return VAL as a coding system. */
- if (CONSP (val))
- return val;
- if (! SYMBOLP (val))
- return Qnil;
- if (! NILP (Fcoding_system_p (val)))
- return Fcons (val, val);
- if (! NILP (Ffboundp (val)))
+ CHECK_CONS (bom);
+ val = XCAR (bom);
+ CHECK_CODING_SYSTEM (val);
+ val = XCDR (bom);
+ CHECK_CODING_SYSTEM (val);
+ }
+ ASET (attrs, coding_attr_utf_16_bom, bom);
+
+ endian = args[coding_arg_utf16_endian];
+ CHECK_SYMBOL (endian);
+ if (NILP (endian))
+ endian = Qbig;
+ else if (! EQ (endian, Qbig) && ! EQ (endian, Qlittle))
+ error ("Invalid endian: %s", SDATA (SYMBOL_NAME (endian)));
+ ASET (attrs, coding_attr_utf_16_endian, endian);
+
+ category = (CONSP (bom)
+ ? coding_category_utf_16_auto
+ : NILP (bom)
+ ? (EQ (endian, Qbig)
+ ? coding_category_utf_16_be_nosig
+ : coding_category_utf_16_le_nosig)
+ : (EQ (endian, Qbig)
+ ? coding_category_utf_16_be
+ : coding_category_utf_16_le));
+ }
+ else if (EQ (coding_type, Qiso_2022))
+ {
+ Lisp_Object initial, reg_usage, request, flags;
+ int i;
+
+ if (nargs < coding_arg_iso2022_max)
+ goto short_args;
+
+ initial = Fcopy_sequence (args[coding_arg_iso2022_initial]);
+ CHECK_VECTOR (initial);
+ for (i = 0; i < 4; i++)
+ {
+ val = Faref (initial, make_number (i));
+ if (! NILP (val))
{
- /* We use call1 rather than safe_call1
- so as to get bug reports about functions called here
- which don't handle the current interface. */
- val = call1 (val, Flist (nargs, args));
- if (CONSP (val))
- return val;
- if (SYMBOLP (val) && ! NILP (Fcoding_system_p (val)))
- return Fcons (val, val);
+ struct charset *charset;
+
+ CHECK_CHARSET_GET_CHARSET (val, charset);
+ ASET (initial, i, make_number (CHARSET_ID (charset)));
+ if (i == 0 && CHARSET_ASCII_COMPATIBLE_P (charset))
+ CODING_ATTR_ASCII_COMPAT (attrs) = Qt;
}
- return Qnil;
+ else
+ ASET (initial, i, make_number (-1));
}
- }
- return Qnil;
-}
-DEFUN ("update-coding-systems-internal", Fupdate_coding_systems_internal,
- Supdate_coding_systems_internal, 0, 0, 0,
- doc: /* Update internal database for ISO2022 and CCL based coding systems.
-When values of any coding categories are changed, you must
-call this function. */)
- ()
-{
- int i;
+ reg_usage = args[coding_arg_iso2022_reg_usage];
+ CHECK_CONS (reg_usage);
+ CHECK_NUMBER_CAR (reg_usage);
+ CHECK_NUMBER_CDR (reg_usage);
+
+ request = Fcopy_sequence (args[coding_arg_iso2022_request]);
+ for (tail = request; ! NILP (tail); tail = Fcdr (tail))
+ {
+ int id;
+ Lisp_Object tmp;
+
+ val = Fcar (tail);
+ CHECK_CONS (val);
+ tmp = XCAR (val);
+ CHECK_CHARSET_GET_ID (tmp, id);
+ CHECK_NATNUM_CDR (val);
+ if (XINT (XCDR (val)) >= 4)
+ error ("Invalid graphic register number: %d", XINT (XCDR (val)));
+ XSETCAR (val, make_number (id));
+ }
- for (i = CODING_CATEGORY_IDX_EMACS_MULE; i < CODING_CATEGORY_IDX_MAX; i++)
+ flags = args[coding_arg_iso2022_flags];
+ CHECK_NATNUM (flags);
+ i = XINT (flags);
+ if (EQ (args[coding_arg_charset_list], Qiso_2022))
+ flags = make_number (i | CODING_ISO_FLAG_FULL_SUPPORT);
+
+ ASET (attrs, coding_attr_iso_initial, initial);
+ ASET (attrs, coding_attr_iso_usage, reg_usage);
+ ASET (attrs, coding_attr_iso_request, request);
+ ASET (attrs, coding_attr_iso_flags, flags);
+ setup_iso_safe_charsets (attrs);
+
+ if (i & CODING_ISO_FLAG_SEVEN_BITS)
+ category = ((i & (CODING_ISO_FLAG_LOCKING_SHIFT
+ | CODING_ISO_FLAG_SINGLE_SHIFT))
+ ? coding_category_iso_7_else
+ : EQ (args[coding_arg_charset_list], Qiso_2022)
+ ? coding_category_iso_7
+ : coding_category_iso_7_tight);
+ else
+ {
+ int id = XINT (AREF (initial, 1));
+
+ category = (((i & CODING_ISO_FLAG_LOCKING_SHIFT)
+ || EQ (args[coding_arg_charset_list], Qiso_2022)
+ || id < 0)
+ ? coding_category_iso_8_else
+ : (CHARSET_DIMENSION (CHARSET_FROM_ID (id)) == 1)
+ ? coding_category_iso_8_1
+ : coding_category_iso_8_2);
+ }
+ if (category != coding_category_iso_8_1
+ && category != coding_category_iso_8_2)
+ CODING_ATTR_ASCII_COMPAT (attrs) = Qnil;
+ }
+ else if (EQ (coding_type, Qemacs_mule))
+ {
+ if (EQ (args[coding_arg_charset_list], Qemacs_mule))
+ ASET (attrs, coding_attr_emacs_mule_full, Qt);
+ CODING_ATTR_ASCII_COMPAT (attrs) = Qt;
+ category = coding_category_emacs_mule;
+ }
+ else if (EQ (coding_type, Qshift_jis))
{
- Lisp_Object val;
- val = find_symbol_value (XVECTOR (Vcoding_category_table)->contents[i]);
- if (!NILP (val))
+ struct charset *charset;
+
+ if (XINT (Flength (charset_list)) != 3
+ && XINT (Flength (charset_list)) != 4)
+ error ("There should be three or four charsets");
+
+ charset = CHARSET_FROM_ID (XINT (XCAR (charset_list)));
+ if (CHARSET_DIMENSION (charset) != 1)
+ error ("Dimension of charset %s is not one",
+ SDATA (SYMBOL_NAME (CHARSET_NAME (charset))));
+ if (CHARSET_ASCII_COMPATIBLE_P (charset))
+ CODING_ATTR_ASCII_COMPAT (attrs) = Qt;
+
+ charset_list = XCDR (charset_list);
+ charset = CHARSET_FROM_ID (XINT (XCAR (charset_list)));
+ if (CHARSET_DIMENSION (charset) != 1)
+ error ("Dimension of charset %s is not one",
+ SDATA (SYMBOL_NAME (CHARSET_NAME (charset))));
+
+ charset_list = XCDR (charset_list);
+ charset = CHARSET_FROM_ID (XINT (XCAR (charset_list)));
+ if (CHARSET_DIMENSION (charset) != 2)
+ error ("Dimension of charset %s is not two",
+ SDATA (SYMBOL_NAME (CHARSET_NAME (charset))));
+
+ charset_list = XCDR (charset_list);
+ if (! NILP (charset_list))
{
- if (! coding_system_table[i])
- coding_system_table[i] = ((struct coding_system *)
- xmalloc (sizeof (struct coding_system)));
- setup_coding_system (val, coding_system_table[i]);
+ charset = CHARSET_FROM_ID (XINT (XCAR (charset_list)));
+ if (CHARSET_DIMENSION (charset) != 2)
+ error ("Dimension of charset %s is not two",
+ SDATA (SYMBOL_NAME (CHARSET_NAME (charset))));
}
- else if (coding_system_table[i])
+
+ category = coding_category_sjis;
+ Vsjis_coding_system = name;
+ }
+ else if (EQ (coding_type, Qbig5))
+ {
+ struct charset *charset;
+
+ if (XINT (Flength (charset_list)) != 2)
+ error ("There should be just two charsets");
+
+ charset = CHARSET_FROM_ID (XINT (XCAR (charset_list)));
+ if (CHARSET_DIMENSION (charset) != 1)
+ error ("Dimension of charset %s is not one",
+ SDATA (SYMBOL_NAME (CHARSET_NAME (charset))));
+ if (CHARSET_ASCII_COMPATIBLE_P (charset))
+ CODING_ATTR_ASCII_COMPAT (attrs) = Qt;
+
+ charset_list = XCDR (charset_list);
+ charset = CHARSET_FROM_ID (XINT (XCAR (charset_list)));
+ if (CHARSET_DIMENSION (charset) != 2)
+ error ("Dimension of charset %s is not two",
+ SDATA (SYMBOL_NAME (CHARSET_NAME (charset))));
+
+ category = coding_category_big5;
+ Vbig5_coding_system = name;
+ }
+ else if (EQ (coding_type, Qraw_text))
+ {
+ category = coding_category_raw_text;
+ CODING_ATTR_ASCII_COMPAT (attrs) = Qt;
+ }
+ else if (EQ (coding_type, Qutf_8))
+ {
+ category = coding_category_utf_8;
+ CODING_ATTR_ASCII_COMPAT (attrs) = Qt;
+ }
+ else if (EQ (coding_type, Qundecided))
+ category = coding_category_undecided;
+ else
+ error ("Invalid coding system type: %s",
+ SDATA (SYMBOL_NAME (coding_type)));
+
+ CODING_ATTR_CATEGORY (attrs) = make_number (category);
+ CODING_ATTR_PLIST (attrs)
+ = Fcons (QCcategory, Fcons (AREF (Vcoding_category_table, category),
+ CODING_ATTR_PLIST (attrs)));
+ CODING_ATTR_PLIST (attrs)
+ = Fcons (QCascii_compatible_p,
+ Fcons (CODING_ATTR_ASCII_COMPAT (attrs),
+ CODING_ATTR_PLIST (attrs)));
+
+ eol_type = args[coding_arg_eol_type];
+ if (! NILP (eol_type)
+ && ! EQ (eol_type, Qunix)
+ && ! EQ (eol_type, Qdos)
+ && ! EQ (eol_type, Qmac))
+ error ("Invalid eol-type");
+
+ aliases = Fcons (name, Qnil);
+
+ if (NILP (eol_type))
+ {
+ eol_type = make_subsidiaries (name);
+ for (i = 0; i < 3; i++)
{
- xfree (coding_system_table[i]);
- coding_system_table[i] = NULL;
+ Lisp_Object this_spec, this_name, this_aliases, this_eol_type;
+
+ this_name = AREF (eol_type, i);
+ this_aliases = Fcons (this_name, Qnil);
+ this_eol_type = (i == 0 ? Qunix : i == 1 ? Qdos : Qmac);
+ this_spec = Fmake_vector (make_number (3), attrs);
+ ASET (this_spec, 1, this_aliases);
+ ASET (this_spec, 2, this_eol_type);
+ Fputhash (this_name, this_spec, Vcoding_system_hash_table);
+ Vcoding_system_list = Fcons (this_name, Vcoding_system_list);
+ val = Fassoc (Fsymbol_name (this_name), Vcoding_system_alist);
+ if (NILP (val))
+ Vcoding_system_alist
+ = Fcons (Fcons (Fsymbol_name (this_name), Qnil),
+ Vcoding_system_alist);
}
}
+ spec_vec = Fmake_vector (make_number (3), attrs);
+ ASET (spec_vec, 1, aliases);
+ ASET (spec_vec, 2, eol_type);
+
+ Fputhash (name, spec_vec, Vcoding_system_hash_table);
+ Vcoding_system_list = Fcons (name, Vcoding_system_list);
+ val = Fassoc (Fsymbol_name (name), Vcoding_system_alist);
+ if (NILP (val))
+ Vcoding_system_alist = Fcons (Fcons (Fsymbol_name (name), Qnil),
+ Vcoding_system_alist);
+
+ {
+ int id = coding_categories[category].id;
+
+ if (id < 0 || EQ (name, CODING_ID_NAME (id)))
+ setup_coding_system (name, &coding_categories[category]);
+ }
+
return Qnil;
+
+ short_args:
+ return Fsignal (Qwrong_number_of_arguments,
+ Fcons (intern ("define-coding-system-internal"),
+ make_number (nargs)));
}
-DEFUN ("set-coding-priority-internal", Fset_coding_priority_internal,
- Sset_coding_priority_internal, 0, 0, 0,
- doc: /* Update internal database for the current value of `coding-category-list'.
-This function is internal use only. */)
- ()
+
+DEFUN ("coding-system-put", Fcoding_system_put, Scoding_system_put,
+ 3, 3, 0,
+ doc: /* Change value in CODING-SYSTEM's property list PROP to VAL. */)
+ (coding_system, prop, val)
+ Lisp_Object coding_system, prop, val;
{
- int i = 0, idx;
- Lisp_Object val;
+ Lisp_Object spec, attrs;
+
+ CHECK_CODING_SYSTEM_GET_SPEC (coding_system, spec);
+ attrs = AREF (spec, 0);
+ if (EQ (prop, QCmnemonic))
+ {
+ if (! STRINGP (val))
+ CHECK_CHARACTER (val);
+ CODING_ATTR_MNEMONIC (attrs) = val;
+ }
+ else if (EQ (prop, QCdefalut_char))
+ {
+ if (NILP (val))
+ val = make_number (' ');
+ else
+ CHECK_CHARACTER (val);
+ CODING_ATTR_DEFAULT_CHAR (attrs) = val;
+ }
+ else if (EQ (prop, QCdecode_translation_table))
+ {
+ if (! CHAR_TABLE_P (val) && ! CONSP (val))
+ CHECK_SYMBOL (val);
+ CODING_ATTR_DECODE_TBL (attrs) = val;
+ }
+ else if (EQ (prop, QCencode_translation_table))
+ {
+ if (! CHAR_TABLE_P (val) && ! CONSP (val))
+ CHECK_SYMBOL (val);
+ CODING_ATTR_ENCODE_TBL (attrs) = val;
+ }
+ else if (EQ (prop, QCpost_read_conversion))
+ {
+ CHECK_SYMBOL (val);
+ CODING_ATTR_POST_READ (attrs) = val;
+ }
+ else if (EQ (prop, QCpre_write_conversion))
+ {
+ CHECK_SYMBOL (val);
+ CODING_ATTR_PRE_WRITE (attrs) = val;
+ }
+ else if (EQ (prop, QCascii_compatible_p))
+ {
+ CODING_ATTR_ASCII_COMPAT (attrs) = val;
+ }
+
+ CODING_ATTR_PLIST (attrs)
+ = Fplist_put (CODING_ATTR_PLIST (attrs), prop, val);
+ return val;
+}
- val = Vcoding_category_list;
- while (CONSP (val) && i < CODING_CATEGORY_IDX_MAX)
+DEFUN ("define-coding-system-alias", Fdefine_coding_system_alias,
+ Sdefine_coding_system_alias, 2, 2, 0,
+ doc: /* Define ALIAS as an alias for CODING-SYSTEM. */)
+ (alias, coding_system)
+ Lisp_Object alias, coding_system;
+{
+ Lisp_Object spec, aliases, eol_type, val;
+
+ CHECK_SYMBOL (alias);
+ CHECK_CODING_SYSTEM_GET_SPEC (coding_system, spec);
+ aliases = AREF (spec, 1);
+ /* ALISES should be a list of length more than zero, and the first
+ element is a base coding system. Append ALIAS at the tail of the
+ list. */
+ while (!NILP (XCDR (aliases)))
+ aliases = XCDR (aliases);
+ XSETCDR (aliases, Fcons (alias, Qnil));
+
+ eol_type = AREF (spec, 2);
+ if (VECTORP (eol_type))
{
- if (! SYMBOLP (XCAR (val)))
- break;
- idx = XFASTINT (Fget (XCAR (val), Qcoding_category_index));
- if (idx >= CODING_CATEGORY_IDX_MAX)
- break;
- coding_priorities[i++] = (1 << idx);
- val = XCDR (val);
+ Lisp_Object subsidiaries;
+ int i;
+
+ subsidiaries = make_subsidiaries (alias);
+ for (i = 0; i < 3; i++)
+ Fdefine_coding_system_alias (AREF (subsidiaries, i),
+ AREF (eol_type, i));
}
- /* If coding-category-list is valid and contains all coding
- categories, `i' should be CODING_CATEGORY_IDX_MAX now. If not,
- the following code saves Emacs from crashing. */
- while (i < CODING_CATEGORY_IDX_MAX)
- coding_priorities[i++] = CODING_CATEGORY_MASK_RAW_TEXT;
+
+ Fputhash (alias, spec, Vcoding_system_hash_table);
+ Vcoding_system_list = Fcons (alias, Vcoding_system_list);
+ val = Fassoc (Fsymbol_name (alias), Vcoding_system_alist);
+ if (NILP (val))
+ Vcoding_system_alist = Fcons (Fcons (Fsymbol_name (alias), Qnil),
+ Vcoding_system_alist);
return Qnil;
}
-DEFUN ("define-coding-system-internal", Fdefine_coding_system_internal,
- Sdefine_coding_system_internal, 1, 1, 0,
- doc: /* Register CODING-SYSTEM as a base coding system.
-This function is internal use only. */)
+DEFUN ("coding-system-base", Fcoding_system_base, Scoding_system_base,
+ 1, 1, 0,
+ doc: /* Return the base of CODING-SYSTEM.
+Any alias or subsidiary coding system is not a base coding system. */)
+ (coding_system)
+ Lisp_Object coding_system;
+{
+ Lisp_Object spec, attrs;
+
+ if (NILP (coding_system))
+ return (Qno_conversion);
+ CHECK_CODING_SYSTEM_GET_SPEC (coding_system, spec);
+ attrs = AREF (spec, 0);
+ return CODING_ATTR_BASE_NAME (attrs);
+}
+
+DEFUN ("coding-system-plist", Fcoding_system_plist, Scoding_system_plist,
+ 1, 1, 0,
+ doc: "Return the property list of CODING-SYSTEM.")
+ (coding_system)
+ Lisp_Object coding_system;
+{
+ Lisp_Object spec, attrs;
+
+ if (NILP (coding_system))
+ coding_system = Qno_conversion;
+ CHECK_CODING_SYSTEM_GET_SPEC (coding_system, spec);
+ attrs = AREF (spec, 0);
+ return CODING_ATTR_PLIST (attrs);
+}
+
+
+DEFUN ("coding-system-aliases", Fcoding_system_aliases, Scoding_system_aliases,
+ 1, 1, 0,
+ doc: /* Return the list of aliases of CODING-SYSTEM. */)
(coding_system)
Lisp_Object coding_system;
{
- Lisp_Object safe_chars, slot;
+ Lisp_Object spec;
- if (NILP (Fcheck_coding_system (coding_system)))
- xsignal1 (Qcoding_system_error, coding_system);
+ if (NILP (coding_system))
+ coding_system = Qno_conversion;
+ CHECK_CODING_SYSTEM_GET_SPEC (coding_system, spec);
+ return AREF (spec, 1);
+}
- safe_chars = coding_safe_chars (coding_system);
- if (! EQ (safe_chars, Qt) && ! CHAR_TABLE_P (safe_chars))
- error ("No valid safe-chars property for %s",
- SDATA (SYMBOL_NAME (coding_system)));
+DEFUN ("coding-system-eol-type", Fcoding_system_eol_type,
+ Scoding_system_eol_type, 1, 1, 0,
+ doc: /* Return eol-type of CODING-SYSTEM.
+An eol-type is integer 0, 1, 2, or a vector of coding systems.
- if (EQ (safe_chars, Qt))
- {
- if (NILP (Fmemq (coding_system, XCAR (Vcoding_system_safe_chars))))
- XSETCAR (Vcoding_system_safe_chars,
- Fcons (coding_system, XCAR (Vcoding_system_safe_chars)));
- }
- else
- {
- slot = Fassq (coding_system, XCDR (Vcoding_system_safe_chars));
- if (NILP (slot))
- XSETCDR (Vcoding_system_safe_chars,
- nconc2 (XCDR (Vcoding_system_safe_chars),
- Fcons (Fcons (coding_system, safe_chars), Qnil)));
- else
- XSETCDR (slot, safe_chars);
- }
- return Qnil;
+Integer values 0, 1, and 2 indicate a format of end-of-line; LF, CRLF,
+and CR respectively.
+
+A vector value indicates that a format of end-of-line should be
+detected automatically. Nth element of the vector is the subsidiary
+coding system whose eol-type is N. */)
+ (coding_system)
+ Lisp_Object coding_system;
+{
+ Lisp_Object spec, eol_type;
+ int n;
+
+ if (NILP (coding_system))
+ coding_system = Qno_conversion;
+ if (! CODING_SYSTEM_P (coding_system))
+ return Qnil;
+ spec = CODING_SYSTEM_SPEC (coding_system);
+ eol_type = AREF (spec, 2);
+ if (VECTORP (eol_type))
+ return Fcopy_sequence (eol_type);
+ n = EQ (eol_type, Qunix) ? 0 : EQ (eol_type, Qdos) ? 1 : 2;
+ return make_number (n);
}
#endif /* emacs */
{
int i;
- /* Emacs' internal format specific initialize routine. */
- for (i = 0; i <= 0x20; i++)
- emacs_code_class[i] = EMACS_control_code;
- emacs_code_class[0x0A] = EMACS_linefeed_code;
- emacs_code_class[0x0D] = EMACS_carriage_return_code;
- for (i = 0x21 ; i < 0x7F; i++)
- emacs_code_class[i] = EMACS_ascii_code;
- emacs_code_class[0x7F] = EMACS_control_code;
- for (i = 0x80; i < 0xFF; i++)
- emacs_code_class[i] = EMACS_invalid_code;
- emacs_code_class[LEADING_CODE_PRIVATE_11] = EMACS_leading_code_3;
- emacs_code_class[LEADING_CODE_PRIVATE_12] = EMACS_leading_code_3;
- emacs_code_class[LEADING_CODE_PRIVATE_21] = EMACS_leading_code_4;
- emacs_code_class[LEADING_CODE_PRIVATE_22] = EMACS_leading_code_4;
+ for (i = 0; i < coding_category_max; i++)
+ {
+ coding_categories[i].id = -1;
+ coding_priorities[i] = i;
+ }
/* ISO2022 specific initialize routine. */
for (i = 0; i < 0x20; i++)
iso_code_class[i] = ISO_graphic_plane_1;
iso_code_class[0x20] = iso_code_class[0x7F] = ISO_0x20_or_0x7F;
iso_code_class[0xA0] = iso_code_class[0xFF] = ISO_0xA0_or_0xFF;
- iso_code_class[ISO_CODE_CR] = ISO_carriage_return;
iso_code_class[ISO_CODE_SO] = ISO_shift_out;
iso_code_class[ISO_CODE_SI] = ISO_shift_in;
iso_code_class[ISO_CODE_SS2_7] = ISO_single_shift_2_7;
iso_code_class[ISO_CODE_SS3] = ISO_single_shift_3;
iso_code_class[ISO_CODE_CSI] = ISO_control_sequence_introducer;
- setup_coding_system (Qnil, &safe_terminal_coding);
- setup_coding_system (Qnil, &default_buffer_file_coding);
-
- bzero (coding_system_table, sizeof coding_system_table);
-
- bzero (ascii_skip_code, sizeof ascii_skip_code);
- for (i = 0; i < 128; i++)
- ascii_skip_code[i] = 1;
-
-#if defined (MSDOS) || defined (WINDOWSNT)
- system_eol_type = CODING_EOL_CRLF;
-#else
- system_eol_type = CODING_EOL_LF;
-#endif
-
- inhibit_pre_post_conversion = 0;
+ for (i = 0; i < 256; i++)
+ {
+ emacs_mule_bytes[i] = 1;
+ }
+ emacs_mule_bytes[EMACS_MULE_LEADING_CODE_PRIVATE_11] = 3;
+ emacs_mule_bytes[EMACS_MULE_LEADING_CODE_PRIVATE_12] = 3;
+ emacs_mule_bytes[EMACS_MULE_LEADING_CODE_PRIVATE_21] = 4;
+ emacs_mule_bytes[EMACS_MULE_LEADING_CODE_PRIVATE_22] = 4;
}
#ifdef emacs
void
syms_of_coding ()
{
+ staticpro (&Vcoding_system_hash_table);
+ {
+ Lisp_Object args[2];
+ args[0] = QCtest;
+ args[1] = Qeq;
+ Vcoding_system_hash_table = Fmake_hash_table (2, args);
+ }
+
+ staticpro (&Vsjis_coding_system);
+ Vsjis_coding_system = Qnil;
+
+ staticpro (&Vbig5_coding_system);
+ Vbig5_coding_system = Qnil;
+
+ staticpro (&Vcode_conversion_reused_workbuf);
+ Vcode_conversion_reused_workbuf = Qnil;
+
staticpro (&Vcode_conversion_workbuf_name);
Vcode_conversion_workbuf_name = build_string (" *code-conversion-work*");
- Qtarget_idx = intern ("target-idx");
- staticpro (&Qtarget_idx);
+ reused_workbuf_in_use = 0;
- Qcoding_system_history = intern ("coding-system-history");
- staticpro (&Qcoding_system_history);
+ DEFSYM (Qcharset, "charset");
+ DEFSYM (Qtarget_idx, "target-idx");
+ DEFSYM (Qcoding_system_history, "coding-system-history");
Fset (Qcoding_system_history, Qnil);
/* Target FILENAME is the first argument. */
/* Target FILENAME is the third argument. */
Fput (Qwrite_region, Qtarget_idx, make_number (2));
- Qcall_process = intern ("call-process");
- staticpro (&Qcall_process);
+ DEFSYM (Qcall_process, "call-process");
/* Target PROGRAM is the first argument. */
Fput (Qcall_process, Qtarget_idx, make_number (0));
- Qcall_process_region = intern ("call-process-region");
- staticpro (&Qcall_process_region);
+ DEFSYM (Qcall_process_region, "call-process-region");
/* Target PROGRAM is the third argument. */
Fput (Qcall_process_region, Qtarget_idx, make_number (2));
- Qstart_process = intern ("start-process");
- staticpro (&Qstart_process);
+ DEFSYM (Qstart_process, "start-process");
/* Target PROGRAM is the third argument. */
Fput (Qstart_process, Qtarget_idx, make_number (2));
- Qopen_network_stream = intern ("open-network-stream");
- staticpro (&Qopen_network_stream);
+ DEFSYM (Qopen_network_stream, "open-network-stream");
/* Target SERVICE is the fourth argument. */
Fput (Qopen_network_stream, Qtarget_idx, make_number (3));
- Qcoding_system = intern ("coding-system");
- staticpro (&Qcoding_system);
+ DEFSYM (Qcoding_system, "coding-system");
+ DEFSYM (Qcoding_aliases, "coding-aliases");
- Qeol_type = intern ("eol-type");
- staticpro (&Qeol_type);
+ DEFSYM (Qeol_type, "eol-type");
+ DEFSYM (Qunix, "unix");
+ DEFSYM (Qdos, "dos");
- Qbuffer_file_coding_system = intern ("buffer-file-coding-system");
- staticpro (&Qbuffer_file_coding_system);
+ DEFSYM (Qbuffer_file_coding_system, "buffer-file-coding-system");
+ DEFSYM (Qpost_read_conversion, "post-read-conversion");
+ DEFSYM (Qpre_write_conversion, "pre-write-conversion");
+ DEFSYM (Qdefault_char, "default-char");
+ DEFSYM (Qundecided, "undecided");
+ DEFSYM (Qno_conversion, "no-conversion");
+ DEFSYM (Qraw_text, "raw-text");
- Qpost_read_conversion = intern ("post-read-conversion");
- staticpro (&Qpost_read_conversion);
+ DEFSYM (Qiso_2022, "iso-2022");
- Qpre_write_conversion = intern ("pre-write-conversion");
- staticpro (&Qpre_write_conversion);
+ DEFSYM (Qutf_8, "utf-8");
+ DEFSYM (Qutf_8_emacs, "utf-8-emacs");
- Qno_conversion = intern ("no-conversion");
- staticpro (&Qno_conversion);
+ DEFSYM (Qutf_16, "utf-16");
+ DEFSYM (Qbig, "big");
+ DEFSYM (Qlittle, "little");
- Qundecided = intern ("undecided");
- staticpro (&Qundecided);
+ DEFSYM (Qshift_jis, "shift-jis");
+ DEFSYM (Qbig5, "big5");
- Qcoding_system_p = intern ("coding-system-p");
- staticpro (&Qcoding_system_p);
-
- Qcoding_system_error = intern ("coding-system-error");
- staticpro (&Qcoding_system_error);
+ DEFSYM (Qcoding_system_p, "coding-system-p");
+ DEFSYM (Qcoding_system_error, "coding-system-error");
Fput (Qcoding_system_error, Qerror_conditions,
Fcons (Qcoding_system_error, Fcons (Qerror, Qnil)));
Fput (Qcoding_system_error, Qerror_message,
build_string ("Invalid coding system"));
- Qcoding_category = intern ("coding-category");
- staticpro (&Qcoding_category);
- Qcoding_category_index = intern ("coding-category-index");
- staticpro (&Qcoding_category_index);
-
- Vcoding_category_table
- = Fmake_vector (make_number (CODING_CATEGORY_IDX_MAX), Qnil);
- staticpro (&Vcoding_category_table);
- {
- int i;
- for (i = 0; i < CODING_CATEGORY_IDX_MAX; i++)
- {
- XVECTOR (Vcoding_category_table)->contents[i]
- = intern (coding_category_name[i]);
- Fput (XVECTOR (Vcoding_category_table)->contents[i],
- Qcoding_category_index, make_number (i));
- }
- }
-
- Vcoding_system_safe_chars = Fcons (Qnil, Qnil);
- staticpro (&Vcoding_system_safe_chars);
-
- Qtranslation_table = intern ("translation-table");
- staticpro (&Qtranslation_table);
- Fput (Qtranslation_table, Qchar_table_extra_slots, make_number (2));
-
- Qtranslation_table_id = intern ("translation-table-id");
- staticpro (&Qtranslation_table_id);
-
- Qtranslation_table_for_decode = intern ("translation-table-for-decode");
- staticpro (&Qtranslation_table_for_decode);
-
- Qtranslation_table_for_encode = intern ("translation-table-for-encode");
- staticpro (&Qtranslation_table_for_encode);
-
- Qsafe_chars = intern ("safe-chars");
- staticpro (&Qsafe_chars);
-
- Qchar_coding_system = intern ("char-coding-system");
- staticpro (&Qchar_coding_system);
-
/* Intern this now in case it isn't already done.
Setting this variable twice is harmless.
But don't staticpro it here--that is done in alloc.c. */
Qchar_table_extra_slots = intern ("char-table-extra-slots");
- Fput (Qsafe_chars, Qchar_table_extra_slots, make_number (0));
- Fput (Qchar_coding_system, Qchar_table_extra_slots, make_number (0));
- Qvalid_codes = intern ("valid-codes");
- staticpro (&Qvalid_codes);
-
- Qascii_incompatible = intern ("ascii-incompatible");
- staticpro (&Qascii_incompatible);
+ DEFSYM (Qtranslation_table, "translation-table");
+ Fput (Qtranslation_table, Qchar_table_extra_slots, make_number (2));
+ DEFSYM (Qtranslation_table_id, "translation-table-id");
+ DEFSYM (Qtranslation_table_for_decode, "translation-table-for-decode");
+ DEFSYM (Qtranslation_table_for_encode, "translation-table-for-encode");
- Qemacs_mule = intern ("emacs-mule");
- staticpro (&Qemacs_mule);
+ DEFSYM (Qvalid_codes, "valid-codes");
- Qraw_text = intern ("raw-text");
- staticpro (&Qraw_text);
+ DEFSYM (Qemacs_mule, "emacs-mule");
- Qutf_8 = intern ("utf-8");
- staticpro (&Qutf_8);
+ DEFSYM (QCcategory, ":category");
+ DEFSYM (QCmnemonic, ":mnemonic");
+ DEFSYM (QCdefalut_char, ":default-char");
+ DEFSYM (QCdecode_translation_table, ":decode-translation-table");
+ DEFSYM (QCencode_translation_table, ":encode-translation-table");
+ DEFSYM (QCpost_read_conversion, ":post-read-conversion");
+ DEFSYM (QCpre_write_conversion, ":pre-write-conversion");
+ DEFSYM (QCascii_compatible_p, ":ascii-compatible-p");
- Qcoding_system_define_form = intern ("coding-system-define-form");
- staticpro (&Qcoding_system_define_form);
+ Vcoding_category_table
+ = Fmake_vector (make_number (coding_category_max), Qnil);
+ staticpro (&Vcoding_category_table);
+ /* Followings are target of code detection. */
+ ASET (Vcoding_category_table, coding_category_iso_7,
+ intern ("coding-category-iso-7"));
+ ASET (Vcoding_category_table, coding_category_iso_7_tight,
+ intern ("coding-category-iso-7-tight"));
+ ASET (Vcoding_category_table, coding_category_iso_8_1,
+ intern ("coding-category-iso-8-1"));
+ ASET (Vcoding_category_table, coding_category_iso_8_2,
+ intern ("coding-category-iso-8-2"));
+ ASET (Vcoding_category_table, coding_category_iso_7_else,
+ intern ("coding-category-iso-7-else"));
+ ASET (Vcoding_category_table, coding_category_iso_8_else,
+ intern ("coding-category-iso-8-else"));
+ ASET (Vcoding_category_table, coding_category_utf_8,
+ intern ("coding-category-utf-8"));
+ ASET (Vcoding_category_table, coding_category_utf_16_be,
+ intern ("coding-category-utf-16-be"));
+ ASET (Vcoding_category_table, coding_category_utf_16_auto,
+ intern ("coding-category-utf-16-auto"));
+ ASET (Vcoding_category_table, coding_category_utf_16_le,
+ intern ("coding-category-utf-16-le"));
+ ASET (Vcoding_category_table, coding_category_utf_16_be_nosig,
+ intern ("coding-category-utf-16-be-nosig"));
+ ASET (Vcoding_category_table, coding_category_utf_16_le_nosig,
+ intern ("coding-category-utf-16-le-nosig"));
+ ASET (Vcoding_category_table, coding_category_charset,
+ intern ("coding-category-charset"));
+ ASET (Vcoding_category_table, coding_category_sjis,
+ intern ("coding-category-sjis"));
+ ASET (Vcoding_category_table, coding_category_big5,
+ intern ("coding-category-big5"));
+ ASET (Vcoding_category_table, coding_category_ccl,
+ intern ("coding-category-ccl"));
+ ASET (Vcoding_category_table, coding_category_emacs_mule,
+ intern ("coding-category-emacs-mule"));
+ /* Followings are NOT target of code detection. */
+ ASET (Vcoding_category_table, coding_category_raw_text,
+ intern ("coding-category-raw-text"));
+ ASET (Vcoding_category_table, coding_category_undecided,
+ intern ("coding-category-undecided"));
+
+ DEFSYM (Qinsufficient_source, "insufficient-source");
+ DEFSYM (Qinconsistent_eol, "inconsistent-eol");
+ DEFSYM (Qinvalid_source, "invalid-source");
+ DEFSYM (Qinterrupted, "interrupted");
+ DEFSYM (Qinsufficient_memory, "insufficient-memory");
+ DEFSYM (Qcoding_system_define_form, "coding-system-define-form");
defsubr (&Scoding_system_p);
defsubr (&Sread_coding_system);
defsubr (&Sdetect_coding_string);
defsubr (&Sfind_coding_systems_region_internal);
defsubr (&Sunencodable_char_position);
+ defsubr (&Scheck_coding_systems_region);
defsubr (&Sdecode_coding_region);
defsubr (&Sencode_coding_region);
defsubr (&Sdecode_coding_string);
defsubr (&Sset_keyboard_coding_system_internal);
defsubr (&Skeyboard_coding_system);
defsubr (&Sfind_operation_coding_system);
- defsubr (&Supdate_coding_systems_internal);
- defsubr (&Sset_coding_priority_internal);
+ defsubr (&Sset_coding_system_priority);
defsubr (&Sdefine_coding_system_internal);
+ defsubr (&Sdefine_coding_system_alias);
+ defsubr (&Scoding_system_put);
+ defsubr (&Scoding_system_base);
+ defsubr (&Scoding_system_plist);
+ defsubr (&Scoding_system_aliases);
+ defsubr (&Scoding_system_eol_type);
+ defsubr (&Scoding_system_priority_list);
DEFVAR_LISP ("coding-system-list", &Vcoding_system_list,
doc: /* List of coding systems.
Do not alter the value of this variable manually. This variable should be
-updated by the functions `make-coding-system' and
+updated by the functions `define-coding-system' and
`define-coding-system-alias'. */);
Vcoding_system_list = Qnil;
int i;
Vcoding_category_list = Qnil;
- for (i = CODING_CATEGORY_IDX_MAX - 1; i >= 0; i--)
+ for (i = coding_category_max - 1; i >= 0; i--)
Vcoding_category_list
= Fcons (XVECTOR (Vcoding_category_table)->contents[i],
Vcoding_category_list);
Vcoding_system_for_write = Qnil;
DEFVAR_LISP ("last-coding-system-used", &Vlast_coding_system_used,
- doc: /* Coding system used in the latest file or process I/O.
-Also set by `encode-coding-region', `decode-coding-region',
-`encode-coding-string' and `decode-coding-string'. */);
+ doc: /*
+Coding system used in the latest file or process I/O. */);
Vlast_coding_system_used = Qnil;
+ DEFVAR_LISP ("last-code-conversion-error", &Vlast_code_conversion_error,
+ doc: /*
+Error status of the last code conversion.
+
+When an error was detected in the last code conversion, this variable
+is set to one of the following symbols.
+ `insufficient-source'
+ `inconsistent-eol'
+ `invalid-source'
+ `interrupted'
+ `insufficient-memory'
+When no error was detected, the value doesn't change. So, to check
+the error status of a code conversion by this variable, you must
+explicitly set this variable to nil before performing code
+conversion. */);
+ Vlast_code_conversion_error = Qnil;
+
DEFVAR_BOOL ("inhibit-eol-conversion", &inhibit_eol_conversion,
- doc: /* *Non-nil means always inhibit code conversion of end-of-line format.
+ doc: /*
+*Non-nil means always inhibit code conversion of end-of-line format.
See info node `Coding Systems' and info node `Text and Binary' concerning
such conversion. */);
inhibit_eol_conversion = 0;
DEFVAR_BOOL ("inherit-process-coding-system", &inherit_process_coding_system,
- doc: /* Non-nil means process buffer inherits coding system of process output.
+ doc: /*
+Non-nil means process buffer inherits coding system of process output.
Bind it to t if the process output is to be treated as if it were a file
read from some filesystem. */);
inherit_process_coding_system = 0;
DEFVAR_LISP ("file-coding-system-alist", &Vfile_coding_system_alist,
- doc: /* Alist to decide a coding system to use for a file I/O operation.
+ doc: /*
+Alist to decide a coding system to use for a file I/O operation.
The format is ((PATTERN . VAL) ...),
where PATTERN is a regular expression matching a file name,
VAL is a coding system, a cons of coding systems, or a function symbol.
Vfile_coding_system_alist = Qnil;
DEFVAR_LISP ("process-coding-system-alist", &Vprocess_coding_system_alist,
- doc: /* Alist to decide a coding system to use for a process I/O operation.
+ doc: /*
+Alist to decide a coding system to use for a process I/O operation.
The format is ((PATTERN . VAL) ...),
where PATTERN is a regular expression matching a program name,
VAL is a coding system, a cons of coding systems, or a function symbol.
Vprocess_coding_system_alist = Qnil;
DEFVAR_LISP ("network-coding-system-alist", &Vnetwork_coding_system_alist,
- doc: /* Alist to decide a coding system to use for a network I/O operation.
+ doc: /*
+Alist to decide a coding system to use for a network I/O operation.
The format is ((PATTERN . VAL) ...),
where PATTERN is a regular expression matching a network service name
or is a port number to connect to,
/* The eol mnemonics are reset in startup.el system-dependently. */
DEFVAR_LISP ("eol-mnemonic-unix", &eol_mnemonic_unix,
- doc: /* *String displayed in mode line for UNIX-like (LF) end-of-line format. */);
+ doc: /*
+*String displayed in mode line for UNIX-like (LF) end-of-line format. */);
eol_mnemonic_unix = build_string (":");
DEFVAR_LISP ("eol-mnemonic-dos", &eol_mnemonic_dos,
- doc: /* *String displayed in mode line for DOS-like (CRLF) end-of-line format. */);
+ doc: /*
+*String displayed in mode line for DOS-like (CRLF) end-of-line format. */);
eol_mnemonic_dos = build_string ("\\");
DEFVAR_LISP ("eol-mnemonic-mac", &eol_mnemonic_mac,
- doc: /* *String displayed in mode line for MAC-like (CR) end-of-line format. */);
+ doc: /*
+*String displayed in mode line for MAC-like (CR) end-of-line format. */);
eol_mnemonic_mac = build_string ("/");
DEFVAR_LISP ("eol-mnemonic-undecided", &eol_mnemonic_undecided,
- doc: /* *String displayed in mode line when end-of-line format is not yet determined. */);
+ doc: /*
+*String displayed in mode line when end-of-line format is not yet determined. */);
eol_mnemonic_undecided = build_string (":");
DEFVAR_LISP ("enable-character-translation", &Venable_character_translation,
- doc: /* *Non-nil enables character translation while encoding and decoding. */);
+ doc: /*
+*Non-nil enables character translation while encoding and decoding. */);
Venable_character_translation = Qt;
DEFVAR_LISP ("standard-translation-table-for-decode",
doc: /* Table for translating characters while encoding. */);
Vstandard_translation_table_for_encode = Qnil;
- DEFVAR_LISP ("charset-revision-table", &Vcharset_revision_alist,
+ DEFVAR_LISP ("charset-revision-table", &Vcharset_revision_table,
doc: /* Alist of charsets vs revision numbers.
While encoding, if a charset (car part of an element) is found,
-designate it with the escape sequence identifying revision (cdr part of the element). */);
- Vcharset_revision_alist = Qnil;
+designate it with the escape sequence identifying revision (cdr part
+of the element). */);
+ Vcharset_revision_table = Qnil;
DEFVAR_LISP ("default-process-coding-system",
&Vdefault_process_coding_system,
Vdefault_process_coding_system = Qnil;
DEFVAR_LISP ("latin-extra-code-table", &Vlatin_extra_code_table,
- doc: /* Table of extra Latin codes in the range 128..159 (inclusive).
+ doc: /*
+Table of extra Latin codes in the range 128..159 (inclusive).
This is a vector of length 256.
If Nth element is non-nil, the existence of code N in a file
\(or output of subprocess) doesn't prevent it to be detected as
DEFVAR_LISP ("select-safe-coding-system-function",
&Vselect_safe_coding_system_function,
- doc: /* Function to call to select safe coding system for encoding a text.
+ doc: /*
+Function to call to select safe coding system for encoding a text.
If set, this function is called to force a user to select a proper
coding system which can encode the text in the case that a default
DEFVAR_BOOL ("inhibit-iso-escape-detection",
&inhibit_iso_escape_detection,
- doc: /* If non-nil, Emacs ignores ISO2022's escape sequence on code detection.
+ doc: /*
+If non-nil, Emacs ignores ISO2022's escape sequence on code detection.
By default, on reading a file, Emacs tries to detect how the text is
encoded. This code detection is sensitive to escape sequences. If
This is applied to the result of input methods, not their input. See also
`keyboard-translate-table'. */);
Vtranslation_table_for_input = Qnil;
+
+ {
+ Lisp_Object args[coding_arg_max];
+ Lisp_Object plist[16];
+ int i;
+
+ for (i = 0; i < coding_arg_max; i++)
+ args[i] = Qnil;
+
+ plist[0] = intern (":name");
+ plist[1] = args[coding_arg_name] = Qno_conversion;
+ plist[2] = intern (":mnemonic");
+ plist[3] = args[coding_arg_mnemonic] = make_number ('=');
+ plist[4] = intern (":coding-type");
+ plist[5] = args[coding_arg_coding_type] = Qraw_text;
+ plist[6] = intern (":ascii-compatible-p");
+ plist[7] = args[coding_arg_ascii_compatible_p] = Qt;
+ plist[8] = intern (":default-char");
+ plist[9] = args[coding_arg_default_char] = make_number (0);
+ plist[10] = intern (":for-unibyte");
+ plist[11] = args[coding_arg_for_unibyte] = Qt;
+ plist[12] = intern (":docstring");
+ plist[13] = build_string ("Do no conversion.\n\
+\n\
+When you visit a file with this coding, the file is read into a\n\
+unibyte buffer as is, thus each byte of a file is treated as a\n\
+character.");
+ plist[14] = intern (":eol-type");
+ plist[15] = args[coding_arg_eol_type] = Qunix;
+ args[coding_arg_plist] = Flist (16, plist);
+ Fdefine_coding_system_internal (coding_arg_max, args);
+
+ plist[1] = args[coding_arg_name] = Qundecided;
+ plist[3] = args[coding_arg_mnemonic] = make_number ('-');
+ plist[5] = args[coding_arg_coding_type] = Qundecided;
+ /* This is already set.
+ plist[7] = args[coding_arg_ascii_compatible_p] = Qt; */
+ plist[8] = intern (":charset-list");
+ plist[9] = args[coding_arg_charset_list] = Fcons (Qascii, Qnil);
+ plist[11] = args[coding_arg_for_unibyte] = Qnil;
+ plist[13] = build_string ("No conversion on encoding, automatic conversion on decoding.");
+ plist[15] = args[coding_arg_eol_type] = Qnil;
+ args[coding_arg_plist] = Flist (16, plist);
+ Fdefine_coding_system_internal (coding_arg_max, args);
+ }
+
+ setup_coding_system (Qno_conversion, &safe_terminal_coding);
+
+ {
+ int i;
+
+ for (i = 0; i < coding_category_max; i++)
+ Fset (AREF (Vcoding_category_table, i), Qno_conversion);
+ }
+#if defined (MSDOS) || defined (WINDOWSNT)
+ system_eol_type = Qdos;
+#else
+ system_eol_type = Qunix;
+#endif
+ staticpro (&system_eol_type);
}
char *
/* Header for coding system handler.
Copyright (C) 2001, 2002, 2003, 2004, 2005,
- 2006, 2007 Free Software Foundation, Inc.
+ 2006, 2007, 2008 Free Software Foundation, Inc.
Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- 2005, 2006, 2007
+ 2005, 2006, 2007, 2008
National Institute of Advanced Industrial Science and Technology (AIST)
Registration Number H14PRO021
+ Copyright (C) 2003
+ National Institute of Advanced Industrial Science and Technology (AIST)
+ Registration Number H13PRO009
This file is part of GNU Emacs.
#ifndef EMACS_CODING_H
#define EMACS_CODING_H
-#include "ccl.h"
+/* Index to arguments of Fdefine_coding_system_internal. */
-/*** EMACS' INTERNAL FORMAT (emacs-mule) section ***/
+enum define_coding_system_arg_index
+ {
+ coding_arg_name,
+ coding_arg_mnemonic,
+ coding_arg_coding_type,
+ coding_arg_charset_list,
+ coding_arg_ascii_compatible_p,
+ coding_arg_decode_translation_table,
+ coding_arg_encode_translation_table,
+ coding_arg_post_read_conversion,
+ coding_arg_pre_write_conversion,
+ coding_arg_default_char,
+ coding_arg_for_unibyte,
+ coding_arg_plist,
+ coding_arg_eol_type,
+ coding_arg_max
+ };
-/* All code (1-byte) of Emacs' internal format is classified into one
- of the followings. See also `charset.h'. */
-enum emacs_code_class_type
+enum define_coding_iso2022_arg_index
{
- EMACS_control_code, /* Control codes in the range
- 0x00..0x1F and 0x7F except for the
- following two codes. */
- EMACS_linefeed_code, /* 0x0A (linefeed) to denote
- end-of-line. */
- EMACS_carriage_return_code, /* 0x0D (carriage-return) to be used
- in selective display mode. */
- EMACS_ascii_code, /* ASCII characters. */
- EMACS_leading_code_2, /* Base leading code of official
- TYPE9N character. */
- EMACS_leading_code_3, /* Base leading code of private TYPE9N
- or official TYPE9Nx9N character. */
- EMACS_leading_code_4, /* Base leading code of private
- TYPE9Nx9N character. */
- EMACS_invalid_code /* Invalid code, i.e. a base leading
- code not yet assigned to any
- charset, or a code of the range
- 0xA0..0xFF. */
+ coding_arg_iso2022_initial = coding_arg_max,
+ coding_arg_iso2022_reg_usage,
+ coding_arg_iso2022_request,
+ coding_arg_iso2022_flags,
+ coding_arg_iso2022_max
};
-extern enum emacs_code_class_type emacs_code_class[256];
-
-/*** ISO2022 section ***/
-
-/* Macros to define code of control characters for ISO2022's functions. */
- /* code */ /* function */
-#define ISO_CODE_LF 0x0A /* line-feed */
-#define ISO_CODE_CR 0x0D /* carriage-return */
-#define ISO_CODE_SO 0x0E /* shift-out */
-#define ISO_CODE_SI 0x0F /* shift-in */
-#define ISO_CODE_SS2_7 0x19 /* single-shift-2 for 7-bit code */
-#define ISO_CODE_ESC 0x1B /* escape */
-#define ISO_CODE_SS2 0x8E /* single-shift-2 */
-#define ISO_CODE_SS3 0x8F /* single-shift-3 */
-#define ISO_CODE_CSI 0x9B /* control-sequence-introduce */
-
-/* All code (1-byte) of ISO2022 is classified into one of the
- followings. */
-enum iso_code_class_type
+enum define_coding_utf16_arg_index
{
- ISO_control_0, /* Control codes in the range
- 0x00..0x1F and 0x7F, except for the
- following 5 codes. */
- ISO_carriage_return, /* ISO_CODE_CR (0x0D) */
- ISO_shift_out, /* ISO_CODE_SO (0x0E) */
- ISO_shift_in, /* ISO_CODE_SI (0x0F) */
- ISO_single_shift_2_7, /* ISO_CODE_SS2_7 (0x19) */
- ISO_escape, /* ISO_CODE_SO (0x1B) */
- ISO_control_1, /* Control codes in the range
- 0x80..0x9F, except for the
- following 3 codes. */
- ISO_single_shift_2, /* ISO_CODE_SS2 (0x8E) */
- ISO_single_shift_3, /* ISO_CODE_SS3 (0x8F) */
- ISO_control_sequence_introducer, /* ISO_CODE_CSI (0x9B) */
- ISO_0x20_or_0x7F, /* Codes of the values 0x20 or 0x7F. */
- ISO_graphic_plane_0, /* Graphic codes in the range 0x21..0x7E. */
- ISO_0xA0_or_0xFF, /* Codes of the values 0xA0 or 0xFF. */
- ISO_graphic_plane_1 /* Graphic codes in the range 0xA1..0xFE. */
+ coding_arg_utf16_bom = coding_arg_max,
+ coding_arg_utf16_endian,
+ coding_arg_utf16_max
};
-/** The macros CODING_FLAG_ISO_XXX defines a flag bit of the `flags'
- element in the structure `coding_system'. This information is used
- while encoding a text to ISO2022. **/
+enum define_coding_ccl_arg_index
+ {
+ coding_arg_ccl_decoder = coding_arg_max,
+ coding_arg_ccl_encoder,
+ coding_arg_ccl_valids,
+ coding_arg_ccl_max
+ };
-/* If set, produce short-form designation sequence (e.g. ESC $ A)
- instead of long-form sequence (e.g. ESC $ ( A). */
-#define CODING_FLAG_ISO_SHORT_FORM 0x0001
+/* Hash table for all coding systems. Keys are coding system symbols
+ and values are spec vectors of the corresponding coding system. A
+ spec vector has the form [ ATTRS ALIASES EOL-TYPE ]. ATTRS is a
+ vector of attribute of the coding system. ALIASES is a list of
+ aliases (symbols) of the coding system. EOL-TYPE is `unix', `dos',
+ `mac' or a vector of coding systems (symbols). */
-/* If set, reset graphic planes and registers at end-of-line to the
- initial state. */
-#define CODING_FLAG_ISO_RESET_AT_EOL 0x0002
+extern Lisp_Object Vcoding_system_hash_table;
-/* If set, reset graphic planes and registers before any control
- characters to the initial state. */
-#define CODING_FLAG_ISO_RESET_AT_CNTL 0x0004
-/* If set, encode by 7-bit environment. */
-#define CODING_FLAG_ISO_SEVEN_BITS 0x0008
+/* Enumeration of coding system type. */
-/* If set, use locking-shift function. */
-#define CODING_FLAG_ISO_LOCKING_SHIFT 0x0010
+enum coding_system_type
+ {
+ coding_type_charset,
+ coding_type_utf_8,
+ coding_type_utf_16,
+ coding_type_iso_2022,
+ coding_type_emacs_mule,
+ coding_type_sjis,
+ coding_type_ccl,
+ coding_type_raw_text,
+ coding_type_undecided,
+ coding_type_max
+ };
-/* If set, use single-shift function. Overwrite
- CODING_FLAG_ISO_LOCKING_SHIFT. */
-#define CODING_FLAG_ISO_SINGLE_SHIFT 0x0020
-/* If set, designate JISX0201-Roman instead of ASCII. */
-#define CODING_FLAG_ISO_USE_ROMAN 0x0040
+/* Enumeration of end-of-line format type. */
-/* If set, designate JISX0208-1978 instead of JISX0208-1983. */
-#define CODING_FLAG_ISO_USE_OLDJIS 0x0080
+enum end_of_line_type
+ {
+ eol_lf, /* Line-feed only, same as Emacs' internal
+ format. */
+ eol_crlf, /* Sequence of carriage-return and
+ line-feed. */
+ eol_cr, /* Carriage-return only. */
+ eol_any, /* Accept any of above. Produce line-feed
+ only. */
+ eol_undecided, /* This value is used to denote that the
+ eol-type is not yet undecided. */
+ eol_type_max
+ };
-/* If set, do not produce ISO6429's direction specifying sequence. */
-#define CODING_FLAG_ISO_NO_DIRECTION 0x0100
+/* Enumeration of index to an attribute vector of a coding system. */
-/* If set, assume designation states are reset at beginning of line on
- output. */
-#define CODING_FLAG_ISO_INIT_AT_BOL 0x0200
+enum coding_attr_index
+ {
+ coding_attr_base_name,
+ coding_attr_docstring,
+ coding_attr_mnemonic,
+ coding_attr_type,
+ coding_attr_charset_list,
+ coding_attr_ascii_compat,
+ coding_attr_decode_tbl,
+ coding_attr_encode_tbl,
+ coding_attr_trans_tbl,
+ coding_attr_post_read,
+ coding_attr_pre_write,
+ coding_attr_default_char,
+ coding_attr_for_unibyte,
+ coding_attr_plist,
+
+ coding_attr_category,
+ coding_attr_safe_charsets,
+
+ /* The followings are extra attributes for each type. */
+ coding_attr_charset_valids,
+
+ coding_attr_ccl_decoder,
+ coding_attr_ccl_encoder,
+ coding_attr_ccl_valids,
+
+ coding_attr_iso_initial,
+ coding_attr_iso_usage,
+ coding_attr_iso_request,
+ coding_attr_iso_flags,
+
+ coding_attr_utf_16_bom,
+ coding_attr_utf_16_endian,
+
+ coding_attr_emacs_mule_full,
+
+ coding_attr_last_index
+ };
-/* If set, designation sequence should be placed at beginning of line
- on output. */
-#define CODING_FLAG_ISO_DESIGNATE_AT_BOL 0x0400
-/* If set, do not encode unsafe characters on output. */
-#define CODING_FLAG_ISO_SAFE 0x0800
+/* Macros to access an element of an attribute vector. */
-/* If set, extra latin codes (128..159) are accepted as a valid code
- on input. */
-#define CODING_FLAG_ISO_LATIN_EXTRA 0x1000
+#define CODING_ATTR_BASE_NAME(attrs) AREF (attrs, coding_attr_base_name)
+#define CODING_ATTR_TYPE(attrs) AREF (attrs, coding_attr_type)
+#define CODING_ATTR_CHARSET_LIST(attrs) AREF (attrs, coding_attr_charset_list)
+#define CODING_ATTR_MNEMONIC(attrs) AREF (attrs, coding_attr_mnemonic)
+#define CODING_ATTR_DOCSTRING(attrs) AREF (attrs, coding_attr_docstring)
+#define CODING_ATTR_ASCII_COMPAT(attrs) AREF (attrs, coding_attr_ascii_compat)
+#define CODING_ATTR_DECODE_TBL(attrs) AREF (attrs, coding_attr_decode_tbl)
+#define CODING_ATTR_ENCODE_TBL(attrs) AREF (attrs, coding_attr_encode_tbl)
+#define CODING_ATTR_TRANS_TBL(attrs) AREF (attrs, coding_attr_trans_tbl)
+#define CODING_ATTR_POST_READ(attrs) AREF (attrs, coding_attr_post_read)
+#define CODING_ATTR_PRE_WRITE(attrs) AREF (attrs, coding_attr_pre_write)
+#define CODING_ATTR_DEFAULT_CHAR(attrs) AREF (attrs, coding_attr_default_char)
+#define CODING_ATTR_FOR_UNIBYTE(attrs) AREF (attrs, coding_attr_for_unibyte)
+#define CODING_ATTR_FLUSHING(attrs) AREF (attrs, coding_attr_flushing)
+#define CODING_ATTR_PLIST(attrs) AREF (attrs, coding_attr_plist)
+#define CODING_ATTR_CATEGORY(attrs) AREF (attrs, coding_attr_category)
+#define CODING_ATTR_SAFE_CHARSETS(attrs)AREF (attrs, coding_attr_safe_charsets)
-/* If set, use designation escape sequence. */
-#define CODING_FLAG_ISO_DESIGNATION 0x10000
-/* A character to be produced on output if encoding of the original
- character is inhibitted by CODING_MODE_INHIBIT_UNENCODABLE_CHAR.
- It must be an ASCII character. */
-#define CODING_REPLACEMENT_CHARACTER '?'
+/* Return the name of a coding system specified by ID. */
+#define CODING_ID_NAME(id) \
+ (HASH_KEY (XHASH_TABLE (Vcoding_system_hash_table), id))
-/* Structure of the field `spec.iso2022' in the structure `coding_system'. */
-struct iso2022_spec
-{
- /* The current graphic register invoked to each graphic plane. */
- int current_invocation[2];
+/* Return the attribute vector of a coding system specified by ID. */
- /* The current charset designated to each graphic register. */
- int current_designation[4];
+#define CODING_ID_ATTRS(id) \
+ (AREF (HASH_VALUE (XHASH_TABLE (Vcoding_system_hash_table), id), 0))
- /* A charset initially designated to each graphic register. */
- int initial_designation[4];
+/* Return the list of aliases of a coding system specified by ID. */
- /* If not -1, it is a graphic register specified in an invalid
- designation sequence. */
- int last_invalid_designation_register;
+#define CODING_ID_ALIASES(id) \
+ (AREF (HASH_VALUE (XHASH_TABLE (Vcoding_system_hash_table), id), 1))
- /* A graphic register to which each charset should be designated. */
- unsigned char requested_designation[MAX_CHARSET + 1];
+/* Return the eol-type of a coding system specified by ID. */
- /* A revision number to be specified for each charset on encoding.
- The value 255 means no revision number for the corresponding
- charset. */
- unsigned char charset_revision_number[MAX_CHARSET + 1];
+#define CODING_ID_EOL_TYPE(id) \
+ (AREF (HASH_VALUE (XHASH_TABLE (Vcoding_system_hash_table), id), 2))
- /* Set to 1 temporarily only when graphic register 2 or 3 is invoked
- by single-shift while encoding. */
- int single_shifting;
- /* Set to 1 temporarily only when processing at beginning of line. */
- int bol;
-};
+/* Return the spec vector of CODING_SYSTEM_SYMBOL. */
+
+#define CODING_SYSTEM_SPEC(coding_system_symbol) \
+ (Fgethash (coding_system_symbol, Vcoding_system_hash_table, Qnil))
+
+
+/* Return the ID of CODING_SYSTEM_SYMBOL. */
+
+#define CODING_SYSTEM_ID(coding_system_symbol) \
+ hash_lookup (XHASH_TABLE (Vcoding_system_hash_table), \
+ coding_system_symbol, NULL)
+
+/* Return 1 if CODING_SYSTEM_SYMBOL is a coding system. */
+
+#define CODING_SYSTEM_P(coding_system_symbol) \
+ (CODING_SYSTEM_ID (coding_system_symbol) >= 0 \
+ || (! NILP (coding_system_symbol) \
+ && ! NILP (Fcoding_system_p (coding_system_symbol))))
+
+/* Check if X is a coding system or not. */
+
+#define CHECK_CODING_SYSTEM(x) \
+ do { \
+ if (CODING_SYSTEM_ID (x) < 0 \
+ && NILP (Fcheck_coding_system (x))) \
+ wrong_type_argument (Qcoding_system_p, (x)); \
+ } while (0)
+
+
+/* Check if X is a coding system or not. If it is, set SEPC to the
+ spec vector of the coding system. */
+
+#define CHECK_CODING_SYSTEM_GET_SPEC(x, spec) \
+ do { \
+ spec = CODING_SYSTEM_SPEC (x); \
+ if (NILP (spec)) \
+ { \
+ Fcheck_coding_system (x); \
+ spec = CODING_SYSTEM_SPEC (x); \
+ } \
+ if (NILP (spec)) \
+ x = wrong_type_argument (Qcoding_system_p, (x)); \
+ } while (0)
+
+
+/* Check if X is a coding system or not. If it is, set ID to the
+ ID of the coding system. */
+
+#define CHECK_CODING_SYSTEM_GET_ID(x, id) \
+ do \
+ { \
+ id = CODING_SYSTEM_ID (x); \
+ if (id < 0) \
+ { \
+ Fcheck_coding_system (x); \
+ id = CODING_SYSTEM_ID (x); \
+ } \
+ if (id < 0) \
+ x = wrong_type_argument (Qcoding_system_p, (x)); \
+ } while (0)
-/* Macros to access each field in the structure `spec.iso2022'. */
-#define CODING_SPEC_ISO_INVOCATION(coding, plane) \
- (coding)->spec.iso2022.current_invocation[plane]
-#define CODING_SPEC_ISO_DESIGNATION(coding, reg) \
- (coding)->spec.iso2022.current_designation[reg]
-#define CODING_SPEC_ISO_INITIAL_DESIGNATION(coding, reg) \
- (coding)->spec.iso2022.initial_designation[reg]
-#define CODING_SPEC_ISO_REQUESTED_DESIGNATION(coding, charset) \
- (coding)->spec.iso2022.requested_designation[charset]
-#define CODING_SPEC_ISO_REVISION_NUMBER(coding, charset) \
- (coding)->spec.iso2022.charset_revision_number[charset]
-#define CODING_SPEC_ISO_SINGLE_SHIFTING(coding) \
- (coding)->spec.iso2022.single_shifting
-#define CODING_SPEC_ISO_BOL(coding) \
- (coding)->spec.iso2022.bol
-
-/* A value which may appear in
- coding->spec.iso2022.requested_designation indicating that the
- corresponding charset does not request any graphic register to be
- designated. */
-#define CODING_SPEC_ISO_NO_REQUESTED_DESIGNATION 4
-
-/* Return a charset which is currently designated to the graphic plane
- PLANE in the coding-system CODING. */
-#define CODING_SPEC_ISO_PLANE_CHARSET(coding, plane) \
- ((CODING_SPEC_ISO_INVOCATION (coding, plane) < 0) \
- ? -1 \
- : CODING_SPEC_ISO_DESIGNATION (coding, \
- CODING_SPEC_ISO_INVOCATION (coding, plane)))
-
-/*** BIG5 section ***/
-
-/* Macros to denote each type of BIG5 coding system. */
-#define CODING_FLAG_BIG5_HKU 0x00 /* BIG5-HKU is one of variants of
- BIG5 developed by Hong Kong
- University. */
-#define CODING_FLAG_BIG5_ETEN 0x01 /* BIG5_ETen is one of variants
- of BIG5 developed by the
- company ETen in Taiwan. */
/*** GENERAL section ***/
-/* Types of coding system. */
-enum coding_type
+/* Enumeration of result code of code conversion. */
+enum coding_result_code
{
- coding_type_no_conversion, /* A coding system which requires no
- conversion for reading and writing
- including end-of-line format. */
- coding_type_emacs_mule, /* A coding system used in Emacs'
- buffer and string. Requires no
- conversion for reading and writing
- except for end-of-line format. */
- coding_type_undecided, /* A coding system which requires
- automatic detection of a real
- coding system. */
- coding_type_sjis, /* SJIS coding system for Japanese. */
- coding_type_iso2022, /* Any coding system of ISO2022
- variants. */
- coding_type_big5, /* BIG5 coding system for Chinese. */
- coding_type_ccl, /* The coding system of which decoder
- and encoder are written in CCL. */
- coding_type_raw_text /* A coding system for a text
- containing random 8-bit code which
- does not require code conversion
- except for end-of-line format. */
+ CODING_RESULT_SUCCESS,
+ CODING_RESULT_INSUFFICIENT_SRC,
+ CODING_RESULT_INSUFFICIENT_DST,
+ CODING_RESULT_INCONSISTENT_EOL,
+ CODING_RESULT_INVALID_SRC,
+ CODING_RESULT_INTERRUPT,
+ CODING_RESULT_INSUFFICIENT_MEM
};
-/* Formats of end-of-line. */
-#define CODING_EOL_LF 0 /* Line-feed only, same as Emacs'
- internal format. */
-#define CODING_EOL_CRLF 1 /* Sequence of carriage-return and
- line-feed. */
-#define CODING_EOL_CR 2 /* Carriage-return only. */
-#define CODING_EOL_UNDECIDED 3 /* This value is used to denote the
- eol-type is not yet decided. */
-#define CODING_EOL_INCONSISTENT 4 /* This value is used to denote the
- eol-type is not consistent
- through the file. */
-
-/* 1 if composing. */
-#define COMPOSING_P(coding) ((int) coding->composing > (int) COMPOSITION_NO)
-
-#define COMPOSITION_DATA_SIZE 4080
-#define COMPOSITION_DATA_MAX_BUNCH_LENGTH (4 + MAX_COMPOSITION_COMPONENTS*2)
-
-/* Data structure to hold information about compositions of text that
- is being decoded or encode. ISO 2022 base code conversion routines
- handle special ESC sequences for composition specification. But,
- they can't get/put such information directly from/to a buffer in
- the deepest place. So, they store or retrieve the information
- through this structure.
-
- The encoder stores the information in this structure when it meets
- ESC sequences for composition while encoding codes, then, after all
- text codes are encoded, puts `composition' properties on the text
- by referring to the structure.
-
- The decoder at first stores the information of a text to be
- decoded, then, while decoding codes, generates ESC sequences for
- composition at proper places by referring to the structure. */
-
-struct composition_data
-{
- /* The character position of the first character to be encoded or
- decoded. START and END (see below) are relative to this
- position. */
- int char_offset;
-
- /* The composition data. These elements are repeated for each
- composition:
- LENGTH START END METHOD [ COMPONENT ... ]
- where,
- LENGTH is the number of elements for this composition.
-
- START and END are starting and ending character positions of
- the composition relative to `char_offset'.
-
- METHOD is one of `enum composing_status' specifying the way of
- composition.
-
- COMPONENT is a character or an encoded composition rule. */
- int data[COMPOSITION_DATA_SIZE];
-
- /* The number of elements in `data' currently used. */
- int used;
-
- /* Pointers to the previous and next structures. When `data' is
- filled up, another structure is allocated and linked in `next'.
- The new structure has backward link to this structure in `prev'.
- The number of chained structures depends on how many compositions
- the text being encoded or decoded contains. */
- struct composition_data *prev, *next;
-};
-
-/* Macros used for the member `result' of the struct
- coding_system. */
-#define CODING_FINISH_NORMAL 0
-#define CODING_FINISH_INSUFFICIENT_SRC 1
-#define CODING_FINISH_INSUFFICIENT_DST 2
-#define CODING_FINISH_INCONSISTENT_EOL 3
-#define CODING_FINISH_INSUFFICIENT_CMP 4
-#define CODING_FINISH_INTERRUPT 5
/* Macros used for the member `mode' of the struct coding_system. */
#define CODING_MODE_INHIBIT_INCONSISTENT_EOL 0x01
/* If set, the decoding/encoding routines treat the current data as
- the last block of the whole text to be converted, and do
+ the last block of the whole text to be converted, and do the
appropriate finishing job. */
#define CODING_MODE_LAST_BLOCK 0x02
enables selective display. */
#define CODING_MODE_SELECTIVE_DISPLAY 0x04
-/* If set, replace unencodabae characters by `?' on encoding. */
-#define CODING_MODE_INHIBIT_UNENCODABLE_CHAR 0x08
-
/* This flag is used by the decoding/encoding routines on the fly. If
set, it means that right-to-left text is being processed. */
-#define CODING_MODE_DIRECTION 0x10
+#define CODING_MODE_DIRECTION 0x08
-struct coding_system
+#define CODING_MODE_FIXED_DESTINATION 0x10
+
+/* If set, it means that the encoding routines produces some safe
+ ASCII characters (usually '?') for unsupported characters. */
+#define CODING_MODE_SAFE_ENCODING 0x20
+
+/* Structure of the field `spec.iso_2022' in the structure
+ `coding_system'. */
+struct iso_2022_spec
{
- /* Type of the coding system. */
- enum coding_type type;
+ /* Bit-wise-or of CODING_ISO_FLAG_XXX. */
+ unsigned flags;
- /* Type of end-of-line format (LF, CRLF, or CR) of the coding system. */
- int eol_type;
+ /* The current graphic register invoked to each graphic plane. */
+ int current_invocation[2];
- /* Flag bits of the coding system. The meaning of each bit is common
- to all types of coding systems. */
- unsigned int common_flags;
+ /* The current charset designated to each graphic register. The
+ value -1 means that not charset is designated, -2 means that
+ there was an invalid designation previously. */
+ int current_designation[4];
- /* Flag bits of the coding system. The meaning of each bit depends
- on the type of the coding system. */
- unsigned int flags;
+ /* Set to 1 temporarily only when graphic register 2 or 3 is invoked
+ by single-shift while encoding. */
+ int single_shifting;
- /* Mode bits of the coding system. See the comments of the macros
- CODING_MODE_XXX. */
- unsigned int mode;
+ /* Set to 1 temporarily only when processing at beginning of line. */
+ int bol;
+};
+
+struct ccl_spec;
+
+enum utf_16_bom_type
+ {
+ utf_16_detect_bom,
+ utf_16_without_bom,
+ utf_16_with_bom
+ };
+
+enum utf_16_endian_type
+ {
+ utf_16_big_endian,
+ utf_16_little_endian
+ };
+
+struct utf_16_spec
+{
+ enum utf_16_bom_type bom;
+ enum utf_16_endian_type endian;
+ int surrogate;
+};
- /* The current status of composition handling. */
- int composing;
+struct coding_detection_info
+{
+ /* Values of these members are bitwise-OR of CATEGORY_MASK_XXXs. */
+ /* Which categories are already checked. */
+ int checked;
+ /* Which categories are strongly found. */
+ int found;
+ /* Which categories are rejected. */
+ int rejected;
+};
- /* 1 if the next character is a composition rule. */
- int composition_rule_follows;
- /* Information of compositions are stored here on decoding and set
- in advance on encoding. */
- struct composition_data *cmp_data;
+struct coding_system
+{
+ /* ID number of the coding system. This is an index to
+ Vcoding_system_hash_table. This value is set by
+ setup_coding_system. At the early stage of building time, this
+ value is -1 in the array coding_categories to indicate that no
+ coding-system of that category is yet defined. */
+ int id;
- /* Index to cmp_data->data for the first element for the current
- composition. */
- int cmp_data_start;
+ /* Flag bits of the coding system. The meaning of each bit is common
+ to all types of coding systems. */
+ int common_flags;
- /* Index to cmp_data->data for the current element for the current
- composition. */
- int cmp_data_index;
+ /* Mode bits of the coding system. See the comments of the macros
+ CODING_MODE_XXX. */
+ unsigned int mode;
/* Detailed information specific to each type of coding system. */
- union spec
+ union
{
- struct iso2022_spec iso2022;
- struct ccl_spec ccl; /* Defined in ccl.h. */
+ struct iso_2022_spec iso_2022;
+ struct ccl_spec *ccl; /* Defined in ccl.h. */
+ struct utf_16_spec utf_16;
+ int emacs_mule_full_support;
} spec;
- /* Index number of coding category of the coding system. */
- int category_idx;
+ int max_charset_id;
+ char *safe_charsets;
- /* The following two members specify how characters 128..159 are
- represented in source and destination text respectively. 1 means
- they are represented by 2-byte sequence, 0 means they are
- represented by 1-byte as is (see the comment in charset.h). */
+ /* The following two members specify how binary 8-bit code 128..255
+ are represented in source and destination text respectively. 1
+ means they are represented by 2-byte sequence, 0 means they are
+ represented by 1-byte as is (see the comment in character.h). */
unsigned src_multibyte : 1;
unsigned dst_multibyte : 1;
-1 in setup_coding_system, and updated by detect_coding. So,
when this is equal to the byte length of the text being
converted, we can skip the actual conversion process. */
- int heading_ascii;
+ int head_ascii;
/* The following members are set by encoding/decoding routine. */
- int produced, produced_char, consumed, consumed_char;
+ EMACS_INT produced, produced_char, consumed, consumed_char;
/* Number of error source data found in a decoding routine. */
int errors;
- /* Finish status of code conversion. It should be one of macros
- CODING_FINISH_XXXX. */
- int result;
+ /* Store the positions of error source data. */
+ EMACS_INT *error_positions;
- /* If nonzero, suppress error notification. */
- int suppress_error;
+ /* Finish status of code conversion. */
+ enum coding_result_code result;
- /* The following members are all Lisp symbols. We don't have to
- protect them from GC because the current garbage collection
- doesn't relocate Lisp symbols. But, when it is changed, we must
- find a way to protect them. */
+ EMACS_INT src_pos, src_pos_byte, src_chars, src_bytes;
+ Lisp_Object src_object;
+ const unsigned char *source;
- /* Backward pointer to the Lisp symbol of the coding system. */
- Lisp_Object symbol;
+ EMACS_INT dst_pos, dst_pos_byte, dst_bytes;
+ Lisp_Object dst_object;
+ unsigned char *destination;
- /* Lisp function (symbol) to be called after decoding to do
- additional conversion, or nil. */
- Lisp_Object post_read_conversion;
+ /* Set to 1 if the source of conversion is not in the member
+ `charbuf', but at `src_object'. */
+ int chars_at_source;
- /* Lisp function (symbol) to be called before encoding to do
- additional conversion, or nil. */
- Lisp_Object pre_write_conversion;
+ /* If an element is non-negative, it is a character code.
- /* Character translation tables to look up, or nil. */
- Lisp_Object translation_table_for_decode;
- Lisp_Object translation_table_for_encode;
-};
+ If it is in the range -128..-1, it is a 8-bit character code
+ minus 256.
+
+ If it is less than -128, it specifies the start of an annotation
+ chunk. The length of the chunk is -128 minus the value of the
+ element. The following elements are OFFSET, ANNOTATION-TYPE, and
+ a sequence of actual data for the annotation. OFFSET is a
+ character position offset from dst_pos or src_pos,
+ ANNOTATION-TYPE specfies the meaning of the annotation and how to
+ handle the following data.. */
+ int *charbuf;
+ int charbuf_size, charbuf_used;
+
+ /* Set to 1 if charbuf contains an annotation. */
+ int annotated;
+
+ unsigned char carryover[64];
+ int carryover_bytes;
+
+ int default_char;
-/* Mask bits for (struct coding_system *)->common_flags. */
-#define CODING_REQUIRE_FLUSHING_MASK 0x01
-#define CODING_REQUIRE_DECODING_MASK 0x02
-#define CODING_REQUIRE_ENCODING_MASK 0x04
-#define CODING_REQUIRE_DETECTION_MASK 0x08
-#define CODING_ASCII_INCOMPATIBLE_MASK 0x10
+ int (*detector) P_ ((struct coding_system *,
+ struct coding_detection_info *));
+ void (*decoder) P_ ((struct coding_system *));
+ int (*encoder) P_ ((struct coding_system *));
+};
-/* Return 1 if the coding system CODING requires specific code to be
+/* Meanings of bits in the member `common_flags' of the structure
+ coding_system. The lowest 8 bits are reserved for various kind of
+ annotations (currently two of them are used). */
+#define CODING_ANNOTATION_MASK 0x00FF
+#define CODING_ANNOTATE_COMPOSITION_MASK 0x0001
+#define CODING_ANNOTATE_DIRECTION_MASK 0x0002
+#define CODING_ANNOTATE_CHARSET_MASK 0x0003
+#define CODING_FOR_UNIBYTE_MASK 0x0100
+#define CODING_REQUIRE_FLUSHING_MASK 0x0200
+#define CODING_REQUIRE_DECODING_MASK 0x0400
+#define CODING_REQUIRE_ENCODING_MASK 0x0800
+#define CODING_REQUIRE_DETECTION_MASK 0x1000
+#define CODING_RESET_AT_BOL_MASK 0x2000
+
+/* Return 1 if the coding context CODING requires annotaion
+ handling. */
+#define CODING_REQUIRE_ANNOTATION(coding) \
+ ((coding)->common_flags & CODING_ANNOTATION_MASK)
+
+/* Return 1 if the coding context CODING prefers decoding into unibyte. */
+#define CODING_FOR_UNIBYTE(coding) \
+ ((coding)->common_flags & CODING_FOR_UNIBYTE_MASK)
+
+/* Return 1 if the coding context CODING requires specific code to be
attached at the tail of converted text. */
#define CODING_REQUIRE_FLUSHING(coding) \
((coding)->common_flags & CODING_REQUIRE_FLUSHING_MASK)
-/* Return 1 if the coding system CODING requires code conversion on
+/* Return 1 if the coding context CODING requires code conversion on
decoding. */
#define CODING_REQUIRE_DECODING(coding) \
((coding)->dst_multibyte \
|| (coding)->common_flags & CODING_REQUIRE_DECODING_MASK)
-/* Return 1 if the coding system CODING requires code conversion on
+
+/* Return 1 if the coding context CODING requires code conversion on
encoding.
The non-multibyte part of the condition is to support encoding of
unibyte strings/buffers generated by string-as-unibyte or
(set-buffer-multibyte nil) from multibyte strings/buffers. */
-#define CODING_REQUIRE_ENCODING(coding) \
- ((coding)->src_multibyte \
- || (coding)->common_flags & CODING_REQUIRE_ENCODING_MASK)
+#define CODING_REQUIRE_ENCODING(coding) \
+ ((coding)->src_multibyte \
+ || (coding)->common_flags & CODING_REQUIRE_ENCODING_MASK \
+ || (coding)->mode & CODING_MODE_SELECTIVE_DISPLAY)
-/* Return 1 if the coding system CODING requires some kind of code
+
+/* Return 1 if the coding context CODING requires some kind of code
detection. */
#define CODING_REQUIRE_DETECTION(coding) \
((coding)->common_flags & CODING_REQUIRE_DETECTION_MASK)
-/* Return 1 if the coding system CODING requires code conversion on
+/* Return 1 if the coding context CODING requires code conversion on
decoding or some kind of code detection. */
#define CODING_MAY_REQUIRE_DECODING(coding) \
(CODING_REQUIRE_DECODING (coding) \
|| CODING_REQUIRE_DETECTION (coding))
-/* Index for each coding category in `coding_category_table' */
-#define CODING_CATEGORY_IDX_EMACS_MULE 0
-#define CODING_CATEGORY_IDX_SJIS 1
-#define CODING_CATEGORY_IDX_ISO_7 2
-#define CODING_CATEGORY_IDX_ISO_7_TIGHT 3
-#define CODING_CATEGORY_IDX_ISO_8_1 4
-#define CODING_CATEGORY_IDX_ISO_8_2 5
-#define CODING_CATEGORY_IDX_ISO_7_ELSE 6
-#define CODING_CATEGORY_IDX_ISO_8_ELSE 7
-#define CODING_CATEGORY_IDX_CCL 8
-#define CODING_CATEGORY_IDX_BIG5 9
-#define CODING_CATEGORY_IDX_UTF_8 10
-#define CODING_CATEGORY_IDX_UTF_16_BE 11
-#define CODING_CATEGORY_IDX_UTF_16_LE 12
-#define CODING_CATEGORY_IDX_RAW_TEXT 13
-#define CODING_CATEGORY_IDX_BINARY 14
-#define CODING_CATEGORY_IDX_MAX 15
-
-/* Definitions of flag bits returned by the function
- detect_coding_mask (). */
-#define CODING_CATEGORY_MASK_EMACS_MULE (1 << CODING_CATEGORY_IDX_EMACS_MULE)
-#define CODING_CATEGORY_MASK_SJIS (1 << CODING_CATEGORY_IDX_SJIS)
-#define CODING_CATEGORY_MASK_ISO_7 (1 << CODING_CATEGORY_IDX_ISO_7)
-#define CODING_CATEGORY_MASK_ISO_7_TIGHT (1 << CODING_CATEGORY_IDX_ISO_7_TIGHT)
-#define CODING_CATEGORY_MASK_ISO_8_1 (1 << CODING_CATEGORY_IDX_ISO_8_1)
-#define CODING_CATEGORY_MASK_ISO_8_2 (1 << CODING_CATEGORY_IDX_ISO_8_2)
-#define CODING_CATEGORY_MASK_ISO_7_ELSE (1 << CODING_CATEGORY_IDX_ISO_7_ELSE)
-#define CODING_CATEGORY_MASK_ISO_8_ELSE (1 << CODING_CATEGORY_IDX_ISO_8_ELSE)
-#define CODING_CATEGORY_MASK_CCL (1 << CODING_CATEGORY_IDX_CCL)
-#define CODING_CATEGORY_MASK_BIG5 (1 << CODING_CATEGORY_IDX_BIG5)
-#define CODING_CATEGORY_MASK_UTF_8 (1 << CODING_CATEGORY_IDX_UTF_8)
-#define CODING_CATEGORY_MASK_UTF_16_BE (1 << CODING_CATEGORY_IDX_UTF_16_BE)
-#define CODING_CATEGORY_MASK_UTF_16_LE (1 << CODING_CATEGORY_IDX_UTF_16_LE)
-#define CODING_CATEGORY_MASK_RAW_TEXT (1 << CODING_CATEGORY_IDX_RAW_TEXT)
-#define CODING_CATEGORY_MASK_BINARY (1 << CODING_CATEGORY_IDX_BINARY)
-
-/* This value is returned if detect_coding_mask () find nothing other
- than ASCII characters. */
-#define CODING_CATEGORY_MASK_ANY \
- ( CODING_CATEGORY_MASK_EMACS_MULE \
- | CODING_CATEGORY_MASK_SJIS \
- | CODING_CATEGORY_MASK_ISO_7 \
- | CODING_CATEGORY_MASK_ISO_7_TIGHT \
- | CODING_CATEGORY_MASK_ISO_8_1 \
- | CODING_CATEGORY_MASK_ISO_8_2 \
- | CODING_CATEGORY_MASK_ISO_7_ELSE \
- | CODING_CATEGORY_MASK_ISO_8_ELSE \
- | CODING_CATEGORY_MASK_CCL \
- | CODING_CATEGORY_MASK_BIG5 \
- | CODING_CATEGORY_MASK_UTF_8 \
- | CODING_CATEGORY_MASK_UTF_16_BE \
- | CODING_CATEGORY_MASK_UTF_16_LE)
-
-#define CODING_CATEGORY_MASK_ISO_7BIT \
- (CODING_CATEGORY_MASK_ISO_7 | CODING_CATEGORY_MASK_ISO_7_TIGHT)
-
-#define CODING_CATEGORY_MASK_ISO_8BIT \
- (CODING_CATEGORY_MASK_ISO_8_1 | CODING_CATEGORY_MASK_ISO_8_2)
-
-#define CODING_CATEGORY_MASK_ISO_SHIFT \
- (CODING_CATEGORY_MASK_ISO_7_ELSE | CODING_CATEGORY_MASK_ISO_8_ELSE)
-
-#define CODING_CATEGORY_MASK_ISO \
- ( CODING_CATEGORY_MASK_ISO_7BIT \
- | CODING_CATEGORY_MASK_ISO_SHIFT \
- | CODING_CATEGORY_MASK_ISO_8BIT)
-
-#define CODING_CATEGORY_MASK_UTF_16_BE_LE \
- (CODING_CATEGORY_MASK_UTF_16_BE | CODING_CATEGORY_MASK_UTF_16_LE)
-
/* Macros to decode or encode a character of JISX0208 in SJIS. S1 and
S2 are the 1st and 2nd position-codes of JISX0208 in SJIS coding
system. C1 and C2 are the 1st and 2nd position codes of Emacs'
internal format. */
-#define DECODE_SJIS(s1, s2, c1, c2) \
- do { \
- if (s2 >= 0x9F) \
- c1 = s1 * 2 - (s1 >= 0xE0 ? 0x160 : 0xE0), \
- c2 = s2 - 0x7E; \
- else \
- c1 = s1 * 2 - ((s1 >= 0xE0) ? 0x161 : 0xE1), \
- c2 = s2 - ((s2 >= 0x7F) ? 0x20 : 0x1F); \
+#define SJIS_TO_JIS(code) \
+ do { \
+ int s1, s2, j1, j2; \
+ \
+ s1 = (code) >> 8, s2 = (code) & 0xFF; \
+ \
+ if (s2 >= 0x9F) \
+ (j1 = s1 * 2 - (s1 >= 0xE0 ? 0x160 : 0xE0), \
+ j2 = s2 - 0x7E); \
+ else \
+ (j1 = s1 * 2 - ((s1 >= 0xE0) ? 0x161 : 0xE1), \
+ j2 = s2 - ((s2 >= 0x7F) ? 0x20 : 0x1F)); \
+ (code) = (j1 << 8) | j2; \
+ } while (0)
+
+#define SJIS_TO_JIS2(code) \
+ do { \
+ int s1, s2, j1, j2; \
+ \
+ s1 = (code) >> 8, s2 = (code) & 0xFF; \
+ \
+ if (s2 >= 0x9F) \
+ { \
+ j1 = (s1 == 0xF0 ? 0x28 \
+ : s1 == 0xF1 ? 0x24 \
+ : s1 == 0xF2 ? 0x2C \
+ : s1 == 0xF3 ? 0x2E \
+ : 0x6E + (s1 - 0xF4) * 2); \
+ j2 = s2 - 0x7E; \
+ } \
+ else \
+ { \
+ j1 = (s1 <= 0xF2 ? 0x21 + (s1 - 0xF0) * 2 \
+ : s1 <= 0xF4 ? 0x2D + (s1 - 0xF3) * 2 \
+ : 0x6F + (s1 - 0xF5) * 2); \
+ j2 = s2 - ((s2 >= 0x7F ? 0x20 : 0x1F)); \
+ } \
+ (code) = (j1 << 8) | j2; \
+ } while (0)
+
+
+#define JIS_TO_SJIS(code) \
+ do { \
+ int s1, s2, j1, j2; \
+ \
+ j1 = (code) >> 8, j2 = (code) & 0xFF; \
+ if (j1 & 1) \
+ (s1 = j1 / 2 + ((j1 < 0x5F) ? 0x71 : 0xB1), \
+ s2 = j2 + ((j2 >= 0x60) ? 0x20 : 0x1F)); \
+ else \
+ (s1 = j1 / 2 + ((j1 < 0x5F) ? 0x70 : 0xB0), \
+ s2 = j2 + 0x7E); \
+ (code) = (s1 << 8) | s2; \
} while (0)
-#define ENCODE_SJIS(c1, c2, s1, s2) \
+#define JIS_TO_SJIS2(code) \
do { \
- if (c1 & 1) \
- s1 = c1 / 2 + ((c1 < 0x5F) ? 0x71 : 0xB1), \
- s2 = c2 + ((c2 >= 0x60) ? 0x20 : 0x1F); \
+ int s1, s2, j1, j2; \
+ \
+ j1 = (code) >> 8, j2 = (code) & 0xFF; \
+ if (j1 & 1) \
+ { \
+ s1 = (j1 <= 0x25 ? 0xF0 + (j1 - 0x21) / 2 \
+ : j1 <= 0x27 ? 0xF3 + (j1 - 0x2D) / 2 \
+ : 0xF5 + (j1 - 0x6F) / 2); \
+ s2 = j2 + ((j2 >= 0x60) ? 0x20 : 0x1F); \
+ } \
else \
- s1 = c1 / 2 + ((c1 < 0x5F) ? 0x70 : 0xB0), \
- s2 = c2 + 0x7E; \
+ { \
+ s1 = (j1 == 0x28 ? 0xF0 \
+ : j1 == 0x24 ? 0xF1 \
+ : j1 == 0x2C ? 0xF2 \
+ : j1 == 0x2E ? 0xF3 \
+ : 0xF4 + (j1 - 0x6E) / 2); \
+ s2 = j2 + 0x7E; \
+ } \
+ (code) = (s1 << 8) | s2; \
} while (0)
/* Encode the file name NAME using the specified coding system
? code_convert_string_norecord (name, Vdefault_file_name_coding_system, 1) \
: name))
+
/* Decode the file name NAME using the specified coding system
for file names, if any. */
#define DECODE_FILE(name) \
? code_convert_string_norecord (name, Vdefault_file_name_coding_system, 0) \
: name))
+
/* Encode the string STR using the specified coding system
for system functions, if any. */
#define ENCODE_SYSTEM(str) \
? code_convert_string_norecord (str, Vlocale_coding_system, 0) \
: str)
+/* Used by the gtk menu code. Note that this encodes utf-8, not
+ utf-8-emacs, so it's not a no-op. */
#define ENCODE_UTF_8(str) code_convert_string_norecord (str, Qutf_8, 1)
/* Extern declarations. */
-extern int decode_coding P_ ((struct coding_system *, const unsigned char *,
- unsigned char *, int, int));
-extern int encode_coding P_ ((struct coding_system *, const unsigned char *,
- unsigned char *, int, int));
-extern void coding_save_composition P_ ((struct coding_system *, int, int,
- Lisp_Object));
-extern void coding_free_composition_data P_ ((struct coding_system *));
-extern void coding_adjust_composition_offset P_ ((struct coding_system *,
- int));
-extern void coding_allocate_composition_data P_ ((struct coding_system *,
- int));
-extern void coding_restore_composition P_ ((struct coding_system *,
- Lisp_Object));
-extern int code_convert_region P_ ((int, int, int, int, struct coding_system *,
- int, int));
-extern Lisp_Object run_pre_post_conversion_on_str P_ ((Lisp_Object,
- struct coding_system *,
- int));
-extern void run_pre_write_conversin_on_c_str P_ ((unsigned char **, int *,
- int, int,
- struct coding_system *));
-
+extern Lisp_Object code_conversion_save P_ ((int, int));
extern int decoding_buffer_size P_ ((struct coding_system *, int));
extern int encoding_buffer_size P_ ((struct coding_system *, int));
-extern void detect_coding P_ ((struct coding_system *, const unsigned char *,
- int));
-extern void detect_eol P_ ((struct coding_system *, const unsigned char *,
- int));
-extern int setup_coding_system P_ ((Lisp_Object, struct coding_system *));
-extern Lisp_Object code_convert_string P_ ((Lisp_Object,
- struct coding_system *, int, int));
-extern Lisp_Object code_convert_string1 P_ ((Lisp_Object, Lisp_Object,
- Lisp_Object, int));
+extern void setup_coding_system P_ ((Lisp_Object, struct coding_system *));
+extern Lisp_Object coding_charset_list P_ ((struct coding_system *));
+extern void detect_coding P_ ((struct coding_system *));
+extern Lisp_Object code_convert_region P_ ((Lisp_Object, Lisp_Object,
+ Lisp_Object, Lisp_Object,
+ int, int));
+extern Lisp_Object code_convert_string P_ ((Lisp_Object, Lisp_Object,
+ Lisp_Object, int, int, int));
extern Lisp_Object code_convert_string_norecord P_ ((Lisp_Object, Lisp_Object,
int));
-extern void setup_raw_text_coding_system P_ ((struct coding_system *));
-extern Lisp_Object encode_coding_string P_ ((Lisp_Object,
- struct coding_system *, int));
-extern Lisp_Object decode_coding_string P_ ((Lisp_Object,
- struct coding_system *, int));
+extern Lisp_Object raw_text_coding_system P_ ((Lisp_Object));
+extern Lisp_Object coding_inherit_eol_type P_ ((Lisp_Object, Lisp_Object));
+
+extern int decode_coding_gap P_ ((struct coding_system *,
+ EMACS_INT, EMACS_INT));
+extern int encode_coding_gap P_ ((struct coding_system *,
+ EMACS_INT, EMACS_INT));
+extern void decode_coding_object P_ ((struct coding_system *,
+ Lisp_Object, EMACS_INT, EMACS_INT,
+ EMACS_INT, EMACS_INT, Lisp_Object));
+extern void encode_coding_object P_ ((struct coding_system *,
+ Lisp_Object, EMACS_INT, EMACS_INT,
+ EMACS_INT, EMACS_INT, Lisp_Object));
+
+/* Macros for backward compatibility. */
+
+#define decode_coding_region(coding, from, to) \
+ decode_coding_object (coding, Fcurrent_buffer (), \
+ from, CHAR_TO_BYTE (from), \
+ to, CHAR_TO_BYTE (to), Fcurrent_buffer ())
+
+
+#define encode_coding_region(coding, from, to) \
+ encode_coding_object (coding, Fcurrent_buffer (), \
+ from, CHAR_TO_BYTE (from), \
+ to, CHAR_TO_BYTE (to), Fcurrent_buffer ())
+
+
+#define decode_coding_string(coding, string, nocopy) \
+ decode_coding_object (coding, string, 0, 0, XSTRING (string)->size, \
+ STRING_BYTES (XSTRING (string)), Qt)
+
+#define encode_coding_string(coding, string, nocopy) \
+ (encode_coding_object (coding, string, 0, 0, XSTRING (string)->size, \
+ STRING_BYTES (XSTRING (string)), Qt), \
+ (coding)->dst_object)
+
+
+#define decode_coding_c_string(coding, src, bytes, dst_object) \
+ do { \
+ (coding)->source = (src); \
+ (coding)->src_chars = (coding)->src_bytes = (bytes); \
+ decode_coding_object ((coding), Qnil, 0, 0, (bytes), (bytes), \
+ (dst_object)); \
+ } while (0)
+
+
+extern Lisp_Object preferred_coding_system P_ (());
+
+
+extern Lisp_Object Qutf_8, Qutf_8_emacs;
+
extern Lisp_Object Qcoding_system, Qeol_type, Qcoding_category_index;
-extern Lisp_Object Qraw_text, Qemacs_mule;
+extern Lisp_Object Qcoding_system_p;
+extern Lisp_Object Qraw_text, Qemacs_mule, Qno_conversion, Qundecided;
+extern Lisp_Object Qiso_2022;
extern Lisp_Object Qbuffer_file_coding_system;
-extern Lisp_Object Vcoding_category_list;
-extern Lisp_Object Qutf_8;
+
+extern Lisp_Object Qunix, Qdos, Qmac;
extern Lisp_Object Qtranslation_table;
extern Lisp_Object Qtranslation_table_id;
/* Mnemonic string to indicate type of end-of-line is not yet decided. */
extern Lisp_Object eol_mnemonic_undecided;
-/* Format of end-of-line decided by system. */
-extern int system_eol_type;
-
#ifdef emacs
extern Lisp_Object Qfile_coding_system;
extern Lisp_Object Qcall_process, Qcall_process_region;
terminal coding system is nil. */
extern struct coding_system safe_terminal_coding;
-/* Default coding system to be used to write a file. */
-extern struct coding_system default_buffer_file_coding;
-
/* Default coding systems used for process I/O. */
extern Lisp_Object Vdefault_process_coding_system;
-/* Function to call to force a user to force select a proper coding
+/* Function to call to force a user to force select a propert coding
system. */
extern Lisp_Object Vselect_safe_coding_system_function;
/* Error signaled when there's a problem with detecting coding system */
extern Lisp_Object Qcoding_system_error;
+extern char emacs_mule_bytes[256];
+extern int emacs_mule_string_char P_ ((unsigned char *));
+
#endif /* EMACS_CODING_H */
/* arch-tag: 2bc3b4fa-6870-4f64-8135-b962b2d290e4
/* Composite sequence support.
Copyright (C) 2001, 2002, 2003, 2004, 2005,
- 2006, 2007 Free Software Foundation, Inc.
- Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ 2006, 2007, 2008 Free Software Foundation, Inc.
+ Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
National Institute of Advanced Industrial Science and Technology (AIST)
Registration Number H14PRO021
+ Copyright (C) 2003, 2006
+ National Institute of Advanced Industrial Science and Technology (AIST)
+ Registration Number H13PRO009
This file is part of GNU Emacs.
#include <config.h>
#include "lisp.h"
#include "buffer.h"
-#include "charset.h"
+#include "character.h"
#include "intervals.h"
/* Emacs uses special text property `composition' to support character
/* Function to call to adjust composition. */
Lisp_Object Vcompose_chars_after_function;
-/* Char-table of patterns and functions to make a composition. */
-Lisp_Object Vcomposition_function_table;
-Lisp_Object Qcomposition_function_table;
+Lisp_Object Qauto_composed;
+Lisp_Object Vauto_composition_function;
+Lisp_Object Qauto_composition_function;
+
+EXFUN (Fremove_list_of_text_properties, 4);
/* Temporary variable used in macros COMPOSITION_XXX. */
Lisp_Object composition_temp;
-\f
-/* Return how many columns C will occupy on the screen. It always
- returns 1 for control characters and 8-bit characters because those
- are just ignored in a composition. */
-#define CHAR_WIDTH(c) \
- (SINGLE_BYTE_CHAR_P (c) ? 1 : CHARSET_WIDTH (CHAR_CHARSET (c)))
+extern int enable_font_backend;
+\f
/* Return COMPOSITION-ID of a composition at buffer position
CHARPOS/BYTEPOS and length NCHARS. The `composition' property of
the sequence is PROP. STRING, if non-nil, is a string that
/* Check if the contents of COMPONENTS are valid if COMPONENTS is a
vector or a list. It should be a sequence of:
char1 rule1 char2 rule2 char3 ... ruleN charN+1 */
+
+#ifdef USE_FONT_BACKEND
+ if (enable_font_backend
+ && VECTORP (components)
+ && ASIZE (components) >= 2
+ && VECTORP (AREF (components, 0)))
+ {
+ /* COMPONENTS is a glyph-string. */
+ int len = ASIZE (key);
+
+ for (i = 1; i < len; i++)
+ if (! VECTORP (AREF (key, i)))
+ goto invalid_composition;
+ }
+ else
+#endif /* USE_FONT_BACKEND */
if (VECTORP (components) || CONSP (components))
{
int len = XVECTOR (key)->size;
: ((INTEGERP (components) || STRINGP (components))
? COMPOSITION_WITH_ALTCHARS
: COMPOSITION_WITH_RULE_ALTCHARS));
+#ifdef USE_FONT_BACKEND
+ if (cmp->method == COMPOSITION_WITH_RULE_ALTCHARS
+ && VECTORP (components)
+ && ! INTEGERP (AREF (components, 0)))
+ cmp->method = COMPOSITION_WITH_GLYPH_STRING;
+#endif /* USE_FONT_BACKEND */
cmp->hash_index = hash_index;
glyph_len = (cmp->method == COMPOSITION_WITH_RULE_ALTCHARS
? (XVECTOR (key)->size + 1) / 2
cmp->offsets = (short *) xmalloc (sizeof (short) * glyph_len * 2);
cmp->font = NULL;
+#ifdef USE_FONT_BACKEND
+ if (cmp->method == COMPOSITION_WITH_GLYPH_STRING)
+ {
+ cmp->width = 1; /* Should be fixed later. */
+ cmp->glyph_len--;
+ }
+ else
+#endif /* USE_FONT_BACKEND */
/* Calculate the width of overall glyphs of the composition. */
if (cmp->method != COMPOSITION_WITH_RULE_ALTCHARS)
{
float leftmost = 0.0, rightmost;
ch = XINT (key_contents[0]);
- rightmost = CHAR_WIDTH (ch);
+ rightmost = ch != '\t' ? CHAR_WIDTH (ch) : 1;
for (i = 1; i < glyph_len; i += 2)
{
- int rule, gref, nref;
+ int rule, gref, nref, xoff, yoff;
int this_width;
float this_left;
rule = XINT (key_contents[i]);
ch = XINT (key_contents[i + 1]);
- this_width = CHAR_WIDTH (ch);
+ this_width = ch != '\t' ? CHAR_WIDTH (ch) : 1;
/* A composition rule is specified by an integer value
that encodes global and new reference points (GREF and
| |
6---7---8 -- descent
*/
- COMPOSITION_DECODE_RULE (rule, gref, nref);
+ COMPOSITION_DECODE_RULE (rule, gref, nref, xoff, yoff);
this_left = (leftmost
+ (gref % 3) * (rightmost - leftmost) / 2.0
- (nref % 3) * this_width / 2.0);
int
find_composition (pos, limit, start, end, prop, object)
- int pos, limit, *start, *end;
+ int pos, limit;
+ EMACS_INT *start, *end;
Lisp_Object *prop, object;
{
Lisp_Object val;
Lisp_Object prop;
{
Lisp_Object func;
- int start, end;
+ EMACS_INT start, end;
func = COMPOSITION_MODIFICATION_FUNC (prop);
/* If an invalid composition precedes or follows, try to make them
to = end;
if (!NILP (Ffboundp (func)))
call2 (func, make_number (from), make_number (to));
- else if (!NILP (Ffboundp (Vcompose_chars_after_function)))
- call3 (Vcompose_chars_after_function,
- make_number (from), make_number (to), Qnil);
}
/* Make invalid compositions adjacent to or inside FROM and TO valid.
CHECK_MASK is bitwise `or' of mask bits defined by macros
CHECK_XXX (see the comment in composite.h).
+ It also resets the text-property `auto-composed' to a proper region
+ so that automatic character composition works correctly later while
+ displaying the region.
+
This function is called when a buffer text is changed. If the
change is deletion, FROM == TO. Otherwise, FROM < TO. */
void
update_compositions (from, to, check_mask)
- int from, to, check_mask;
+ EMACS_INT from, to;
+ int check_mask;
{
Lisp_Object prop;
- int start, end;
+ EMACS_INT start, end;
+ /* The beginning and end of the region to set the property
+ `auto-composed' to nil. */
+ EMACS_INT min_pos = from, max_pos = to;
if (inhibit_modification_hooks)
return;
&& find_composition (from - 1, -1, &start, &end, &prop, Qnil)
&& COMPOSITION_VALID_P (start, end, prop))
{
+ min_pos = start;
+ if (end > to)
+ max_pos = end;
if (from < end)
Fput_text_property (make_number (from), make_number (end),
Qcomposition,
else if (from < ZV
&& find_composition (from, -1, &start, &from, &prop, Qnil)
&& COMPOSITION_VALID_P (start, from, prop))
- run_composition_function (start, from, prop);
+ {
+ if (from > to)
+ max_pos = from;
+ run_composition_function (start, from, prop);
+ }
}
if (check_mask & CHECK_INSIDE)
To avoid it, in such a case, we change the property of
the former to the copy of it. */
if (to < end)
- Fput_text_property (make_number (start), make_number (to),
- Qcomposition,
- Fcons (XCAR (prop), XCDR (prop)), Qnil);
+ {
+ Fput_text_property (make_number (start), make_number (to),
+ Qcomposition,
+ Fcons (XCAR (prop), XCDR (prop)), Qnil);
+ max_pos = end;
+ }
run_composition_function (start, end, prop);
}
else if (to < ZV
&& find_composition (to, -1, &start, &end, &prop, Qnil)
&& COMPOSITION_VALID_P (start, end, prop))
- run_composition_function (start, end, prop);
+ {
+ run_composition_function (start, end, prop);
+ max_pos = end;
+ }
+ }
+ if (min_pos < max_pos)
+ {
+ int count = SPECPDL_INDEX ();
+
+ specbind (Qinhibit_read_only, Qt);
+ specbind (Qinhibit_modification_hooks, Qt);
+ specbind (Qinhibit_point_motion_hooks, Qt);
+ Fremove_list_of_text_properties (make_number (min_pos),
+ make_number (max_pos),
+ Fcons (Qauto_composed, Qnil), Qnil);
+ unbind_to (count, Qnil);
}
}
{
Lisp_Object prop;
+#if 0
+ if (VECTORP (components) && ASIZE (components) > 1
+ && VECTORP (AREF (components, 0)))
+ prop = components;
+ else
+#endif /* USE_FONT_BACKEND */
prop = Fcons (Fcons (make_number (end - start), components),
modification_func);
Fput_text_property (make_number (start), make_number (end),
Qcomposition, prop, string);
}
-
\f
/* Emacs Lisp APIs. */
Lisp_Object pos, limit, string, detail_p;
{
Lisp_Object prop, tail;
- int start, end;
+ EMACS_INT start, end;
int id;
CHECK_NUMBER_COERCE_MARKER (pos);
args[0] = QCtest;
args[1] = Qequal;
+ args[2] = QCweakness;
/* We used to make the hash table weak so that unreferenced
compostions can be garbage-collected. But, usually once
created compositions are repeatedly used in an Emacs session,
and thus it's not worth to save memory in such a way. So, we
make the table not weak. */
- args[2] = QCweakness;
args[3] = Qnil;
args[4] = QCsize;
args[5] = make_number (311);
The default value is the function `compose-chars-after'. */);
Vcompose_chars_after_function = intern ("compose-chars-after");
- Qcomposition_function_table = intern ("composition-function-table");
- staticpro (&Qcomposition_function_table);
-
- /* Intern this now in case it isn't already done.
- Setting this variable twice is harmless.
- But don't staticpro it here--that is done in alloc.c. */
- Qchar_table_extra_slots = intern ("char-table-extra-slots");
+ Qauto_composed = intern ("auto-composed");
+ staticpro (&Qauto_composed);
- Fput (Qcomposition_function_table, Qchar_table_extra_slots, make_number (0));
+ Qauto_composition_function = intern ("auto-composition-function");
+ staticpro (&Qauto_composition_function);
- DEFVAR_LISP ("composition-function-table", &Vcomposition_function_table,
- doc: /* Char table of patterns and functions to make a composition.
+ DEFVAR_LISP ("auto-composition-function", &Vauto_composition_function,
+ doc: /* Function to call to compose characters automatically.
+The function is called from the display routine with four arguments,
+FROM, TO, WINDOW, and STRING.
-Each element is nil or an alist of PATTERNs vs FUNCs, where PATTERNs
-are regular expressions and FUNCs are functions. FUNC is responsible
-for composing text matching the corresponding PATTERN. FUNC is called
-with three arguments FROM, TO, and PATTERN. See the function
-`compose-chars-after' for more detail.
+If STRING is nil, the function must compose characters in the region
+between FROM and TO in the current buffer.
-This table is looked up by the first character of a composition when
-the composition gets invalid after a change in a buffer. */);
- Vcomposition_function_table
- = Fmake_char_table (Qcomposition_function_table, Qnil);
+Otherwise, STRING is a string, and FROM and TO are indices into the
+string. In this case, the function must compose characters in the
+string. */);
+ Vauto_composition_function = Qnil;
defsubr (&Scompose_region_internal);
defsubr (&Scompose_string_internal);
/* Header for composite sequence handler.
Copyright (C) 2001, 2002, 2003, 2004, 2005,
- 2006, 2007 Free Software Foundation, Inc.
- Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ 2006, 2007, 2008 Free Software Foundation, Inc.
+ Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
National Institute of Advanced Industrial Science and Technology (AIST)
Registration Number H14PRO021
+ Copyright (C) 2003, 2006
+ National Institute of Advanced Industrial Science and Technology (AIST)
+ Registration Number H13PRO009
This file is part of GNU Emacs.
#ifndef EMACS_COMPOSITE_H
#define EMACS_COMPOSITE_H
-/* Methods to display a sequence of components a composition. */
+/* Methods to display a sequence of components of a composition. */
enum composition_method {
- /* The first two are actually not methods, but used in code
- conversion to specify the current composing status. */
- COMPOSITION_DISABLED, /* Never handle composition data */
- COMPOSITION_NO, /* Not processing composition data */
/* Compose relatively without alternate characters. */
COMPOSITION_RELATIVE,
- /* Compose by specified composition rule. This is not used in Emacs
- 21 but we need it to decode files saved in the older versions of
- Emacs. */
+ /* Compose by specified composition rules. This is not used in
+ Emacs 21 but we need it to decode files saved in the older
+ versions of Emacs. */
COMPOSITION_WITH_RULE,
/* Compose relatively with alternate characters. */
COMPOSITION_WITH_ALTCHARS,
- /* Compose by specified composition rule with alternate characters. */
- COMPOSITION_WITH_RULE_ALTCHARS
+ /* Compose by specified composition rules with alternate characters. */
+ COMPOSITION_WITH_RULE_ALTCHARS,
+ /* Compose by specified lispy glyph-string. */
+ COMPOSITION_WITH_GLYPH_STRING,
+ /* This is not a method. */
+ COMPOSITION_NO
};
/* Maximum number of compoments a single composition can have. */
: (composition_temp = XCDR (XCAR (prop)), \
(NILP (composition_temp) \
? COMPOSITION_RELATIVE \
- : ((INTEGERP (composition_temp) || STRINGP (composition_temp)) \
- ? COMPOSITION_WITH_ALTCHARS \
- : COMPOSITION_WITH_RULE_ALTCHARS))))
+ : (INTEGERP (composition_temp) || STRINGP (composition_temp)) \
+ ? COMPOSITION_WITH_ALTCHARS \
+ : (VECTORP (composition_temp) \
+ && ASIZE (composition_temp) >= 2 \
+ && VECTORP (AREF (composition_temp, 0))) \
+ ? COMPOSITION_WITH_GLYPH_STRING \
+ : COMPOSITION_WITH_RULE_ALTCHARS)))
/* Return 1 if the composition is valid. It is valid if length of
the composition equals to (END - START). */
->contents[(n) * 2 - 1])
/* Decode encoded composition rule RULE_CODE into GREF (global
- reference point code) and NREF (new reference point code). Don't
- check RULE_CODE, always set GREF and NREF to valid values. */
-#define COMPOSITION_DECODE_RULE(rule_code, gref, nref) \
- do { \
- gref = (rule_code) / 12; \
- if (gref > 12) gref = 11; \
- nref = (rule_code) % 12; \
+ reference point code), NREF (new reference point code), XOFF
+ (horizontal offset) YOFF (vertical offset). Don't check RULE_CODE,
+ always set GREF and NREF to valid values. By side effect,
+ RULE_CODE is modified. */
+
+#define COMPOSITION_DECODE_RULE(rule_code, gref, nref, xoff, yoff) \
+ do { \
+ xoff = (rule_code) >> 16; \
+ yoff = ((rule_code) >> 8) & 0xFF; \
+ rule_code &= 0xFF; \
+ gref = (rule_code) / 12; \
+ if (gref > 12) gref = 11; \
+ nref = (rule_code) % 12; \
} while (0)
/* Return encoded composition rule for the pair of global reference
/* Width, ascent, and descent pixels of the composition. */
short pixel_width, ascent, descent;
+ short lbearing, rbearing;
+
/* How many columns the overall glyphs occupy on the screen. This
gives an approximate value for column calculation in
Fcurrent_column, and etc. */
extern Lisp_Object Qcomposition;
extern Lisp_Object composition_hash_table;
+extern Lisp_Object Qauto_composed;
+extern Lisp_Object Vauto_composition_function;
+extern Lisp_Object Qauto_composition_function;
extern int get_composition_id P_ ((int, int, int, Lisp_Object, Lisp_Object));
-extern int find_composition P_ ((int, int, int *, int *, Lisp_Object *,
+extern int find_composition P_ ((int, int, EMACS_INT *, EMACS_INT *, Lisp_Object *,
Lisp_Object));
-extern void update_compositions P_ ((int, int, int));
+extern void update_compositions P_ ((EMACS_INT, EMACS_INT, int));
extern void make_composition_value_copy P_ ((Lisp_Object));
extern void compose_region P_ ((int, int, Lisp_Object, Lisp_Object,
Lisp_Object));
/* src/config.in. Generated from configure.in by autoheader. */
/* GNU Emacs site configuration template file.
- Copyright (C) 1988, 1993, 1994, 1999, 2000, 2001, 2002, 2004, 2005, 2006, 2007
- Free Software Foundation, Inc.
+ Copyright (C) 1988, 1993, 1994, 1999, 2000, 2001, 2002, 2004, 2005,
+ 2006, 2007, 2008 Free Software Foundation, Inc.
This file is part of GNU Emacs.
/* Define to 1 if you have the `fpathconf' function. */
#undef HAVE_FPATHCONF
+/* Define to 1 if you have freetype and fontconfig libraries. */
+#undef HAVE_FREETYPE
+
/* Define to 1 if you have the `frexp' function. */
#undef HAVE_FREXP
/* Define to 1 if you have the `ncurses' library (-lncurses). */
#undef HAVE_LIBNCURSES
+/* Define to 1 if you have libotf library. */
+#undef HAVE_LIBOTF
+
/* Define to 1 if you have the <libpng/png.h> header file. */
#undef HAVE_LIBPNG_PNG_H
/* Define to 1 if you have the `lrand48' function. */
#undef HAVE_LRAND48
+/* Define to 1 if you have m17n-flt library. */
+#undef HAVE_M17N_FLT
+
/* Define to 1 if you have the <machine/soundcard.h> header file. */
#undef HAVE_MACHINE_SOUNDCARD_H
/* Define to the unexec source file name. */
#undef UNEXEC_SRC
+/* Define to 1 if we should use font-backend. */
+#undef USE_FONT_BACKEND
+
/* Define to 1 if we should use toolkit scroll bars. */
#undef USE_TOOLKIT_SCROLL_BARS
# ifndef GC_SETJMP_WORKS
/* GC_SETJMP_WORKS is nearly always appropriate for GCC --
see NON_SAVING_SETJMP in the target descriptions. */
- /* Exceptions (see NON_SAVING_SETJMP in target description) are ns32k,
+ /* Exceptions (see NON_SAVING_SETJMP in target description) are
SCO5 non-ELF (but Emacs specifies ELF) and SVR3 on x86.
- Fixme: Deal with ns32k, SVR3. */
+ Fixme: Deal with SVR3. */
# define GC_SETJMP_WORKS 1
# endif
# ifndef GC_LISP_OBJECT_ALIGNMENT
/* Primitive operations on Lisp data types for GNU Emacs Lisp interpreter.
Copyright (C) 1985, 1986, 1988, 1993, 1994, 1995, 1997, 1998, 1999, 2000,
- 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
+ Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include <stdio.h>
#include "lisp.h"
#include "puresize.h"
-#include "charset.h"
+#include "character.h"
#include "buffer.h"
#include "keyboard.h"
#include "frame.h"
{
/* If VALUE is not even a valid Lisp object, abort here
where we can get a backtrace showing where it came from. */
- if ((unsigned int) XGCTYPE (value) >= Lisp_Type_Limit)
+ if ((unsigned int) XTYPE (value) >= Lisp_Type_Limit)
abort ();
xsignal2 (Qwrong_type_argument, predicate, value);
(object)
Lisp_Object object;
{
- switch (XGCTYPE (object))
+ switch (XTYPE (object))
{
case Lisp_Int:
return Qinteger;
abort ();
case Lisp_Vectorlike:
- if (GC_WINDOW_CONFIGURATIONP (object))
+ if (WINDOW_CONFIGURATIONP (object))
return Qwindow_configuration;
- if (GC_PROCESSP (object))
+ if (PROCESSP (object))
return Qprocess;
- if (GC_WINDOWP (object))
+ if (WINDOWP (object))
return Qwindow;
- if (GC_SUBRP (object))
+ if (SUBRP (object))
return Qsubr;
- if (GC_COMPILEDP (object))
+ if (COMPILEDP (object))
return Qcompiled_function;
- if (GC_BUFFERP (object))
+ if (BUFFERP (object))
return Qbuffer;
- if (GC_CHAR_TABLE_P (object))
+ if (CHAR_TABLE_P (object))
return Qchar_table;
- if (GC_BOOL_VECTOR_P (object))
+ if (BOOL_VECTOR_P (object))
return Qbool_vector;
- if (GC_FRAMEP (object))
+ if (FRAMEP (object))
return Qframe;
- if (GC_HASH_TABLE_P (object))
+ if (HASH_TABLE_P (object))
return Qhash_table;
return Qvector;
}
DEFUN ("char-or-string-p", Fchar_or_string_p, Schar_or_string_p, 1, 1, 0,
- doc: /* Return t if OBJECT is a character (an integer) or a string. */)
+ doc: /* Return t if OBJECT is a character or a string. */)
(object)
register Lisp_Object object;
{
- if (INTEGERP (object) || STRINGP (object))
+ if (CHARACTERP (object) || STRINGP (object))
return Qt;
return Qnil;
}
}
else if (CHAR_TABLE_P (array))
{
- Lisp_Object val;
-
- val = Qnil;
-
- if (idxval < 0)
- args_out_of_range (array, idx);
- if (idxval < CHAR_TABLE_ORDINARY_SLOTS)
- {
- if (! SINGLE_BYTE_CHAR_P (idxval))
- args_out_of_range (array, idx);
- /* For ASCII and 8-bit European characters, the element is
- stored in the top table. */
- val = XCHAR_TABLE (array)->contents[idxval];
- if (NILP (val))
- {
- int default_slot
- = (idxval < 0x80 ? CHAR_TABLE_DEFAULT_SLOT_ASCII
- : idxval < 0xA0 ? CHAR_TABLE_DEFAULT_SLOT_8_BIT_CONTROL
- : CHAR_TABLE_DEFAULT_SLOT_8_BIT_GRAPHIC);
- val = XCHAR_TABLE (array)->contents[default_slot];
- }
- if (NILP (val))
- val = XCHAR_TABLE (array)->defalt;
- while (NILP (val)) /* Follow parents until we find some value. */
- {
- array = XCHAR_TABLE (array)->parent;
- if (NILP (array))
- return Qnil;
- val = XCHAR_TABLE (array)->contents[idxval];
- if (NILP (val))
- val = XCHAR_TABLE (array)->defalt;
- }
- return val;
- }
- else
- {
- int code[4], i;
- Lisp_Object sub_table;
- Lisp_Object current_default;
-
- SPLIT_CHAR (idxval, code[0], code[1], code[2]);
- if (code[1] < 32) code[1] = -1;
- else if (code[2] < 32) code[2] = -1;
-
- /* Here, the possible range of CODE[0] (== charset ID) is
- 128..MAX_CHARSET. Since the top level char table contains
- data for multibyte characters after 256th element, we must
- increment CODE[0] by 128 to get a correct index. */
- code[0] += 128;
- code[3] = -1; /* anchor */
-
- try_parent_char_table:
- current_default = XCHAR_TABLE (array)->defalt;
- sub_table = array;
- for (i = 0; code[i] >= 0; i++)
- {
- val = XCHAR_TABLE (sub_table)->contents[code[i]];
- if (SUB_CHAR_TABLE_P (val))
- {
- sub_table = val;
- if (! NILP (XCHAR_TABLE (sub_table)->defalt))
- current_default = XCHAR_TABLE (sub_table)->defalt;
- }
- else
- {
- if (NILP (val))
- val = current_default;
- if (NILP (val))
- {
- array = XCHAR_TABLE (array)->parent;
- if (!NILP (array))
- goto try_parent_char_table;
- }
- return val;
- }
- }
- /* Reaching here means IDXVAL is a generic character in
- which each character or a group has independent value.
- Essentially it's nonsense to get a value for such a
- generic character, but for backward compatibility, we try
- the default value and parent. */
- val = current_default;
- if (NILP (val))
- {
- array = XCHAR_TABLE (array)->parent;
- if (!NILP (array))
- goto try_parent_char_table;
- }
- return val;
- }
+ CHECK_CHARACTER (idx);
+ return CHAR_TABLE_REF (array, idxval);
}
else
{
}
else if (CHAR_TABLE_P (array))
{
- if (idxval < 0)
- args_out_of_range (array, idx);
- if (idxval < CHAR_TABLE_ORDINARY_SLOTS)
- {
- if (! SINGLE_BYTE_CHAR_P (idxval))
- args_out_of_range (array, idx);
- XCHAR_TABLE (array)->contents[idxval] = newelt;
- }
- else
- {
- int code[4], i;
- Lisp_Object val;
-
- SPLIT_CHAR (idxval, code[0], code[1], code[2]);
- if (code[1] < 32) code[1] = -1;
- else if (code[2] < 32) code[2] = -1;
-
- /* See the comment of the corresponding part in Faref. */
- code[0] += 128;
- code[3] = -1; /* anchor */
- for (i = 0; code[i + 1] >= 0; i++)
- {
- val = XCHAR_TABLE (array)->contents[code[i]];
- if (SUB_CHAR_TABLE_P (val))
- array = val;
- else
- {
- Lisp_Object temp;
-
- /* VAL is a leaf. Create a sub char table with the
- initial value VAL and look into it. */
-
- temp = make_sub_char_table (val);
- XCHAR_TABLE (array)->contents[code[i]] = temp;
- array = temp;
- }
- }
- XCHAR_TABLE (array)->contents[code[i]] = newelt;
- }
+ CHECK_CHARACTER (idx);
+ CHAR_TABLE_SET (array, idxval, newelt);
}
else if (STRING_MULTIBYTE (array))
{
if (idxval < 0 || idxval >= SCHARS (array))
args_out_of_range (array, idx);
- CHECK_NUMBER (newelt);
+ CHECK_CHARACTER (newelt);
nbytes = SBYTES (array);
args_out_of_range (array, idx);
CHECK_NUMBER (newelt);
- if (XINT (newelt) < 0 || SINGLE_BYTE_CHAR_P (XINT (newelt)))
- SSET (array, idxval, XINT (newelt));
- else
- {
- /* We must relocate the string data while converting it to
- multibyte. */
- int idxval_byte, prev_bytes, new_bytes;
- unsigned char workbuf[MAX_MULTIBYTE_LENGTH], *p0 = workbuf, *p1;
- unsigned char *origstr = SDATA (array), *str;
- int nchars, nbytes;
- USE_SAFE_ALLOCA;
-
- nchars = SCHARS (array);
- nbytes = idxval_byte = count_size_as_multibyte (origstr, idxval);
- nbytes += count_size_as_multibyte (origstr + idxval,
- nchars - idxval);
- SAFE_ALLOCA (str, unsigned char *, nbytes);
- copy_text (SDATA (array), str, nchars, 0, 1);
- PARSE_MULTIBYTE_SEQ (str + idxval_byte, nbytes - idxval_byte,
- prev_bytes);
- new_bytes = CHAR_STRING (XINT (newelt), p0);
- allocate_string_data (XSTRING (array), nchars,
- nbytes + new_bytes - prev_bytes);
- bcopy (str, SDATA (array), idxval_byte);
- p1 = SDATA (array) + idxval_byte;
- while (new_bytes--)
- *p1++ = *p0++;
- bcopy (str + idxval_byte + prev_bytes, p1,
- nbytes - (idxval_byte + prev_bytes));
- SAFE_FREE ();
- clear_string_char_byte_cache ();
- }
+ if (XINT (newelt) >= 0 && ! SINGLE_BYTE_CHAR_P (XINT (newelt)))
+ args_out_of_range (array, newelt);
+ SSET (array, idxval, XINT (newelt));
}
return newelt;
/* Lisp functions for making directory listings.
Copyright (C) 1985, 1986, 1993, 1994, 1999, 2000, 2001, 2002, 2003,
- 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include "systime.h"
#include "buffer.h"
#include "commands.h"
+#include "character.h"
#include "charset.h"
#include "coding.h"
#include "regex.h"
/* Interface definitions for display code.
Copyright (C) 1985, 1993, 1994, 1997, 1998, 1999, 2000, 2001, 2002,
- 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ 2003, 2004, 2005, 2006, 2007, 2008
+ Free Software Foundation, Inc.
This file is part of GNU Emacs.
/* Continuation lines width at the start of the row. */
int continuation_lines_width;
+
+#ifdef HAVE_WINDOW_SYSTEM
+ /* Non-NULL means the current clipping area. This is temporarily
+ set while exposing a region. Coordinates are frame-relative. */
+ XRectangle *clip;
+#endif
};
*clip_tail, not including their overhangs. */
struct glyph_string *clip_head, *clip_tail;
+ /* The current clipping areas. */
+ NativeRectangle clip[2];
+
+ /* Number of clipping areas. */
+ int num_clips;
+
struct glyph_string *next, *prev;
};
LFACE_FONT_INDEX,
LFACE_INHERIT_INDEX,
LFACE_AVGWIDTH_INDEX,
+ LFACE_FONTSET_INDEX,
LFACE_VECTOR_SIZE
};
reallocated. */
int font_info_id;
- /* Fontset ID if this face uses a fontset, or -1. This is only >= 0
- if the face was realized for a composition sequence.
- Otherwise, a specific font is loaded from the set of fonts
- specified by the fontset given by the family attribute of the face. */
+ struct font_info *font_info;
+
+ /* Fontset ID if for this face's fontset. Non-ASCII faces derived
+ from the same ASCII face have the same fontset. */
int fontset;
/* Pixmap width and height. */
/* The hash value of this face. */
unsigned hash;
- /* The charset for which this face was realized if it was realized
- for use in multibyte text. If fontset >= 0, this is the charset
- of the first character of the composition sequence. A value of
- charset < 0 means the face was realized for use in unibyte text
- where the idea of Emacs charsets isn't applicable. */
- int charset;
-
/* Non-zero if text in this face should be underlined, overlined,
strike-through or have a box drawn around it. */
unsigned underline_p : 1;
/* Next and previous face in hash collision list of face cache. */
struct face *next, *prev;
- /* If this face is for ASCII characters, this points this face
- itself. Otherwise, this points a face for ASCII characters. */
+ /* If this face is an ASCII face, this points to this face itself.
+ Otherwise, this points to an ASCII face that has the same
+ attributes except the font. */
struct face *ascii_face;
+
+ /* Extra member that a font-driver uses privately. */
+ void *extra;
};
/* Non-zero if FACE is suitable for displaying character CHAR. */
#define FACE_SUITABLE_FOR_CHAR_P(FACE, CHAR) \
- (SINGLE_BYTE_CHAR_P (CHAR) \
+ (ASCII_CHAR_P (CHAR) \
? (FACE) == (FACE)->ascii_face \
: face_suitable_for_char_p ((FACE), (CHAR)))
with id ID but is suitable for displaying character CHAR.
This macro is only meaningful for multibyte character CHAR. */
-#define FACE_FOR_CHAR(F, FACE, CHAR) \
- (SINGLE_BYTE_CHAR_P (CHAR) \
- ? (FACE)->ascii_face->id \
- : face_for_char ((F), (FACE), (CHAR)))
+#define FACE_FOR_CHAR(F, FACE, CHAR, POS, OBJECT) \
+ (ASCII_CHAR_P (CHAR) \
+ ? (FACE)->ascii_face->id \
+ : face_for_char ((F), (FACE), (CHAR), (POS), (OBJECT)))
#else /* not HAVE_WINDOW_SYSTEM */
#define FACE_SUITABLE_FOR_CHAR_P(FACE, CHAR) 1
-#define FACE_FOR_CHAR(F, FACE, CHAR) ((FACE)->id)
+#define FACE_FOR_CHAR(F, FACE, CHAR, POS, OBJECT) ((FACE)->id)
#endif /* not HAVE_WINDOW_SYSTEM */
enum prop_idx
{
+ AUTO_COMPOSED_PROP_IDX,
FONTIFIED_PROP_IDX,
FACE_PROP_IDX,
INVISIBLE_PROP_IDX,
the two-byte form of C. Encoding is returned in *CHAR2B. If
TWO_BYTE_P is non-null, return non-zero there if font is two-byte. */
int (*encode_char) P_ ((int c, XChar2b *char2b,
- struct font_info *font_into, int *two_byte_p));
+ struct font_info *font_into,
+ struct charset *charset,
+ int *two_byte_p));
/* Compute left and right overhang of glyph string S.
A NULL pointer if platform does not support this. */
unsigned long load_color P_ ((struct frame *, struct face *, Lisp_Object,
enum lface_attribute_index));
void unload_color P_ ((struct frame *, unsigned long));
-int face_font_available_p P_ ((struct frame *, Lisp_Object));
+char *choose_face_font P_ ((struct frame *, Lisp_Object *, Lisp_Object,
+ int *));
int ascii_face_of_lisp_face P_ ((struct frame *, int));
void prepare_face_for_display P_ ((struct frame *, struct face *));
int xstricmp P_ ((const unsigned char *, const unsigned char *));
-int lookup_face P_ ((struct frame *, Lisp_Object *, int, struct face *));
-int lookup_named_face P_ ((struct frame *, Lisp_Object, int, int));
+int lookup_face P_ ((struct frame *, Lisp_Object *));
+int lookup_non_ascii_face P_ ((struct frame *, int, struct face *));
+int lookup_named_face P_ ((struct frame *, Lisp_Object, int));
int smaller_face P_ ((struct frame *, int, int));
int face_with_height P_ ((struct frame *, int, int));
-int lookup_derived_face P_ ((struct frame *, Lisp_Object, int, int, int));
+int lookup_derived_face P_ ((struct frame *, Lisp_Object, int, int));
void init_frame_faces P_ ((struct frame *));
void free_frame_faces P_ ((struct frame *));
void recompute_basic_faces P_ ((struct frame *));
int merge_faces P_ ((struct frame *, Lisp_Object, int, int));
int compute_char_face P_ ((struct frame *, int, Lisp_Object));
void free_all_realized_faces P_ ((Lisp_Object));
+void free_realized_face P_ ((struct frame *, struct face *));
extern Lisp_Object Qforeground_color, Qbackground_color;
extern Lisp_Object Qframe_set_background_mode;
extern char unspecified_fg[], unspecified_bg[];
-void free_realized_multibyte_face P_ ((struct frame *, int));
+extern Lisp_Object split_font_name_into_vector P_ ((Lisp_Object));
+extern Lisp_Object build_font_name_from_vector P_ ((Lisp_Object));
/* Defined in xfns.c */
/* Updating of data structures for redisplay.
Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995,
1997, 1998, 1999, 2000, 2001, 2002, 2003,
- 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include "dispextern.h"
#include "cm.h"
#include "buffer.h"
-#include "charset.h"
+#include "character.h"
#include "keyboard.h"
#include "frame.h"
#include "termhooks.h"
/* Things for GLYPHS and glyph tables.
Copyright (C) 1993, 2001, 2002, 2003, 2004, 2005,
- 2006, 2007 Free Software Foundation, Inc.
+ 2006, 2007, 2008 Free Software Foundation, Inc.
This file is part of GNU Emacs.
extern Lisp_Object disp_char_vector P_ ((struct Lisp_Char_Table *, int));
-#define DISP_CHAR_VECTOR(dp, c) \
- (SINGLE_BYTE_CHAR_P(c) ? (dp)->contents[c] : disp_char_vector ((dp), (c)))
+#define DISP_CHAR_VECTOR(dp, c) \
+ (ASCII_CHAR_P(c) \
+ ? (NILP ((dp)->ascii) \
+ ? (dp)->defalt \
+ : (SUB_CHAR_TABLE_P ((dp)->ascii) \
+ ? XSUB_CHAR_TABLE ((dp)->ascii)->contents[c] \
+ : (dp)->ascii)) \
+ : disp_char_vector ((dp), (c)))
/* Defined in window.c. */
extern struct Lisp_Char_Table *window_display_table P_ ((struct window *));
/* Record indices of function doc strings stored in a file.
Copyright (C) 1985, 1986, 1993, 1994, 1995, 1997, 1998, 1999, 2000, 2001,
- 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ 2002, 2003, 2004, 2005, 2006, 2007, 2008
+ Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include "lisp.h"
#include "buffer.h"
#include "keyboard.h"
-#include "charset.h"
+#include "character.h"
#include "keymap.h"
#ifdef HAVE_INDEX
Also takes args differently: pass one pointer to an array of strings
in addition to the format string which is separate.
Copyright (C) 1985, 2001, 2002, 2003, 2004, 2005,
- 2006, 2007 Free Software Foundation, Inc.
+ 2006, 2007, 2008 Free Software Foundation, Inc.
This file is part of GNU Emacs.
/* Since we use the macro CHAR_HEAD_P, we have to include this, but
don't have to include others because CHAR_HEAD_P does not contains
another macro. */
-#include "charset.h"
+#include "character.h"
static int doprnt1 ();
/* MS-DOS specific Lisp utilities. Coded by Manabu Higashida, 1991.
Major changes May-July 1993 Morten Welinder (only 10% original code left)
Copyright (C) 1991, 1993, 1996, 1997, 1998, 2001, 2002, 2003, 2004,
- 2005, 2006, 2007 Free Software Foundation, Inc.
+ 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include "dosfns.h"
#include "msdos.h"
#include "dispextern.h"
-#include "charset.h"
+#include "character.h"
#include "coding.h"
#include <dpmi.h>
#include <go32.h>
/* Lisp functions pertaining to editing.
Copyright (C) 1985, 1986, 1987, 1989, 1993, 1994, 1995, 1996,
1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- 2005, 2006, 2007 Free Software Foundation, Inc.
+ 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include "intervals.h"
#include "buffer.h"
-#include "charset.h"
+#include "character.h"
#include "coding.h"
#include "frame.h"
#include "window.h"
int len;
unsigned char str[MAX_MULTIBYTE_LENGTH];
- CHECK_NUMBER (character);
+ CHECK_CHARACTER (character);
- len = (SINGLE_BYTE_CHAR_P (XFASTINT (character))
- ? (*str = (unsigned char)(XFASTINT (character)), 1)
- : char_to_string (XFASTINT (character), str));
+ len = CHAR_STRING (XFASTINT (character), str);
return make_string_from_bytes (str, 1, len);
}
for (argnum = 0; argnum < nargs; argnum++)
{
val = args[argnum];
- if (INTEGERP (val))
+ if (CHARACTERP (val))
{
unsigned char str[MAX_MULTIBYTE_LENGTH];
int len;
len = CHAR_STRING (XFASTINT (val), str);
else
{
- str[0] = (SINGLE_BYTE_CHAR_P (XINT (val))
+ str[0] = (ASCII_CHAR_P (XINT (val))
? XINT (val)
: multibyte_char_to_unibyte (XINT (val), Qnil));
len = 1;
return Qnil;
}
+DEFUN ("insert-byte", Finsert_byte, Sinsert_byte, 2, 3, 0,
+ doc: /* Insert COUNT (second arg) copies of BYTE (first arg).
+Both arguments are required.
+BYTE is a number of the range 0..255.
+
+If BYTE is 128..255 and the current buffer is multibyte, the
+corresponding eight-bit character is inserted.
+
+Point, and before-insertion markers, are relocated as in the function `insert'.
+The optional third arg INHERIT, if non-nil, says to inherit text properties
+from adjoining text, if those properties are sticky. */)
+ (byte, count, inherit)
+ Lisp_Object byte, count, inherit;
+{
+ CHECK_NUMBER (byte);
+ if (XINT (byte) < 0 || XINT (byte) > 255)
+ args_out_of_range_3 (byte, make_number (0), make_number (255));
+ if (XINT (byte) >= 128
+ && ! NILP (current_buffer->enable_multibyte_characters))
+ XSETFASTINT (byte, BYTE8_TO_CHAR (XINT (byte)));
+ return Finsert_char (byte, count, inherit);
+}
+
\f
/* Making strings from buffer contents. */
return Qnil;
}
+
+static Lisp_Object check_translation P_ ((int, int, int, Lisp_Object));
+
+/* Helper function for Ftranslate_region_internal.
+
+ Check if a character sequence at POS (POS_BYTE) matches an element
+ of VAL. VAL is a list (([FROM-CHAR ...] . TO) ...). If a matching
+ element is found, return it. Otherwise return Qnil. */
+
+static Lisp_Object
+check_translation (pos, pos_byte, end, val)
+ int pos, pos_byte, end;
+ Lisp_Object val;
+{
+ int buf_size = 16, buf_used = 0;
+ int *buf = alloca (sizeof (int) * buf_size);
+
+ for (; CONSP (val); val = XCDR (val))
+ {
+ Lisp_Object elt;
+ int len, i;
+
+ elt = XCAR (val);
+ if (! CONSP (elt))
+ continue;
+ elt = XCAR (elt);
+ if (! VECTORP (elt))
+ continue;
+ len = ASIZE (elt);
+ if (len <= end - pos)
+ {
+ for (i = 0; i < len; i++)
+ {
+ if (buf_used <= i)
+ {
+ unsigned char *p = BYTE_POS_ADDR (pos_byte);
+ int len;
+
+ if (buf_used == buf_size)
+ {
+ int *newbuf;
+
+ buf_size += 16;
+ newbuf = alloca (sizeof (int) * buf_size);
+ memcpy (newbuf, buf, sizeof (int) * buf_used);
+ buf = newbuf;
+ }
+ buf[buf_used++] = STRING_CHAR_AND_LENGTH (p, 0, len);
+ pos_byte += len;
+ }
+ if (XINT (AREF (elt, i)) != buf[i])
+ break;
+ }
+ if (i == len)
+ return XCAR (val);
+ }
+ }
+ return Qnil;
+}
+
+
DEFUN ("translate-region-internal", Ftranslate_region_internal,
Stranslate_region_internal, 3, 3, 0,
doc: /* Internal use only.
From START to END, translate characters according to TABLE.
-TABLE is a string; the Nth character in it is the mapping
-for the character with code N.
+TABLE is a string or a char-table; the Nth character in it is the
+mapping for the character with code N.
It returns the number of characters changed. */)
(start, end, table)
Lisp_Object start;
int pos, pos_byte, end_pos;
int multibyte = !NILP (current_buffer->enable_multibyte_characters);
int string_multibyte;
+ Lisp_Object val;
validate_region (&start, &end);
if (CHAR_TABLE_P (table))
{
+ if (! EQ (XCHAR_TABLE (table)->purpose, Qtranslation_table))
+ error ("Not a translation table");
size = MAX_CHAR;
tt = NULL;
}
if (! multibyte && (SCHARS (table) < SBYTES (table)))
table = string_make_unibyte (table);
string_multibyte = SCHARS (table) < SBYTES (table);
- size = SCHARS (table);
+ size = SBYTES (table);
tt = SDATA (table);
}
pos = XINT (start);
pos_byte = CHAR_TO_BYTE (pos);
end_pos = XINT (end);
- modify_region (current_buffer, pos, XINT (end), 0);
+ modify_region (current_buffer, pos, end_pos, 0);
cnt = 0;
for (; pos < end_pos; )
unsigned char *str, buf[MAX_MULTIBYTE_LENGTH];
int len, str_len;
int oc;
+ Lisp_Object val;
if (multibyte)
oc = STRING_CHAR_AND_LENGTH (p, MAX_MULTIBYTE_LENGTH, len);
if (string_multibyte)
{
str = tt + string_char_to_byte (table, oc);
- nc = STRING_CHAR_AND_LENGTH (str, MAX_MULTIBYTE_LENGTH,
+ nc = STRING_CHAR_AND_LENGTH (str, MAX_MULTIBYTE_LENGTH,
str_len);
}
else
nc = tt[oc];
if (! ASCII_BYTE_P (nc) && multibyte)
{
- str_len = CHAR_STRING (nc, buf);
+ str_len = BYTE8_STRING (nc, buf);
str = buf;
}
else
}
else
{
- Lisp_Object val;
int c;
nc = oc;
val = CHAR_TABLE_REF (table, oc);
- if (INTEGERP (val)
+ if (CHARACTERP (val)
&& (c = XINT (val), CHAR_VALID_P (c, 0)))
{
nc = c;
str_len = CHAR_STRING (nc, buf);
str = buf;
}
+ else if (VECTORP (val) || (CONSP (val)))
+ {
+ /* VAL is [TO_CHAR ...] or (([FROM-CHAR ...] . TO) ...)
+ where TO is TO-CHAR or [TO-CHAR ...]. */
+ nc = -1;
+ }
}
- if (nc != oc)
+ if (nc != oc && nc >= 0)
{
+ /* Simple one char to one char translation. */
if (len != str_len)
{
Lisp_Object string;
/* This is less efficient, because it moves the gap,
- but it should multibyte characters correctly. */
+ but it should handle multibyte characters correctly. */
string = make_multibyte_string (str, 1, str_len);
replace_range (pos, pos + 1, string, 1, 0, 1);
len = str_len;
}
++cnt;
}
+ else if (nc < 0)
+ {
+ Lisp_Object string;
+
+ if (CONSP (val))
+ {
+ val = check_translation (pos, pos_byte, end_pos, val);
+ if (NILP (val))
+ {
+ pos_byte += len;
+ pos++;
+ continue;
+ }
+ /* VAL is ([FROM-CHAR ...] . TO). */
+ len = ASIZE (XCAR (val));
+ val = XCDR (val);
+ }
+ else
+ len = 1;
+
+ if (VECTORP (val))
+ {
+ int i;
+
+ string = Fmake_string (make_number (ASIZE (val)),
+ AREF (val, 0));
+ for (i = 1; i < ASIZE (val); i++)
+ Faset (string, make_number (i), AREF (val, i));
+ }
+ else
+ {
+ string = Fmake_string (make_number (1), val);
+ }
+ replace_range (pos, pos + len, string, 1, 0, 1);
+ pos_byte += SBYTES (string);
+ pos += SCHARS (string);
+ cnt += SCHARS (string);
+ end_pos += SCHARS (string) - len;
+ continue;
+ }
}
pos_byte += len;
pos++;
thissize = 30 + (precision[n] > 0 ? precision[n] : 0);
if (*format == 'c')
{
- if (! SINGLE_BYTE_CHAR_P (XINT (args[n]))
- /* Note: No one can remember why we have to treat
+ if (! ASCII_CHAR_P (XINT (args[n]))
+ /* Note: No one can remeber why we have to treat
the character 0 as a multibyte character here.
But, until it causes a real problem, let's
don't change it. */
/* Do these in separate statements,
then compare the variables.
because of the way DOWNCASE uses temp variables. */
- i1 = DOWNCASE (XFASTINT (c1));
- i2 = DOWNCASE (XFASTINT (c2));
+ i1 = XFASTINT (c1);
+ if (NILP (current_buffer->enable_multibyte_characters)
+ && ! ASCII_CHAR_P (i1))
+ {
+ MAKE_CHAR_MULTIBYTE (i1);
+ }
+ i2 = XFASTINT (c2);
+ if (NILP (current_buffer->enable_multibyte_characters)
+ && ! ASCII_CHAR_P (i2))
+ {
+ MAKE_CHAR_MULTIBYTE (i2);
+ }
+ i1 = DOWNCASE (i1);
+ i2 = DOWNCASE (i2);
return (i1 == i2 ? Qt : Qnil);
}
\f
defsubr (&Sinsert_and_inherit);
defsubr (&Sinsert_and_inherit_before_markers);
defsubr (&Sinsert_char);
+ defsubr (&Sinsert_byte);
defsubr (&Suser_login_name);
defsubr (&Suser_real_login_name);
/* Fully extensible Emacs, running on Unix, intended for GNU.
Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1997, 1998, 1999,
- 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
+ Free Software Foundation, Inc.
This file is part of GNU Emacs.
return count >= 3 ? REPORT_EMACS_BUG_PRETEST_ADDRESS : REPORT_EMACS_BUG_ADDRESS;
}
+#ifdef USE_FONT_BACKEND
+extern int enable_font_backend;
+#endif /* USE_FONT_BACKEND */
/* ARGSUSED */
int
init_alloc_once ();
init_obarray ();
init_eval_once ();
+ init_character_once ();
init_charset_once ();
init_coding_once ();
init_syntax_once (); /* Create standard syntax table. */
syms_of_macterm ();
syms_of_macmenu ();
syms_of_macselect ();
- syms_of_data ();
syms_of_search ();
syms_of_frame ();
mac_term_init (build_string ("Mac"), NULL, NULL);
init_keyboard ();
#endif
+ /* Called before syms_of_fileio, because it sets up Qerror_condition. */
+ syms_of_data ();
+ syms_of_fileio ();
+ /* Before syms_of_coding to initialize Vgc_cons_threshold. */
+ syms_of_alloc ();
+ /* Before syms_of_coding because it initializes Qcharsetp. */
+ syms_of_charset ();
+ /* Before init_window_once, because it sets up the
+ Vcoding_system_hash_table. */
+ syms_of_coding (); /* This should be after syms_of_fileio. */
init_window_once (); /* Init the window system. */
init_fileio_once (); /* Must precede any path manipulation. */
Lisp_Object buffer;
buffer = Fcdr (XCAR (tail));
- /* Verify that all buffers are empty now, as they
- ought to be. */
- if (BUF_Z (XBUFFER (buffer)) > BUF_BEG (XBUFFER (buffer)))
- abort ();
- /* It is safe to do this crudely in an empty buffer. */
- XBUFFER (buffer)->enable_multibyte_characters = Qnil;
+ /* Make a multibyte buffer unibyte. */
+ if (BUF_Z_BYTE (XBUFFER (buffer)) > BUF_Z (XBUFFER (buffer)))
+ {
+ struct buffer *current = current_buffer;
+
+ set_buffer_temp (XBUFFER (buffer));
+ Fset_buffer_multibyte (Qnil);
+ set_buffer_temp (current);
+ }
}
}
}
no_loadup
= argmatch (argv, argc, "-nl", "--no-loadup", 6, NULL, &skip_args);
+#ifdef USE_FONT_BACKEND
+ enable_font_backend = 1;
+ if (argmatch (argv, argc, "-enable-font-backend", "--enable-font-backend",
+ 4, NULL, &skip_args))
+ enable_font_backend = 1;
+ else if (argmatch (argv, argc,
+ "-disable-font-backend", "--disable-font-backend",
+ 4, NULL, &skip_args))
+ enable_font_backend = 0;
+#endif /* USE_FONT_BACKEND */
#ifdef HAVE_X_WINDOWS
/* Stupid kludge to catch command-line display spec. We can't
/* Called before init_window_once for Mac OS Classic. */
syms_of_data ();
#endif
- syms_of_alloc ();
+ syms_of_chartab ();
syms_of_lread ();
syms_of_print ();
syms_of_eval ();
/* Called before init_window_once for Mac OS Classic. */
syms_of_ccl ();
#endif
- syms_of_charset ();
+ syms_of_character ();
syms_of_cmds ();
#ifndef NO_DIR_LIBRARY
syms_of_dired ();
syms_of_doc ();
syms_of_editfns ();
syms_of_emacs ();
- syms_of_fileio ();
- syms_of_coding (); /* This should be after syms_of_fileio. */
#ifdef CLASH_DETECTION
syms_of_filelock ();
#endif /* CLASH_DETECTION */
syms_of_window ();
syms_of_xdisp ();
#ifdef HAVE_WINDOW_SYSTEM
+ syms_of_font ();
syms_of_fringe ();
syms_of_image ();
#endif /* HAVE_WINDOW_SYSTEM */
#endif /* HAVE_NTGUI */
}
+ init_charset ();
+
init_editfns (); /* init_process uses Voperating_system_release. */
init_process (); /* init_display uses add_keyboard_wait_descriptor. */
#ifndef MAC_OS8
{ "-unibyte", "--unibyte", 81, 0 },
{ "-no-multibyte", "--no-multibyte", 80, 0 },
{ "-nl", "--no-loadup", 70, 0 },
+ { "-enable-font-backend", "--enable-font-backend", 65, 0 },
+ { "-disable-font-backend", "--disable-font-backend", 65, 0 },
/* -d must come last before the options handled in startup.el. */
{ "-d", "--display", 60, 1 },
{ "-display", 0, 60, 1 },
/* File IO for GNU Emacs.
Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995, 1996,
1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- 2005, 2006, 2007 Free Software Foundation, Inc.
+ 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include "lisp.h"
#include "intervals.h"
#include "buffer.h"
-#include "charset.h"
+#include "character.h"
#include "coding.h"
#include "window.h"
#include "blockinput.h"
{
Lisp_Object errstring;
int errorno = errno;
+ char *str;
synchronize_system_messages_locale ();
- errstring = code_convert_string_norecord (build_string (strerror (errorno)),
+ str = strerror (errorno);
+ errstring = code_convert_string_norecord (make_unibyte_string (str,
+ strlen (str)),
Vlocale_coding_system, 0);
while (1)
Fset_marker (location, Qnil, Qnil);
return Qnil;
}
+
\f
Lisp_Object Qexpand_file_name;
Lisp_Object Qsubstitute_in_file_name;
1, 1, 0,
doc: /* Return the directory component in file name FILENAME.
Return nil if FILENAME does not include a directory.
- Otherwise return a directory spec.
+ Otherwise return a directory name.
Given a Unix syntax file name, returns a string ending in slash;
on VMS, perhaps instead a string ending in `:', `]' or `>'. */)
(filename)
DEFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
doc: /* Convert filename NAME to absolute, and canonicalize it.
Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
- \(does not start with slash); if DEFAULT-DIRECTORY is nil or missing,
+ \(does not start with slash or tilde); if DEFAULT-DIRECTORY is nil or missing,
the current buffer's value of `default-directory' is used.
File name components that are `.' are removed, and
so are file name components followed by `..', along with the `..' itself;
}
name = FILE_SYSTEM_CASE (name);
- nm = SDATA (name);
multibyte = STRING_MULTIBYTE (name);
+ if (multibyte != STRING_MULTIBYTE (default_directory))
+ {
+ if (multibyte)
+ default_directory = string_to_multibyte (default_directory);
+ else
+ {
+ name = string_to_multibyte (name);
+ multibyte = 1;
+ }
+ }
+
+ nm = SDATA (name);
#ifdef DOS_NT
/* We will force directory separators to be either all \ or /, so make
&& !newdir)
{
newdir = SDATA (default_directory);
- multibyte |= STRING_MULTIBYTE (default_directory);
#ifdef DOS_NT
/* Note if special escape prefix is present, but remove for now. */
if (newdir[0] == '/' && newdir[1] == ':')
convert what we substitute into multibyte. */
while (*o)
{
- int c = unibyte_char_to_multibyte (*o++);
+ int c = *o++;
+ c = unibyte_char_to_multibyte (c);
x += CHAR_STRING (c, x);
}
}
unsigned char buffer[1 << 14];
int replace_handled = 0;
int set_coding_system = 0;
- int coding_system_decided = 0;
+ Lisp_Object coding_system;
int read_quit = 0;
Lisp_Object old_Vdeactivate_mark = Vdeactivate_mark;
int we_locked_file = 0;
CHECK_STRING (filename);
filename = Fexpand_file_name (filename, Qnil);
+ /* The value Qnil means that the coding system is not yet
+ decided. */
+ coding_system = Qnil;
+
/* If the file name has special constructs in it,
call the corresponding file handler. */
handler = Ffind_file_name_handler (filename, Qinsert_file_contents);
if (EQ (Vcoding_system_for_read, Qauto_save_coding))
{
- /* We use emacs-mule for auto saving... */
- setup_coding_system (Qemacs_mule, &coding);
- /* ... but with the special flag to indicate to read in a
- multibyte sequence for eight-bit-control char as is. */
- coding.flags = 1;
- coding.src_multibyte = 0;
- coding.dst_multibyte
- = !NILP (current_buffer->enable_multibyte_characters);
- coding.eol_type = CODING_EOL_LF;
- coding_system_decided = 1;
+ coding_system = coding_inherit_eol_type (Qutf_8_emacs, Qunix);
+ setup_coding_system (coding_system, &coding);
+ /* Ensure we set Vlast_coding_system_used. */
+ set_coding_system = 1;
}
else if (BEG < Z)
{
/* Decide the coding system to use for reading the file now
because we can't use an optimized method for handling
`coding:' tag if the current buffer is not empty. */
- Lisp_Object val;
- val = Qnil;
-
if (!NILP (Vcoding_system_for_read))
- val = Vcoding_system_for_read;
+ coding_system = Vcoding_system_for_read;
else
{
/* Don't try looking inside a file for a coding system
insert_1_both (read_buf, nread, nread, 0, 0, 0);
TEMP_SET_PT_BOTH (BEG, BEG_BYTE);
- val = call2 (Vset_auto_coding_function,
- filename, make_number (nread));
+ coding_system = call2 (Vset_auto_coding_function,
+ filename, make_number (nread));
set_buffer_internal (prev);
/* Discard the unwind protect for recovering the
}
}
- if (NILP (val))
+ if (NILP (coding_system))
{
/* If we have not yet decided a coding system, check
file-coding-system-alist. */
- Lisp_Object args[6], coding_systems;
+ Lisp_Object args[6];
args[0] = Qinsert_file_contents, args[1] = orig_filename;
args[2] = visit, args[3] = beg, args[4] = end, args[5] = replace;
- coding_systems = Ffind_operation_coding_system (6, args);
- if (CONSP (coding_systems))
- val = XCAR (coding_systems);
+ coding_system = Ffind_operation_coding_system (6, args);
+ if (CONSP (coding_system))
+ coding_system = XCAR (coding_system);
}
}
- setup_coding_system (Fcheck_coding_system (val), &coding);
- /* Ensure we set Vlast_coding_system_used. */
- set_coding_system = 1;
+ if (NILP (coding_system))
+ coding_system = Qundecided;
+ else
+ CHECK_CODING_SYSTEM (coding_system);
- if (NILP (current_buffer->enable_multibyte_characters)
- && ! NILP (val))
+ if (NILP (current_buffer->enable_multibyte_characters))
/* We must suppress all character code conversion except for
end-of-line conversion. */
- setup_raw_text_coding_system (&coding);
+ coding_system = raw_text_coding_system (coding_system);
- coding.src_multibyte = 0;
- coding.dst_multibyte
- = !NILP (current_buffer->enable_multibyte_characters);
- coding_system_decided = 1;
+ setup_coding_system (coding_system, &coding);
+ /* Ensure we set Vlast_coding_system_used. */
+ set_coding_system = 1;
}
/* If requested, replace the accessible part of the buffer
and let the following if-statement handle the replace job. */
if (!NILP (replace)
&& BEGV < ZV
- && !(coding.common_flags & CODING_REQUIRE_DECODING_MASK))
+ && (NILP (coding_system)
+ || ! CODING_REQUIRE_DECODING (&coding)))
{
/* same_at_start and same_at_end count bytes,
because file access counts bytes
else if (nread == 0)
break;
- if (coding.type == coding_type_undecided)
- detect_coding (&coding, buffer, nread);
- if (coding.common_flags & CODING_REQUIRE_DECODING_MASK)
- /* We found that the file should be decoded somehow.
- Let's give up here. */
+ if (CODING_REQUIRE_DETECTION (&coding))
{
- giveup_match_end = 1;
- break;
+ coding_system = detect_coding_system (buffer, nread, nread, 1, 0,
+ coding_system);
+ setup_coding_system (coding_system, &coding);
}
- if (coding.eol_type == CODING_EOL_UNDECIDED)
- detect_eol (&coding, buffer, nread);
- if (coding.eol_type != CODING_EOL_UNDECIDED
- && coding.eol_type != CODING_EOL_LF)
- /* We found that the format of eol should be decoded.
+ if (CODING_REQUIRE_DECODING (&coding))
+ /* We found that the file should be decoded somehow.
Let's give up here. */
{
giveup_match_end = 1;
{
int same_at_start = BEGV_BYTE;
int same_at_end = ZV_BYTE;
+ int same_at_start_charpos;
+ int inserted_chars;
int overlap;
int bufpos;
- /* Make sure that the gap is large enough. */
- int bufsize = 2 * st.st_size;
- unsigned char *conversion_buffer = (unsigned char *) xmalloc (bufsize);
+ unsigned char *decoded;
int temp;
+ int this_count = SPECPDL_INDEX ();
+ int multibyte = ! NILP (current_buffer->enable_multibyte_characters);
+ Lisp_Object conversion_buffer;
+
+ conversion_buffer = code_conversion_save (1, multibyte);
/* First read the whole file, performing code conversion into
CONVERSION_BUFFER. */
if (lseek (fd, XINT (beg), 0) < 0)
- {
- xfree (conversion_buffer);
- report_file_error ("Setting file position",
- Fcons (orig_filename, Qnil));
- }
+ report_file_error ("Setting file position",
+ Fcons (orig_filename, Qnil));
total = st.st_size; /* Total bytes in the file. */
how_much = 0; /* Bytes read from file so far. */
inserted = 0; /* Bytes put into CONVERSION_BUFFER so far. */
unprocessed = 0; /* Bytes not processed in previous loop. */
+ GCPRO1 (conversion_buffer);
while (how_much < total)
{
+ /* We read one bunch by one (READ_BUF_SIZE bytes) to allow
+ quitting while reading a huge while. */
/* try is reserved in some compilers (Microsoft C) */
int trytry = min (total - how_much, READ_BUF_SIZE - unprocessed);
- unsigned char *destination = read_buf + unprocessed;
int this;
/* Allow quitting out of the actual I/O. */
immediate_quit = 1;
QUIT;
- this = emacs_read (fd, destination, trytry);
+ this = emacs_read (fd, read_buf + unprocessed, trytry);
immediate_quit = 0;
- if (this < 0 || this + unprocessed == 0)
+ if (this <= 0)
{
- how_much = this;
+ if (this < 0)
+ how_much = this;
break;
}
how_much += this;
- if (CODING_MAY_REQUIRE_DECODING (&coding))
- {
- int require, result;
-
- this += unprocessed;
-
- /* If we are using more space than estimated,
- make CONVERSION_BUFFER bigger. */
- require = decoding_buffer_size (&coding, this);
- if (inserted + require + 2 * (total - how_much) > bufsize)
- {
- bufsize = inserted + require + 2 * (total - how_much);
- conversion_buffer = (unsigned char *) xrealloc (conversion_buffer, bufsize);
- }
-
- /* Convert this batch with results in CONVERSION_BUFFER. */
- if (how_much >= total) /* This is the last block. */
- coding.mode |= CODING_MODE_LAST_BLOCK;
- if (coding.composing != COMPOSITION_DISABLED)
- coding_allocate_composition_data (&coding, BEGV);
- result = decode_coding (&coding, read_buf,
- conversion_buffer + inserted,
- this, bufsize - inserted);
-
- /* Save for next iteration whatever we didn't convert. */
- unprocessed = this - coding.consumed;
- bcopy (read_buf + coding.consumed, read_buf, unprocessed);
- if (!NILP (current_buffer->enable_multibyte_characters))
- this = coding.produced;
- else
- this = str_as_unibyte (conversion_buffer + inserted,
- coding.produced);
- }
-
- inserted += this;
+ BUF_SET_PT (XBUFFER (conversion_buffer),
+ BUF_Z (XBUFFER (conversion_buffer)));
+ decode_coding_c_string (&coding, read_buf, unprocessed + this,
+ conversion_buffer);
+ unprocessed = coding.carryover_bytes;
+ if (coding.carryover_bytes > 0)
+ bcopy (coding.carryover, read_buf, unprocessed);
}
+ UNGCPRO;
+ emacs_close (fd);
- /* At this point, INSERTED is how many characters (i.e. bytes)
- are present in CONVERSION_BUFFER.
- HOW_MUCH should equal TOTAL,
- or should be <= 0 if we couldn't read the file. */
+ /* At this point, HOW_MUCH should equal TOTAL, or should be <= 0
+ if we couldn't read the file. */
if (how_much < 0)
+ error ("IO error reading %s: %s",
+ SDATA (orig_filename), emacs_strerror (errno));
+
+ if (unprocessed > 0)
{
- xfree (conversion_buffer);
- coding_free_composition_data (&coding);
- error ("IO error reading %s: %s",
- SDATA (orig_filename), emacs_strerror (errno));
+ coding.mode |= CODING_MODE_LAST_BLOCK;
+ decode_coding_c_string (&coding, read_buf, unprocessed,
+ conversion_buffer);
+ coding.mode &= ~CODING_MODE_LAST_BLOCK;
}
- /* Compare the beginning of the converted file
- with the buffer text. */
+ decoded = BUF_BEG_ADDR (XBUFFER (conversion_buffer));
+ inserted = (BUF_Z_BYTE (XBUFFER (conversion_buffer))
+ - BUF_BEG_BYTE (XBUFFER (conversion_buffer)));
+
+ /* Compare the beginning of the converted string with the buffer
+ text. */
bufpos = 0;
while (bufpos < inserted && same_at_start < same_at_end
- && FETCH_BYTE (same_at_start) == conversion_buffer[bufpos])
+ && FETCH_BYTE (same_at_start) == decoded[bufpos])
same_at_start++, bufpos++;
- /* If the file matches the buffer completely,
+ /* If the file matches the head of buffer completely,
there's no need to replace anything. */
if (bufpos == inserted)
{
- xfree (conversion_buffer);
- coding_free_composition_data (&coding);
- emacs_close (fd);
specpdl_ptr--;
/* Truncate the buffer to the size of the file. */
del_range_byte (same_at_start, same_at_end, 0);
inserted = 0;
+
+ unbind_to (this_count, Qnil);
goto handled;
}
- /* Extend the start of non-matching text area to multibyte
- character boundary. */
+ /* Extend the start of non-matching text area to the previous
+ multibyte character boundary. */
if (! NILP (current_buffer->enable_multibyte_characters))
while (same_at_start > BEGV_BYTE
&& ! CHAR_HEAD_P (FETCH_BYTE (same_at_start)))
/* Compare with same_at_start to avoid counting some buffer text
as matching both at the file's beginning and at the end. */
while (bufpos > 0 && same_at_end > same_at_start
- && FETCH_BYTE (same_at_end - 1) == conversion_buffer[bufpos - 1])
+ && FETCH_BYTE (same_at_end - 1) == decoded[bufpos - 1])
same_at_end--, bufpos--;
- /* Extend the end of non-matching text area to multibyte
- character boundary. */
+ /* Extend the end of non-matching text area to the next
+ multibyte character boundary. */
if (! NILP (current_buffer->enable_multibyte_characters))
while (same_at_end < ZV_BYTE
&& ! CHAR_HEAD_P (FETCH_BYTE (same_at_end)))
/* Replace the chars that we need to replace,
and update INSERTED to equal the number of bytes
- we are taking from the file. */
+ we are taking from the decoded string. */
inserted -= (ZV_BYTE - same_at_end) + (same_at_start - BEGV_BYTE);
if (same_at_end != same_at_start)
}
/* Insert from the file at the proper position. */
SET_PT_BOTH (temp, same_at_start);
- insert_1 (conversion_buffer + same_at_start - BEGV_BYTE, inserted,
- 0, 0, 0);
- if (coding.cmp_data && coding.cmp_data->used)
- coding_restore_composition (&coding, Fcurrent_buffer ());
- coding_free_composition_data (&coding);
-
+ same_at_start_charpos
+ = buf_bytepos_to_charpos (XBUFFER (conversion_buffer),
+ same_at_start);
+ inserted_chars
+ = (buf_bytepos_to_charpos (XBUFFER (conversion_buffer),
+ same_at_start + inserted)
+ - same_at_start_charpos);
+ /* This binding is to avoid ask-user-about-supersession-threat
+ being called in insert_from_buffer (via in
+ prepare_to_modify_buffer). */
+ specbind (intern ("buffer-file-name"), Qnil);
+ insert_from_buffer (XBUFFER (conversion_buffer),
+ same_at_start_charpos, inserted_chars, 0);
/* Set `inserted' to the number of inserted characters. */
inserted = PT - temp;
/* Set point before the inserted characters. */
SET_PT_BOTH (temp, same_at_start);
- xfree (conversion_buffer);
- emacs_close (fd);
- specpdl_ptr--;
+ unbind_to (this_count, Qnil);
goto handled;
}
inserted = 0;
/* Here, we don't do code conversion in the loop. It is done by
- code_convert_region after all data are read into the buffer. */
+ decode_coding_gap after all data are read into the buffer. */
{
int gap_size = GAP_SIZE;
notfound:
- if (! coding_system_decided)
+ if (NILP (coding_system))
{
/* The coding system is not yet decided. Decide it by an
optimized method for handling `coding:' tag.
Note that we can get here only if the buffer was empty
before the insertion. */
- Lisp_Object val;
- val = Qnil;
if (!NILP (Vcoding_system_for_read))
- val = Vcoding_system_for_read;
+ coding_system = Vcoding_system_for_read;
else
{
/* Since we are sure that the current buffer was empty
before the insertion, we can toggle
enable-multibyte-characters directly here without taking
- care of marker adjustment and byte combining problem. By
- this way, we can run Lisp program safely before decoding
- the inserted text. */
+ care of marker adjustment. By this way, we can run Lisp
+ program safely before decoding the inserted text. */
Lisp_Object unwind_data;
int count = SPECPDL_INDEX ();
if (inserted > 0 && ! NILP (Vset_auto_coding_function))
{
- val = call2 (Vset_auto_coding_function,
- filename, make_number (inserted));
+ coding_system = call2 (Vset_auto_coding_function,
+ filename, make_number (inserted));
}
- if (NILP (val))
+ if (NILP (coding_system))
{
/* If the coding system is not yet decided, check
file-coding-system-alist. */
- Lisp_Object args[6], coding_systems;
+ Lisp_Object args[6];
args[0] = Qinsert_file_contents, args[1] = orig_filename;
args[2] = visit, args[3] = beg, args[4] = end, args[5] = Qnil;
- coding_systems = Ffind_operation_coding_system (6, args);
- if (CONSP (coding_systems))
- val = XCAR (coding_systems);
+ coding_system = Ffind_operation_coding_system (6, args);
+ if (CONSP (coding_system))
+ coding_system = XCAR (coding_system);
}
unbind_to (count, Qnil);
inserted = Z_BYTE - BEG_BYTE;
}
- /* The following kludgy code is to avoid some compiler bug.
- We can't simply do
- setup_coding_system (val, &coding);
- on some system. */
- {
- struct coding_system temp_coding;
- setup_coding_system (Fcheck_coding_system (val), &temp_coding);
- bcopy (&temp_coding, &coding, sizeof coding);
- }
- /* Ensure we set Vlast_coding_system_used. */
- set_coding_system = 1;
+ if (NILP (coding_system))
+ coding_system = Qundecided;
+ else
+ CHECK_CODING_SYSTEM (coding_system);
- if (NILP (current_buffer->enable_multibyte_characters)
- && ! NILP (val))
+ if (NILP (current_buffer->enable_multibyte_characters))
/* We must suppress all character code conversion except for
end-of-line conversion. */
- setup_raw_text_coding_system (&coding);
- coding.src_multibyte = 0;
- coding.dst_multibyte
- = !NILP (current_buffer->enable_multibyte_characters);
+ coding_system = raw_text_coding_system (coding_system);
+ setup_coding_system (coding_system, &coding);
+ /* Ensure we set Vlast_coding_system_used. */
+ set_coding_system = 1;
}
- if (!NILP (visit)
- /* Can't do this if part of the buffer might be preserved. */
- && NILP (replace)
- && (coding.type == coding_type_no_conversion
- || coding.type == coding_type_raw_text))
+ if (!NILP (visit))
{
- /* Visiting a file with these coding system makes the buffer
- unibyte. */
- current_buffer->enable_multibyte_characters = Qnil;
- coding.dst_multibyte = 0;
+ /* When we visit a file by raw-text, we change the buffer to
+ unibyte. */
+ if (CODING_FOR_UNIBYTE (&coding)
+ /* Can't do this if part of the buffer might be preserved. */
+ && NILP (replace))
+ /* Visiting a file with these coding system makes the buffer
+ unibyte. */
+ current_buffer->enable_multibyte_characters = Qnil;
}
- if (inserted > 0 || coding.type == coding_type_ccl)
+ coding.dst_multibyte = ! NILP (current_buffer->enable_multibyte_characters);
+ if (CODING_MAY_REQUIRE_DECODING (&coding)
+ && (inserted > 0 || CODING_REQUIRE_FLUSHING (&coding)))
{
- if (CODING_MAY_REQUIRE_DECODING (&coding))
- {
- code_convert_region (PT, PT_BYTE, PT + inserted, PT_BYTE + inserted,
- &coding, 0, 0);
- inserted = coding.produced_char;
- }
- else
- adjust_after_insert (PT, PT_BYTE, PT + inserted, PT_BYTE + inserted,
- inserted);
+ move_gap_both (PT, PT_BYTE);
+ GAP_SIZE += inserted;
+ ZV_BYTE -= inserted;
+ Z_BYTE -= inserted;
+ ZV -= inserted;
+ Z -= inserted;
+ decode_coding_gap (&coding, inserted, inserted);
+ inserted = coding.produced_char;
+ coding_system = CODING_ID_NAME (coding.id);
}
+ else if (inserted > 0)
+ adjust_after_insert (PT, PT_BYTE, PT + inserted, PT_BYTE + inserted,
+ inserted);
/* Now INSERTED is measured in characters. */
/* Use the conversion type to determine buffer-file-type
(find-buffer-file-type is now used to help determine the
conversion). */
- if ((coding.eol_type == CODING_EOL_UNDECIDED
- || coding.eol_type == CODING_EOL_LF)
+ if ((VECTORP (CODING_ID_EOL_TYPE (coding.id))
+ || EQ (CODING_ID_EOL_TYPE (coding.id), Qunix))
&& ! CODING_REQUIRE_DECODING (&coding))
current_buffer->buffer_file_type = Qt;
else
}
if (set_coding_system)
- Vlast_coding_system_used = coding.symbol;
+ Vlast_coding_system_used = coding_system;
if (! NILP (Ffboundp (Qafter_insert_file_set_coding)))
{
}
\f
static Lisp_Object build_annotations P_ ((Lisp_Object, Lisp_Object));
-static Lisp_Object build_annotations_2 P_ ((Lisp_Object, Lisp_Object,
- Lisp_Object, Lisp_Object));
/* If build_annotations switched buffers, switch back to BUF.
Kill the temporary buffer that was selected in the meantime.
/* Decide the coding-system to encode the data with. */
-void
+static Lisp_Object
choose_write_coding_system (start, end, filename,
append, visit, lockname, coding)
Lisp_Object start, end, filename, append, visit, lockname;
struct coding_system *coding;
{
Lisp_Object val;
+ Lisp_Object eol_parent = Qnil;
if (auto_saving
&& NILP (Fstring_equal (current_buffer->filename,
current_buffer->auto_save_file_name)))
{
- /* We use emacs-mule for auto saving... */
- setup_coding_system (Qemacs_mule, coding);
- /* ... but with the special flag to indicate not to strip off
- leading code of eight-bit-control chars. */
- coding->flags = 1;
- /* We force LF for end-of-line because that is faster. */
- coding->eol_type = CODING_EOL_LF;
- goto done_setup_coding;
+ val = Qutf_8_emacs;
+ eol_parent = Qunix;
}
else if (!NILP (Vcoding_system_for_write))
{
val = XCDR (coding_systems);
}
- if (NILP (val)
- && !NILP (current_buffer->buffer_file_coding_system))
+ if (NILP (val))
{
/* If we still have not decided a coding system, use the
default value of buffer-file-coding-system. */
using_default_coding = 1;
}
+ if (! NILP (val) && ! force_raw_text)
+ {
+ Lisp_Object spec, attrs;
+
+ CHECK_CODING_SYSTEM_GET_SPEC (val, spec);
+ attrs = AREF (spec, 0);
+ if (EQ (CODING_ATTR_TYPE (attrs), Qraw_text))
+ force_raw_text = 1;
+ }
+
if (!force_raw_text
&& !NILP (Ffboundp (Vselect_safe_coding_system_function)))
/* Confirm that VAL can surely encode the current region. */
val = call5 (Vselect_safe_coding_system_function,
start, end, val, Qnil, filename);
- setup_coding_system (Fcheck_coding_system (val), coding);
- if (coding->eol_type == CODING_EOL_UNDECIDED
- && !using_default_coding)
- {
- if (! EQ (default_buffer_file_coding.symbol,
- buffer_defaults.buffer_file_coding_system))
- setup_coding_system (buffer_defaults.buffer_file_coding_system,
- &default_buffer_file_coding);
- if (default_buffer_file_coding.eol_type != CODING_EOL_UNDECIDED)
- {
- Lisp_Object subsidiaries;
-
- coding->eol_type = default_buffer_file_coding.eol_type;
- subsidiaries = Fget (coding->symbol, Qeol_type);
- if (VECTORP (subsidiaries)
- && XVECTOR (subsidiaries)->size == 3)
- coding->symbol
- = XVECTOR (subsidiaries)->contents[coding->eol_type];
- }
- }
+ /* If the decided coding-system doesn't specify end-of-line
+ format, we use that of
+ `default-buffer-file-coding-system'. */
+ if (! using_default_coding
+ && ! NILP (buffer_defaults.buffer_file_coding_system))
+ val = (coding_inherit_eol_type
+ (val, buffer_defaults.buffer_file_coding_system));
+ /* If we decide not to encode text, use `raw-text' or one of its
+ subsidiaries. */
if (force_raw_text)
- setup_raw_text_coding_system (coding);
- goto done_setup_coding;
+ val = raw_text_coding_system (val);
}
- setup_coding_system (Fcheck_coding_system (val), coding);
+ val = coding_inherit_eol_type (val, eol_parent);
+ setup_coding_system (val, coding);
- done_setup_coding:
- if (coding->eol_type == CODING_EOL_UNDECIDED)
- coding->eol_type = system_eol_type;
if (!STRINGP (start) && !NILP (current_buffer->selective_display))
coding->mode |= CODING_MODE_SELECTIVE_DISPLAY;
+ return val;
}
DEFUN ("write-region", Fwrite_region, Swrite_region, 3, 7,
int save_errno = 0;
const unsigned char *fn;
struct stat st;
- int tem;
int count = SPECPDL_INDEX ();
int count1;
#ifdef VMS
We used to make this choice before calling build_annotations, but that
leads to problems when a write-annotate-function takes care of
unsavable chars (as was the case with X-Symbol). */
- choose_write_coding_system (start, end, filename,
- append, visit, lockname, &coding);
- Vlast_coding_system_used = coding.symbol;
-
- given_buffer = current_buffer;
- if (! STRINGP (start))
- {
- annotations = build_annotations_2 (start, end,
- coding.pre_write_conversion, annotations);
- if (current_buffer != given_buffer)
- {
- XSETFASTINT (start, BEGV);
- XSETFASTINT (end, ZV);
- }
- }
+ Vlast_coding_system_used
+ = choose_write_coding_system (start, end, filename,
+ append, visit, lockname, &coding);
#ifdef CLASH_DETECTION
if (!auto_saving)
if (GPT > BEG && GPT_ADDR[-1] != '\n')
move_gap (find_next_newline (GPT, 1));
#else
+#if 0
+ /* The new encoding routine doesn't require the following. */
+
/* Whether VMS or not, we must move the gap to the next of newline
when we must put designation sequences at beginning of line. */
if (INTEGERP (start)
move_gap_both (PT, PT_BYTE);
SET_PT_BOTH (opoint, opoint_byte);
}
+#endif
#endif
failure = 0;
}
else if (XINT (start) != XINT (end))
{
- tem = CHAR_TO_BYTE (XINT (start));
-
- if (XINT (start) < GPT)
- {
- failure = 0 > a_write (desc, Qnil, XINT (start),
- min (GPT, XINT (end)) - XINT (start),
- &annotations, &coding);
- save_errno = errno;
- }
-
- if (XINT (end) > GPT && !failure)
- {
- tem = max (XINT (start), GPT);
- failure = 0 > a_write (desc, Qnil, tem , XINT (end) - tem,
- &annotations, &coding);
- save_errno = errno;
- }
+ failure = 0 > a_write (desc, Qnil,
+ XINT (start), XINT (end) - XINT (start),
+ &annotations, &coding);
+ save_errno = errno;
}
else
{
{
/* We have to flush out a data. */
coding.mode |= CODING_MODE_LAST_BLOCK;
- failure = 0 > e_write (desc, Qnil, 0, 0, &coding);
+ failure = 0 > e_write (desc, Qnil, 1, 1, &coding);
save_errno = errno;
}
return annotations;
}
-static Lisp_Object
-build_annotations_2 (start, end, pre_write_conversion, annotations)
- Lisp_Object start, end, pre_write_conversion, annotations;
-{
- struct gcpro gcpro1;
- Lisp_Object res;
-
- GCPRO1 (annotations);
- /* At last, do the same for the function PRE_WRITE_CONVERSION
- implied by the current coding-system. */
- if (!NILP (pre_write_conversion))
- {
- struct buffer *given_buffer = current_buffer;
- Vwrite_region_annotations_so_far = annotations;
- res = call2 (pre_write_conversion, start, end);
- Flength (res);
- annotations = (current_buffer != given_buffer
- ? res
- : merge (annotations, res, Qcar_less_than_car));
- }
-
- UNGCPRO;
- return annotations;
-}
\f
/* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
If STRING is nil, POS is the character position in the current buffer.
return 0;
}
-#ifndef WRITE_BUF_SIZE
-#define WRITE_BUF_SIZE (16 * 1024)
-#endif
/* Write text in the range START and END into descriptor DESC,
encoding them with coding system CODING. If STRING is nil, START
int start, end;
struct coding_system *coding;
{
- register char *addr;
- register int nbytes;
- char buf[WRITE_BUF_SIZE];
- int return_val = 0;
-
- if (start >= end)
- coding->composing = COMPOSITION_DISABLED;
- if (coding->composing != COMPOSITION_DISABLED)
- coding_save_composition (coding, start, end, string);
-
if (STRINGP (string))
{
- addr = SDATA (string);
- nbytes = SBYTES (string);
- coding->src_multibyte = STRING_MULTIBYTE (string);
- }
- else if (start < end)
- {
- /* It is assured that the gap is not in the range START and END-1. */
- addr = CHAR_POS_ADDR (start);
- nbytes = CHAR_TO_BYTE (end) - CHAR_TO_BYTE (start);
- coding->src_multibyte
- = !NILP (current_buffer->enable_multibyte_characters);
- }
- else
- {
- addr = "";
- nbytes = 0;
- coding->src_multibyte = 1;
+ start = 0;
+ end = SCHARS (string);
}
/* We used to have a code for handling selective display here. But,
now it is handled within encode_coding. */
- while (1)
- {
- int result;
- result = encode_coding (coding, addr, buf, nbytes, WRITE_BUF_SIZE);
- if (coding->produced > 0)
+ while (start < end)
+ {
+ if (STRINGP (string))
{
- coding->produced -= emacs_write (desc, buf, coding->produced);
- if (coding->produced)
+ coding->src_multibyte = SCHARS (string) < SBYTES (string);
+ if (CODING_REQUIRE_ENCODING (coding))
{
- return_val = -1;
- break;
+ encode_coding_object (coding, string,
+ start, string_char_to_byte (string, start),
+ end, string_char_to_byte (string, end), Qt);
+ }
+ else
+ {
+ coding->dst_object = string;
+ coding->consumed_char = SCHARS (string);
+ coding->produced = SBYTES (string);
}
}
- nbytes -= coding->consumed;
- addr += coding->consumed;
- if (result == CODING_FINISH_INSUFFICIENT_SRC
- && nbytes > 0)
+ else
{
- /* The source text ends by an incomplete multibyte form.
- There's no way other than write it out as is. */
- nbytes -= emacs_write (desc, addr, nbytes);
- if (nbytes)
+ int start_byte = CHAR_TO_BYTE (start);
+ int end_byte = CHAR_TO_BYTE (end);
+
+ coding->src_multibyte = (end - start) < (end_byte - start_byte);
+ if (CODING_REQUIRE_ENCODING (coding))
{
- return_val = -1;
- break;
+ encode_coding_object (coding, Fcurrent_buffer (),
+ start, start_byte, end, end_byte, Qt);
+ }
+ else
+ {
+ coding->dst_object = Qnil;
+ coding->dst_pos_byte = start_byte;
+ if (start >= GPT || end <= GPT)
+ {
+ coding->consumed_char = end - start;
+ coding->produced = end_byte - start_byte;
+ }
+ else
+ {
+ coding->consumed_char = GPT - start;
+ coding->produced = GPT_BYTE - start_byte;
+ }
}
}
- if (nbytes <= 0)
- break;
+
+ if (coding->produced > 0)
+ {
+ coding->produced -=
+ emacs_write (desc,
+ STRINGP (coding->dst_object)
+ ? SDATA (coding->dst_object)
+ : BYTE_POS_ADDR (coding->dst_pos_byte),
+ coding->produced);
+
+ if (coding->produced)
+ return -1;
+ }
start += coding->consumed_char;
- if (coding->cmp_data)
- coding_adjust_composition_offset (coding, start);
}
- if (coding->cmp_data)
- coding_free_composition_data (coding);
-
- return return_val;
+ return 0;
}
\f
DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime,
couldn't handle some ange-ftp'd file. */
for (do_handled_files = 0; do_handled_files < 2; do_handled_files++)
- for (tail = Vbuffer_alist; GC_CONSP (tail); tail = XCDR (tail))
+ for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail))
{
buf = XCDR (XCAR (tail));
b = XBUFFER (buf);
{
Lisp_Object tem = XCAR (all);
int len;
- if (STRINGP (tem)
- && (len = SBYTES (tem), len > 0)
- && IS_DIRECTORY_SEP (SREF (tem, len-1)))
+ if (STRINGP (tem) &&
+ (len = SBYTES (tem), len > 0) &&
+ IS_DIRECTORY_SEP (SREF (tem, len-1)))
comp = Fcons (tem, comp);
}
}
/* Lock files for editing.
Copyright (C) 1985, 1986, 1987, 1993, 1994, 1996, 1998, 1999, 2000, 2001,
- 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ 2002, 2003, 2004, 2005, 2006, 2007, 2008
+ Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include "lisp.h"
#include "buffer.h"
-#include "charset.h"
+#include "character.h"
#include "coding.h"
#include "systime.h"
register Lisp_Object tail;
register struct buffer *b;
- for (tail = Vbuffer_alist; GC_CONSP (tail); tail = XCDR (tail))
+ for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail))
{
b = XBUFFER (XCDR (XCAR (tail)));
if (STRINGP (b->file_truename) && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b))
/* Random utility Lisp functions.
Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1997,
1998, 1999, 2000, 2001, 2002, 2003, 2004,
- 2005, 2006, 2007 Free Software Foundation, Inc.
+ 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include "lisp.h"
#include "commands.h"
-#include "charset.h"
+#include "character.h"
#include "coding.h"
#include "buffer.h"
#include "keyboard.h"
XSETFASTINT (val, SCHARS (sequence));
else if (VECTORP (sequence))
XSETFASTINT (val, ASIZE (sequence));
- else if (SUB_CHAR_TABLE_P (sequence))
- XSETFASTINT (val, SUB_CHAR_TABLE_ORDINARY_SLOTS);
else if (CHAR_TABLE_P (sequence))
XSETFASTINT (val, MAX_CHAR);
else if (BOOL_VECTOR_P (sequence))
DEFUN ("string-bytes", Fstring_bytes, Sstring_bytes, 1, 1, 0,
doc: /* Return the number of bytes in STRING.
-If STRING is a multibyte string, this is greater than the length of STRING. */)
+If STRING is multibyte, this may be greater than the length of STRING. */)
(string)
Lisp_Object string;
{
return concat (nargs, args, Lisp_Vectorlike, 0);
}
-/* Return a copy of a sub char table ARG. The elements except for a
- nested sub char table are not copied. */
-static Lisp_Object
-copy_sub_char_table (arg)
- Lisp_Object arg;
-{
- Lisp_Object copy = make_sub_char_table (Qnil);
- int i;
-
- XCHAR_TABLE (copy)->defalt = XCHAR_TABLE (arg)->defalt;
- /* Copy all the contents. */
- bcopy (XCHAR_TABLE (arg)->contents, XCHAR_TABLE (copy)->contents,
- SUB_CHAR_TABLE_ORDINARY_SLOTS * sizeof (Lisp_Object));
- /* Recursively copy any sub char-tables in the ordinary slots. */
- for (i = 32; i < SUB_CHAR_TABLE_ORDINARY_SLOTS; i++)
- if (SUB_CHAR_TABLE_P (XCHAR_TABLE (arg)->contents[i]))
- XCHAR_TABLE (copy)->contents[i]
- = copy_sub_char_table (XCHAR_TABLE (copy)->contents[i]);
-
- return copy;
-}
-
DEFUN ("copy-sequence", Fcopy_sequence, Scopy_sequence, 1, 1, 0,
doc: /* Return a copy of a list, vector, string or char-table.
if (CHAR_TABLE_P (arg))
{
- int i;
- Lisp_Object copy;
-
- copy = Fmake_char_table (XCHAR_TABLE (arg)->purpose, Qnil);
- /* Copy all the slots, including the extra ones. */
- bcopy (XVECTOR (arg)->contents, XVECTOR (copy)->contents,
- ((XCHAR_TABLE (arg)->size & PSEUDOVECTOR_SIZE_MASK)
- * sizeof (Lisp_Object)));
-
- /* Recursively copy any sub char tables in the ordinary slots
- for multibyte characters. */
- for (i = CHAR_TABLE_SINGLE_BYTE_SLOTS;
- i < CHAR_TABLE_ORDINARY_SLOTS; i++)
- if (SUB_CHAR_TABLE_P (XCHAR_TABLE (arg)->contents[i]))
- XCHAR_TABLE (copy)->contents[i]
- = copy_sub_char_table (XCHAR_TABLE (copy)->contents[i]);
-
- return copy;
+ return copy_char_table (arg);
}
if (BOOL_VECTOR_P (arg))
for (i = 0; i < len; i++)
{
ch = AREF (this, i);
- CHECK_NUMBER (ch);
+ CHECK_CHARACTER (ch);
this_len_byte = CHAR_BYTES (XINT (ch));
result_len_byte += this_len_byte;
- if (!SINGLE_BYTE_CHAR_P (XINT (ch)))
+ if (! ASCII_CHAR_P (XINT (ch)) && ! CHAR_BYTE8_P (XINT (ch)))
some_multibyte = 1;
}
else if (BOOL_VECTOR_P (this) && XBOOL_VECTOR (this)->size > 0)
for (; CONSP (this); this = XCDR (this))
{
ch = XCAR (this);
- CHECK_NUMBER (ch);
+ CHECK_CHARACTER (ch);
this_len_byte = CHAR_BYTES (XINT (ch));
result_len_byte += this_len_byte;
- if (!SINGLE_BYTE_CHAR_P (XINT (ch)))
+ if (! ASCII_CHAR_P (XINT (ch)) && ! CHAR_BYTE8_P (XINT (ch)))
some_multibyte = 1;
}
else if (STRINGP (this))
{
XSETFASTINT (elt, SREF (this, thisindex)); thisindex++;
if (some_multibyte
- && (XINT (elt) >= 0240
- || (XINT (elt) >= 0200
- && ! NILP (Vnonascii_translation_table)))
+ && XINT (elt) >= 0200
&& XINT (elt) < 0400)
{
c = unibyte_char_to_multibyte (XINT (elt));
else
{
CHECK_NUMBER (elt);
- if (SINGLE_BYTE_CHAR_P (XINT (elt)))
- {
- if (some_multibyte)
- toindex_byte
- += CHAR_STRING (XINT (elt),
- SDATA (val) + toindex_byte);
- else
- SSET (val, toindex_byte++, XINT (elt));
- toindex++;
- }
+ if (some_multibyte)
+ toindex_byte += CHAR_STRING (XINT (elt),
+ SDATA (val) + toindex_byte);
else
- /* If we have any multibyte characters,
- we already decided to make a multibyte string. */
- {
- int c = XINT (elt);
- /* P exists as a variable
- to avoid a bug on the Masscomp C compiler. */
- unsigned char *p = SDATA (val) + toindex_byte;
-
- toindex_byte += CHAR_STRING (c, p);
- toindex++;
- }
+ SSET (val, toindex_byte++, XINT (elt));
+ toindex++;
}
}
}
Lisp_Object string;
int char_index;
{
- int i, i_byte;
+ int i_byte;
int best_below, best_below_byte;
int best_above, best_above_byte;
if (char_index - best_below < best_above - char_index)
{
+ unsigned char *p = SDATA (string) + best_below_byte;
+
while (best_below < char_index)
{
- int c;
- FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, string,
- best_below, best_below_byte);
+ p += BYTES_BY_CHAR_HEAD (*p);
+ best_below++;
}
- i = best_below;
- i_byte = best_below_byte;
+ i_byte = p - SDATA (string);
}
else
{
+ unsigned char *p = SDATA (string) + best_above_byte;
+
while (best_above > char_index)
{
- unsigned char *pend = SDATA (string) + best_above_byte;
- unsigned char *pbeg = pend - best_above_byte;
- unsigned char *p = pend - 1;
- int bytes;
-
- while (p > pbeg && !CHAR_HEAD_P (*p)) p--;
- PARSE_MULTIBYTE_SEQ (p, pend - p, bytes);
- if (bytes == pend - p)
- best_above_byte -= bytes;
- else if (bytes > pend - p)
- best_above_byte -= (pend - p);
- else
- best_above_byte--;
+ p--;
+ while (!CHAR_HEAD_P (*p)) p--;
best_above--;
}
- i = best_above;
- i_byte = best_above_byte;
+ i_byte = p - SDATA (string);
}
string_char_byte_cache_bytepos = i_byte;
- string_char_byte_cache_charpos = i;
+ string_char_byte_cache_charpos = char_index;
string_char_byte_cache_string = string;
return i_byte;
if (byte_index - best_below_byte < best_above_byte - byte_index)
{
- while (best_below_byte < byte_index)
+ unsigned char *p = SDATA (string) + best_below_byte;
+ unsigned char *pend = SDATA (string) + byte_index;
+
+ while (p < pend)
{
- int c;
- FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, string,
- best_below, best_below_byte);
+ p += BYTES_BY_CHAR_HEAD (*p);
+ best_below++;
}
i = best_below;
- i_byte = best_below_byte;
+ i_byte = p - SDATA (string);
}
else
{
- while (best_above_byte > byte_index)
+ unsigned char *p = SDATA (string) + best_above_byte;
+ unsigned char *pbeg = SDATA (string) + byte_index;
+
+ while (p > pbeg)
{
- unsigned char *pend = SDATA (string) + best_above_byte;
- unsigned char *pbeg = pend - best_above_byte;
- unsigned char *p = pend - 1;
- int bytes;
-
- while (p > pbeg && !CHAR_HEAD_P (*p)) p--;
- PARSE_MULTIBYTE_SEQ (p, pend - p, bytes);
- if (bytes == pend - p)
- best_above_byte -= bytes;
- else if (bytes > pend - p)
- best_above_byte -= (pend - p);
- else
- best_above_byte--;
+ p--;
+ while (!CHAR_HEAD_P (*p)) p--;
best_above--;
}
i = best_above;
- i_byte = best_above_byte;
+ i_byte = p - SDATA (string);
}
string_char_byte_cache_bytepos = i_byte;
return i;
}
\f
-/* Convert STRING to a multibyte string.
- Single-byte characters 0240 through 0377 are converted
- by adding nonascii_insert_offset to each. */
+/* Convert STRING to a multibyte string. */
Lisp_Object
string_make_multibyte (string)
}
-/* Convert STRING to a multibyte string without changing each
- character codes. Thus, characters 0200 trough 0237 are converted
- to eight-bit-control characters, and characters 0240 through 0377
- are converted eight-bit-graphic characters. */
+/* Convert STRING (if unibyte) to a multibyte string without changing
+ the number of characters. Characters 0200 trough 0237 are
+ converted to eight-bit characters. */
Lisp_Object
string_to_multibyte (string)
return string;
nbytes = parse_str_to_multibyte (SDATA (string), SBYTES (string));
- /* If all the chars are ASCII or eight-bit-graphic, they won't need
- any more bytes once converted. */
+ /* If all the chars are ASCII, they won't need any more bytes once
+ converted. */
if (nbytes == SBYTES (string))
return make_multibyte_string (SDATA (string), nbytes, nbytes);
If STRING is unibyte, the result is STRING itself.
Otherwise it is a newly created string, with no text properties.
If STRING is multibyte and contains a character of charset
-`eight-bit-control' or `eight-bit-graphic', it is converted to the
-corresponding single byte. */)
+`eight-bit', it is converted to the corresponding single byte. */)
(string)
Lisp_Object string;
{
doc: /* Return a multibyte string with the same individual bytes as STRING.
If STRING is multibyte, the result is STRING itself.
Otherwise it is a newly created string, with no text properties.
+
If STRING is unibyte and contains an individual 8-bit byte (i.e. not
-part of a multibyte form), it is converted to the corresponding
-multibyte character of charset `eight-bit-control' or `eight-bit-graphic'.
+part of a correct utf-8 sequence), it is converted to the corresponding
+multibyte character of charset `eight-bit'.
+See also `string-to-multibyte'.
+
Beware, this often doesn't really do what you think it does.
-It is similar to (decode-coding-string STRING 'emacs-mule-unix).
+It is similar to (decode-coding-string STRING 'utf-8-emacs).
If you're not sure, whether to use `string-as-multibyte' or
-`string-to-multibyte', use `string-to-multibyte'. Beware:
- (aref (string-as-multibyte "\\201") 0) -> 129 (aka ?\\201)
- (aref (string-as-multibyte "\\300") 0) -> 192 (aka ?\\300)
- (aref (string-as-multibyte "\\300\\201") 0) -> 192 (aka ?\\300)
- (aref (string-as-multibyte "\\300\\201") 1) -> 129 (aka ?\\201)
-but
- (aref (string-as-multibyte "\\201\\300") 0) -> 2240
- (aref (string-as-multibyte "\\201\\300") 1) -> <error> */)
+`string-to-multibyte', use `string-to-multibyte'. */)
(string)
Lisp_Object string;
{
doc: /* Return a multibyte string with the same individual chars as STRING.
If STRING is multibyte, the result is STRING itself.
Otherwise it is a newly created string, with no text properties.
-Characters 0200 through 0237 are converted to eight-bit-control
-characters of the same character code. Characters 0240 through 0377
-are converted to eight-bit-graphic characters of the same character
-codes.
-This is similar to (decode-coding-string STRING 'binary) */)
+
+If STRING is unibyte and contains an 8-bit byte, it is converted to
+the corresponding multibyte character of charset `eight-bit'.
+
+This differs from `string-as-multibyte' by converting each byte of a correct
+utf-8 sequence to an eight-bit character, not just bytes that don't form a
+correct sequence. */)
(string)
Lisp_Object string;
{
return CAR (list);
}
+/* Like Fassoc but never report an error and do not allow quits.
+ Use only on lists known never to be circular. */
+
+Lisp_Object
+assoc_no_quit (key, list)
+ Lisp_Object key, list;
+{
+ while (CONSP (list)
+ && (!CONSP (XCAR (list))
+ || (!EQ (XCAR (XCAR (list)), key)
+ && NILP (Fequal (XCAR (XCAR (list)), key)))))
+ list = XCDR (list);
+
+ return CONSP (list) ? XCAR (list) : Qnil;
+}
+
DEFUN ("rassq", Frassq, Srassq, 2, 2, 0,
doc: /* Return non-nil if KEY is `eq' to the cdr of an element of LIST.
The value is actually the first element of LIST whose cdr is KEY. */)
functions are sensible to compare, so eliminate the others now. */
if (size & PSEUDOVECTOR_FLAG)
{
- if (!(size & (PVEC_COMPILED | PVEC_CHAR_TABLE)))
+ if (!(size & (PVEC_COMPILED
+ | PVEC_CHAR_TABLE | PVEC_SUB_CHAR_TABLE)))
return 0;
size &= PSEUDOVECTOR_SIZE_MASK;
}
}
else if (CHAR_TABLE_P (array))
{
- register Lisp_Object *p = XCHAR_TABLE (array)->contents;
- size = CHAR_TABLE_ORDINARY_SLOTS;
- for (index = 0; index < size; index++)
- p[index] = item;
- XCHAR_TABLE (array)->defalt = Qnil;
+ int i;
+
+ for (i = 0; i < (1 << CHARTAB_SIZE_BITS_0); i++)
+ XCHAR_TABLE (array)->contents[i] = item;
+ XCHAR_TABLE (array)->defalt = item;
}
else if (STRINGP (array))
{
STRING_SET_UNIBYTE (string);
return Qnil;
}
-\f
-DEFUN ("char-table-subtype", Fchar_table_subtype, Schar_table_subtype,
- 1, 1, 0,
- doc: /* Return the subtype of char-table CHAR-TABLE. The value is a symbol. */)
- (char_table)
- Lisp_Object char_table;
-{
- CHECK_CHAR_TABLE (char_table);
-
- return XCHAR_TABLE (char_table)->purpose;
-}
-
-DEFUN ("char-table-parent", Fchar_table_parent, Schar_table_parent,
- 1, 1, 0,
- doc: /* Return the parent char-table of CHAR-TABLE.
-The value is either nil or another char-table.
-If CHAR-TABLE holds nil for a given character,
-then the actual applicable value is inherited from the parent char-table
-\(or from its parents, if necessary). */)
- (char_table)
- Lisp_Object char_table;
-{
- CHECK_CHAR_TABLE (char_table);
-
- return XCHAR_TABLE (char_table)->parent;
-}
-
-DEFUN ("set-char-table-parent", Fset_char_table_parent, Sset_char_table_parent,
- 2, 2, 0,
- doc: /* Set the parent char-table of CHAR-TABLE to PARENT.
-Return PARENT. PARENT must be either nil or another char-table. */)
- (char_table, parent)
- Lisp_Object char_table, parent;
-{
- Lisp_Object temp;
-
- CHECK_CHAR_TABLE (char_table);
-
- if (!NILP (parent))
- {
- CHECK_CHAR_TABLE (parent);
-
- for (temp = parent; CHAR_TABLE_P (temp);
- temp = XCHAR_TABLE (temp)->parent)
- if (EQ (temp, char_table))
- error ("Attempt to make a chartable be its own parent");
- }
-
- XCHAR_TABLE (char_table)->parent = parent;
-
- return parent;
-}
-
-DEFUN ("char-table-extra-slot", Fchar_table_extra_slot, Schar_table_extra_slot,
- 2, 2, 0,
- doc: /* Return the value of CHAR-TABLE's extra-slot number N. */)
- (char_table, n)
- Lisp_Object char_table, n;
-{
- CHECK_CHAR_TABLE (char_table);
- CHECK_NUMBER (n);
- if (XINT (n) < 0
- || XINT (n) >= CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (char_table)))
- args_out_of_range (char_table, n);
-
- return XCHAR_TABLE (char_table)->extras[XINT (n)];
-}
-
-DEFUN ("set-char-table-extra-slot", Fset_char_table_extra_slot,
- Sset_char_table_extra_slot,
- 3, 3, 0,
- doc: /* Set CHAR-TABLE's extra-slot number N to VALUE. */)
- (char_table, n, value)
- Lisp_Object char_table, n, value;
-{
- CHECK_CHAR_TABLE (char_table);
- CHECK_NUMBER (n);
- if (XINT (n) < 0
- || XINT (n) >= CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (char_table)))
- args_out_of_range (char_table, n);
-
- return XCHAR_TABLE (char_table)->extras[XINT (n)] = value;
-}
-\f
-static Lisp_Object
-char_table_range (table, from, to, defalt)
- Lisp_Object table;
- int from, to;
- Lisp_Object defalt;
-{
- Lisp_Object val;
-
- if (! NILP (XCHAR_TABLE (table)->defalt))
- defalt = XCHAR_TABLE (table)->defalt;
- val = XCHAR_TABLE (table)->contents[from];
- if (SUB_CHAR_TABLE_P (val))
- val = char_table_range (val, 32, 127, defalt);
- else if (NILP (val))
- val = defalt;
- for (from++; from <= to; from++)
- {
- Lisp_Object this_val;
-
- this_val = XCHAR_TABLE (table)->contents[from];
- if (SUB_CHAR_TABLE_P (this_val))
- this_val = char_table_range (this_val, 32, 127, defalt);
- else if (NILP (this_val))
- this_val = defalt;
- if (! EQ (val, this_val))
- error ("Characters in the range have inconsistent values");
- }
- return val;
-}
-
-
-DEFUN ("char-table-range", Fchar_table_range, Schar_table_range,
- 2, 2, 0,
- doc: /* Return the value in CHAR-TABLE for a range of characters RANGE.
-RANGE should be nil (for the default value),
-a vector which identifies a character set or a row of a character set,
-a character set name, or a character code.
-If the characters in the specified range have different values,
-an error is signaled.
-
-Note that this function doesn't check the parent of CHAR-TABLE. */)
- (char_table, range)
- Lisp_Object char_table, range;
-{
- int charset_id, c1 = 0, c2 = 0;
- int size;
- Lisp_Object ch, val, current_default;
-
- CHECK_CHAR_TABLE (char_table);
-
- if (EQ (range, Qnil))
- return XCHAR_TABLE (char_table)->defalt;
- if (INTEGERP (range))
- {
- int c = XINT (range);
- if (! CHAR_VALID_P (c, 0))
- error ("Invalid character code: %d", c);
- ch = range;
- SPLIT_CHAR (c, charset_id, c1, c2);
- }
- else if (SYMBOLP (range))
- {
- Lisp_Object charset_info;
-
- charset_info = Fget (range, Qcharset);
- CHECK_VECTOR (charset_info);
- charset_id = XINT (AREF (charset_info, 0));
- ch = Fmake_char_internal (make_number (charset_id),
- make_number (0), make_number (0));
- }
- else if (VECTORP (range))
- {
- size = ASIZE (range);
- if (size == 0)
- args_out_of_range (range, make_number (0));
- CHECK_NUMBER (AREF (range, 0));
- charset_id = XINT (AREF (range, 0));
- if (size > 1)
- {
- CHECK_NUMBER (AREF (range, 1));
- c1 = XINT (AREF (range, 1));
- if (size > 2)
- {
- CHECK_NUMBER (AREF (range, 2));
- c2 = XINT (AREF (range, 2));
- }
- }
-
- /* This checks if charset_id, c0, and c1 are all valid or not. */
- ch = Fmake_char_internal (make_number (charset_id),
- make_number (c1), make_number (c2));
- }
- else
- error ("Invalid RANGE argument to `char-table-range'");
-
- if (c1 > 0 && (CHARSET_DIMENSION (charset_id) == 1 || c2 > 0))
- {
- /* Fully specified character. */
- Lisp_Object parent = XCHAR_TABLE (char_table)->parent;
-
- XCHAR_TABLE (char_table)->parent = Qnil;
- val = Faref (char_table, ch);
- XCHAR_TABLE (char_table)->parent = parent;
- return val;
- }
-
- current_default = XCHAR_TABLE (char_table)->defalt;
- if (charset_id == CHARSET_ASCII
- || charset_id == CHARSET_8_BIT_CONTROL
- || charset_id == CHARSET_8_BIT_GRAPHIC)
- {
- int from, to, defalt;
-
- if (charset_id == CHARSET_ASCII)
- from = 0, to = 127, defalt = CHAR_TABLE_DEFAULT_SLOT_ASCII;
- else if (charset_id == CHARSET_8_BIT_CONTROL)
- from = 128, to = 159, defalt = CHAR_TABLE_DEFAULT_SLOT_8_BIT_CONTROL;
- else
- from = 160, to = 255, defalt = CHAR_TABLE_DEFAULT_SLOT_8_BIT_GRAPHIC;
- if (! NILP (XCHAR_TABLE (char_table)->contents[defalt]))
- current_default = XCHAR_TABLE (char_table)->contents[defalt];
- return char_table_range (char_table, from, to, current_default);
- }
-
- val = XCHAR_TABLE (char_table)->contents[128 + charset_id];
- if (! SUB_CHAR_TABLE_P (val))
- return (NILP (val) ? current_default : val);
- if (! NILP (XCHAR_TABLE (val)->defalt))
- current_default = XCHAR_TABLE (val)->defalt;
- if (c1 == 0)
- return char_table_range (val, 32, 127, current_default);
- val = XCHAR_TABLE (val)->contents[c1];
- if (! SUB_CHAR_TABLE_P (val))
- return (NILP (val) ? current_default : val);
- if (! NILP (XCHAR_TABLE (val)->defalt))
- current_default = XCHAR_TABLE (val)->defalt;
- return char_table_range (val, 32, 127, current_default);
-}
-
-DEFUN ("set-char-table-range", Fset_char_table_range, Sset_char_table_range,
- 3, 3, 0,
- doc: /* Set the value in CHAR-TABLE for a range of characters RANGE to VALUE.
-RANGE should be t (for all characters), nil (for the default value),
-a character set, a vector which identifies a character set, a row of a
-character set, or a character code. Return VALUE. */)
- (char_table, range, value)
- Lisp_Object char_table, range, value;
-{
- int i;
-
- CHECK_CHAR_TABLE (char_table);
-
- if (EQ (range, Qt))
- for (i = 0; i < CHAR_TABLE_ORDINARY_SLOTS; i++)
- {
- /* Don't set these special slots used for default values of
- ascii, eight-bit-control, and eight-bit-graphic. */
- if (i != CHAR_TABLE_DEFAULT_SLOT_ASCII
- && i != CHAR_TABLE_DEFAULT_SLOT_8_BIT_CONTROL
- && i != CHAR_TABLE_DEFAULT_SLOT_8_BIT_GRAPHIC)
- XCHAR_TABLE (char_table)->contents[i] = value;
- }
- else if (EQ (range, Qnil))
- XCHAR_TABLE (char_table)->defalt = value;
- else if (SYMBOLP (range))
- {
- Lisp_Object charset_info;
- int charset_id;
-
- charset_info = Fget (range, Qcharset);
- if (! VECTORP (charset_info)
- || ! NATNUMP (AREF (charset_info, 0))
- || (charset_id = XINT (AREF (charset_info, 0)),
- ! CHARSET_DEFINED_P (charset_id)))
- error ("Invalid charset: %s", SDATA (SYMBOL_NAME (range)));
-
- if (charset_id == CHARSET_ASCII)
- for (i = 0; i < 128; i++)
- XCHAR_TABLE (char_table)->contents[i] = value;
- else if (charset_id == CHARSET_8_BIT_CONTROL)
- for (i = 128; i < 160; i++)
- XCHAR_TABLE (char_table)->contents[i] = value;
- else if (charset_id == CHARSET_8_BIT_GRAPHIC)
- for (i = 160; i < 256; i++)
- XCHAR_TABLE (char_table)->contents[i] = value;
- else
- XCHAR_TABLE (char_table)->contents[charset_id + 128] = value;
- }
- else if (INTEGERP (range))
- Faset (char_table, range, value);
- else if (VECTORP (range))
- {
- int size = ASIZE (range);
- Lisp_Object *val = XVECTOR (range)->contents;
- Lisp_Object ch = Fmake_char_internal (size <= 0 ? Qnil : val[0],
- size <= 1 ? Qnil : val[1],
- size <= 2 ? Qnil : val[2]);
- Faset (char_table, ch, value);
- }
- else
- error ("Invalid RANGE argument to `set-char-table-range'");
-
- return value;
-}
-
-DEFUN ("set-char-table-default", Fset_char_table_default,
- Sset_char_table_default, 3, 3, 0,
- doc: /* Set the default value in CHAR-TABLE for generic character CH to VALUE.
-The generic character specifies the group of characters.
-If CH is a normal character, set the default value for a group of
-characters to which CH belongs.
-See also the documentation of `make-char'. */)
- (char_table, ch, value)
- Lisp_Object char_table, ch, value;
-{
- int c, charset, code1, code2;
- Lisp_Object temp;
-
- CHECK_CHAR_TABLE (char_table);
- CHECK_NUMBER (ch);
-
- c = XINT (ch);
- SPLIT_CHAR (c, charset, code1, code2);
-
- /* Since we may want to set the default value for a character set
- not yet defined, we check only if the character set is in the
- valid range or not, instead of it is already defined or not. */
- if (! CHARSET_VALID_P (charset))
- invalid_character (c);
-
- if (SINGLE_BYTE_CHAR_P (c))
- {
- /* We use special slots for the default values of single byte
- characters. */
- int default_slot
- = (c < 0x80 ? CHAR_TABLE_DEFAULT_SLOT_ASCII
- : c < 0xA0 ? CHAR_TABLE_DEFAULT_SLOT_8_BIT_CONTROL
- : CHAR_TABLE_DEFAULT_SLOT_8_BIT_GRAPHIC);
-
- return (XCHAR_TABLE (char_table)->contents[default_slot] = value);
- }
-
- /* Even if C is not a generic char, we had better behave as if a
- generic char is specified. */
- if (!CHARSET_DEFINED_P (charset) || CHARSET_DIMENSION (charset) == 1)
- code1 = 0;
- temp = XCHAR_TABLE (char_table)->contents[charset + 128];
- if (! SUB_CHAR_TABLE_P (temp))
- {
- temp = make_sub_char_table (temp);
- XCHAR_TABLE (char_table)->contents[charset + 128] = temp;
- }
- if (!code1)
- {
- XCHAR_TABLE (temp)->defalt = value;
- return value;
- }
- char_table = temp;
- temp = XCHAR_TABLE (char_table)->contents[code1];
- if (SUB_CHAR_TABLE_P (temp))
- XCHAR_TABLE (temp)->defalt = value;
- else
- XCHAR_TABLE (char_table)->contents[code1] = value;
- return value;
-}
-
-/* Look up the element in TABLE at index CH,
- and return it as an integer.
- If the element is nil, return CH itself.
- (Actually we do that for any non-integer.) */
-
-int
-char_table_translate (table, ch)
- Lisp_Object table;
- int ch;
-{
- Lisp_Object value;
- value = Faref (table, make_number (ch));
- if (! INTEGERP (value))
- return ch;
- return XINT (value);
-}
-
-static void
-optimize_sub_char_table (table, chars)
- Lisp_Object *table;
- int chars;
-{
- Lisp_Object elt;
- int from, to;
-
- if (chars == 94)
- from = 33, to = 127;
- else
- from = 32, to = 128;
-
- if (!SUB_CHAR_TABLE_P (*table)
- || ! NILP (XCHAR_TABLE (*table)->defalt))
- return;
- elt = XCHAR_TABLE (*table)->contents[from++];
- for (; from < to; from++)
- if (NILP (Fequal (elt, XCHAR_TABLE (*table)->contents[from])))
- return;
- *table = elt;
-}
-
-DEFUN ("optimize-char-table", Foptimize_char_table, Soptimize_char_table,
- 1, 1, 0, doc: /* Optimize char table TABLE. */)
- (table)
- Lisp_Object table;
-{
- Lisp_Object elt;
- int dim, chars;
- int i, j;
-
- CHECK_CHAR_TABLE (table);
-
- for (i = CHAR_TABLE_SINGLE_BYTE_SLOTS; i < CHAR_TABLE_ORDINARY_SLOTS; i++)
- {
- elt = XCHAR_TABLE (table)->contents[i];
- if (!SUB_CHAR_TABLE_P (elt))
- continue;
- dim = CHARSET_DIMENSION (i - 128);
- chars = CHARSET_CHARS (i - 128);
- if (dim == 2)
- for (j = 32; j < SUB_CHAR_TABLE_ORDINARY_SLOTS; j++)
- optimize_sub_char_table (XCHAR_TABLE (elt)->contents + j, chars);
- optimize_sub_char_table (XCHAR_TABLE (table)->contents + i, chars);
- }
- return Qnil;
-}
-
-\f
-/* Map C_FUNCTION or FUNCTION over SUBTABLE, calling it for each
- character or group of characters that share a value.
- DEPTH is the current depth in the originally specified
- chartable, and INDICES contains the vector indices
- for the levels our callers have descended.
-
- ARG is passed to C_FUNCTION when that is called. */
-
-void
-map_char_table (c_function, function, table, subtable, arg, depth, indices)
- void (*c_function) P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
- Lisp_Object function, table, subtable, arg;
- int depth, *indices;
-{
- int i, to;
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
-
- GCPRO4 (arg, table, subtable, function);
-
- if (depth == 0)
- {
- /* At first, handle ASCII and 8-bit European characters. */
- for (i = 0; i < CHAR_TABLE_SINGLE_BYTE_SLOTS; i++)
- {
- Lisp_Object elt= XCHAR_TABLE (subtable)->contents[i];
- if (NILP (elt))
- elt = XCHAR_TABLE (subtable)->defalt;
- if (NILP (elt))
- elt = Faref (subtable, make_number (i));
- if (c_function)
- (*c_function) (arg, make_number (i), elt);
- else
- call2 (function, make_number (i), elt);
- }
-#if 0 /* If the char table has entries for higher characters,
- we should report them. */
- if (NILP (current_buffer->enable_multibyte_characters))
- {
- UNGCPRO;
- return;
- }
-#endif
- to = CHAR_TABLE_ORDINARY_SLOTS;
- }
- else
- {
- int charset = indices[0] - 128;
-
- i = 32;
- to = SUB_CHAR_TABLE_ORDINARY_SLOTS;
- if (CHARSET_CHARS (charset) == 94)
- i++, to--;
- }
-
- for (; i < to; i++)
- {
- Lisp_Object elt;
- int charset;
-
- elt = XCHAR_TABLE (subtable)->contents[i];
- indices[depth] = i;
- charset = indices[0] - 128;
- if (depth == 0
- && (!CHARSET_DEFINED_P (charset)
- || charset == CHARSET_8_BIT_CONTROL
- || charset == CHARSET_8_BIT_GRAPHIC))
- continue;
-
- if (SUB_CHAR_TABLE_P (elt))
- {
- if (depth >= 3)
- error ("Too deep char table");
- map_char_table (c_function, function, table, elt, arg, depth + 1, indices);
- }
- else
- {
- int c1, c2, c;
-
- c1 = depth >= 1 ? indices[1] : 0;
- c2 = depth >= 2 ? indices[2] : 0;
- c = MAKE_CHAR (charset, c1, c2);
-
- if (NILP (elt))
- elt = XCHAR_TABLE (subtable)->defalt;
- if (NILP (elt))
- elt = Faref (table, make_number (c));
-
- if (c_function)
- (*c_function) (arg, make_number (c), elt);
- else
- call2 (function, make_number (c), elt);
- }
- }
- UNGCPRO;
-}
-
-static void void_call2 P_ ((Lisp_Object a, Lisp_Object b, Lisp_Object c));
-static void
-void_call2 (a, b, c)
- Lisp_Object a, b, c;
-{
- call2 (a, b, c);
-}
-
-DEFUN ("map-char-table", Fmap_char_table, Smap_char_table,
- 2, 2, 0,
- doc: /* Call FUNCTION for each (normal and generic) characters in CHAR-TABLE.
-FUNCTION is called with two arguments--a key and a value.
-The key is always a possible IDX argument to `aref'. */)
- (function, char_table)
- Lisp_Object function, char_table;
-{
- /* The depth of char table is at most 3. */
- int indices[3];
-
- CHECK_CHAR_TABLE (char_table);
-
- /* When Lisp_Object is represented as a union, `call2' cannot directly
- be passed to map_char_table because it returns a Lisp_Object rather
- than returning nothing.
- Casting leads to crashes on some architectures. --Stef */
- map_char_table (void_call2, Qnil, char_table, char_table, function, 0, indices);
- return Qnil;
-}
-
-/* Return a value for character C in char-table TABLE. Store the
- actual index for that value in *IDX. Ignore the default value of
- TABLE. */
-
-Lisp_Object
-char_table_ref_and_index (table, c, idx)
- Lisp_Object table;
- int c, *idx;
-{
- int charset, c1, c2;
- Lisp_Object elt;
-
- if (SINGLE_BYTE_CHAR_P (c))
- {
- *idx = c;
- return XCHAR_TABLE (table)->contents[c];
- }
- SPLIT_CHAR (c, charset, c1, c2);
- elt = XCHAR_TABLE (table)->contents[charset + 128];
- *idx = MAKE_CHAR (charset, 0, 0);
- if (!SUB_CHAR_TABLE_P (elt))
- return elt;
- if (c1 < 32 || NILP (XCHAR_TABLE (elt)->contents[c1]))
- return XCHAR_TABLE (elt)->defalt;
- elt = XCHAR_TABLE (elt)->contents[c1];
- *idx = MAKE_CHAR (charset, c1, 0);
- if (!SUB_CHAR_TABLE_P (elt))
- return elt;
- if (c2 < 32 || NILP (XCHAR_TABLE (elt)->contents[c2]))
- return XCHAR_TABLE (elt)->defalt;
- *idx = c;
- return XCHAR_TABLE (elt)->contents[c2];
-}
-
\f
/* ARGSUSED */
Lisp_Object
USE_SAFE_ALLOCA;
len = Flength (sequence);
+ if (CHAR_TABLE_P (sequence))
+ wrong_type_argument (Qlistp, sequence);
leni = XINT (len);
nargs = leni + leni - 1;
if (nargs < 0) return empty_unibyte_string;
USE_SAFE_ALLOCA;
len = Flength (sequence);
+ if (CHAR_TABLE_P (sequence))
+ wrong_type_argument (Qlistp, sequence);
leni = XFASTINT (len);
SAFE_ALLOCA_LISP (args, leni);
register int leni;
leni = XFASTINT (Flength (sequence));
+ if (CHAR_TABLE_P (sequence))
+ wrong_type_argument (Qlistp, sequence);
mapcar1 (leni, 0, function, sequence);
return sequence;
if (multibyte)
{
c = STRING_CHAR_AND_LENGTH (from + i, length - i, bytes);
- if (c >= 256)
+ if (CHAR_BYTE8_P (c))
+ c = CHAR_TO_BYTE8 (c);
+ else if (c >= 256)
return -1;
i += bytes;
}
if (multibyte)
{
c = STRING_CHAR_AND_LENGTH (from + i, length - i, bytes);
- if (c >= 256)
+ if (CHAR_BYTE8_P (c))
+ c = CHAR_TO_BYTE8 (c);
+ else if (c >= 256)
return -1;
i += bytes;
}
if (multibyte)
{
c = STRING_CHAR_AND_LENGTH (from + i, length - i, bytes);
- if (c >= 256)
+ if (CHAR_BYTE8_P (c))
+ c = CHAR_TO_BYTE8 (c);
+ else if (c >= 256)
return -1;
i += bytes;
}
value |= base64_char_to_value[c] << 12;
c = (unsigned char) (value >> 16);
- if (multibyte)
- e += CHAR_STRING (c, e);
+ if (multibyte && c >= 128)
+ e += BYTE8_STRING (c, e);
else
*e++ = c;
nchars++;
value |= base64_char_to_value[c] << 6;
c = (unsigned char) (0xff & value >> 8);
- if (multibyte)
- e += CHAR_STRING (c, e);
+ if (multibyte && c >= 128)
+ e += BYTE8_STRING (c, e);
else
*e++ = c;
nchars++;
value |= base64_char_to_value[c];
c = (unsigned char) (0xff & value);
- if (multibyte)
- e += CHAR_STRING (c, e);
+ if (multibyte && c >= 128)
+ e += BYTE8_STRING (c, e);
else
*e++ = c;
nchars++;
struct Lisp_Hash_Table *h;
Lisp_Object key;
{
- unsigned hash = XUINT (key) ^ XGCTYPE (key);
+ unsigned hash = XUINT (key) ^ XTYPE (key);
xassert ((hash & ~INTMASK) == 0);
return hash;
}
if (FLOATP (key))
hash = sxhash (key, 0);
else
- hash = XUINT (key) ^ XGCTYPE (key);
+ hash = XUINT (key) ^ XTYPE (key);
xassert ((hash & ~INTMASK) == 0);
return hash;
}
/* Follow collision chain, removing entries that
don't survive this garbage collection. */
prev = Qnil;
- for (idx = HASH_INDEX (h, bucket); !GC_NILP (idx); idx = next)
+ for (idx = HASH_INDEX (h, bucket); !NILP (idx); idx = next)
{
int i = XFASTINT (idx);
int key_known_to_survive_p = survives_gc_p (HASH_KEY (h, i));
if (remove_p)
{
/* Take out of collision chain. */
- if (GC_NILP (prev))
+ if (NILP (prev))
HASH_INDEX (h, bucket) = next;
else
HASH_NEXT (h, XFASTINT (prev)) = next;
/* Remove elements from weak hash tables that don't survive the
current garbage collection. Remove weak tables that don't survive
- from weak_hash_tables. Called from gc_sweep. */
+ from Vweak_hash_tables. Called from gc_sweep. */
void
sweep_weak_hash_tables ()
************************************************************************/
#include "md5.h"
-#include "coding.h"
DEFUN ("md5", Fmd5, Smd5, 1, 5, 0,
doc: /* Return MD5 message digest of OBJECT, a buffer or string.
if (STRING_MULTIBYTE (object))
/* use default, we can't guess correct value */
- coding_system = find_symbol_value (XCAR (Vcoding_category_list));
+ coding_system = preferred_coding_system ();
else
coding_system = Qraw_text;
}
}
if (STRING_MULTIBYTE (object))
- object = code_convert_string1 (object, coding_system, Qnil, 1);
+ object = code_convert_string (object, coding_system, Qnil, 1, 0, 1);
size = SCHARS (object);
size_byte = SBYTES (object);
specpdl_ptr--;
if (STRING_MULTIBYTE (object))
- object = code_convert_string1 (object, coding_system, Qnil, 1);
+ object = code_convert_string (object, coding_system, Qnil, 1, 0, 0);
}
md5_buffer (SDATA (object) + start_byte,
defsubr (&Sequal_including_properties);
defsubr (&Sfillarray);
defsubr (&Sclear_string);
- defsubr (&Schar_table_subtype);
- defsubr (&Schar_table_parent);
- defsubr (&Sset_char_table_parent);
- defsubr (&Schar_table_extra_slot);
- defsubr (&Sset_char_table_extra_slot);
- defsubr (&Schar_table_range);
- defsubr (&Sset_char_table_range);
- defsubr (&Sset_char_table_default);
- defsubr (&Soptimize_char_table);
- defsubr (&Smap_char_table);
defsubr (&Snconc);
defsubr (&Smapcar);
defsubr (&Smapc);
/* Fontset handler.
- Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
Free Software Foundation, Inc.
Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- 2005, 2006, 2007
+ 2005, 2006, 2007, 2008
National Institute of Advanced Industrial Science and Technology (AIST)
Registration Number H14PRO021
-
+ Copyright (C) 2003, 2006
+ National Institute of Advanced Industrial Science and Technology (AIST)
+ Registration Number H13PRO009
+
This file is part of GNU Emacs.
GNU Emacs is free software; you can redistribute it and/or modify
#endif
#include "lisp.h"
+#include "blockinput.h"
#include "buffer.h"
+#include "character.h"
#include "charset.h"
#include "ccl.h"
#include "keyboard.h"
#include "frame.h"
#include "dispextern.h"
+#include "intervals.h"
#include "fontset.h"
#include "window.h"
#ifdef HAVE_X_WINDOWS
#endif
#include "termhooks.h"
-#ifdef FONTSET_DEBUG
+#include "font.h"
+
#undef xassert
+#ifdef FONTSET_DEBUG
#define xassert(X) do {if (!(X)) abort ();} while (0)
#undef INLINE
#define INLINE
-#endif
+#else /* not FONTSET_DEBUG */
+#define xassert(X) (void) 0
+#endif /* not FONTSET_DEBUG */
+EXFUN (Fclear_face_cache, 1);
/* FONTSET
A fontset is a collection of font related information to give
- similar appearance (style, size, etc) of characters. There are two
- kinds of fontsets; base and realized. A base fontset is created by
- new-fontset from Emacs Lisp explicitly. A realized fontset is
- created implicitly when a face is realized for ASCII characters. A
- face is also realized for multibyte characters based on an ASCII
- face. All of the multibyte faces based on the same ASCII face
- share the same realized fontset.
+ similar appearance (style, etc) of characters. A fontset has two
+ roles. One is to use for the frame parameter `font' as if it is an
+ ASCII font. In that case, Emacs uses the font specified for
+ `ascii' script for the frame's default font.
+
+ Another role, the more important one, is to provide information
+ about which font to use for each non-ASCII character.
+
+ There are two kinds of fontsets; base and realized. A base fontset
+ is created by `new-fontset' from Emacs Lisp explicitly. A realized
+ fontset is created implicitly when a face is realized for ASCII
+ characters. A face is also realized for non-ASCII characters based
+ on an ASCII face. All of non-ASCII faces based on the same ASCII
+ face share the same realized fontset.
+
+ A fontset object is implemented by a char-table whose default value
+ and parent are always nil.
+
+ An element of a base fontset is a vector of FONT-DEFs which itself
+ is a vector [ FONT-SPEC ENCODING REPERTORY ].
+
+ FONT-SPEC is a font-spec created by `font-spec' or
+ ( FAMILY . REGISTRY )
+ or
+ FONT-NAME
+ where FAMILY, REGISTRY, and FONT-NAME are strings.
+
+ ENCODING is a charset ID that can convert characters to glyph codes
+ of the corresponding font.
+
+ REPERTORY is a charset ID, a char-table, or nil. If REPERTORY is a
+ charset ID, the repertory of the charset exactly matches with that
+ of the font. If REPERTORY is a char-table, all characters who have
+ a non-nil value in the table are supported. If REPERTORY is nil,
+ we consult with the font itself to get the repertory.
+
+ ENCODING and REPERTORY are extracted from the variable
+ Vfont_encoding_alist by using a font name generated from FONT-SPEC
+ (if it is a vector) or FONT-NAME as a matching target.
- A fontset object is implemented by a char-table.
- An element of a base fontset is:
- (INDEX . FONTNAME) or
- (INDEX . (FOUNDRY . REGISTRY ))
- FONTNAME is a font name pattern for the corresponding character.
- FOUNDRY and REGISTRY are respectively foundry and registry fields of
- a font name for the corresponding character. INDEX specifies for
- which character (or generic character) the element is defined. It
- may be different from an index to access this element. For
- instance, if a fontset defines some font for all characters of
- charset `japanese-jisx0208', INDEX is the generic character of this
- charset. REGISTRY is the
+ An element of a realized fontset is nil or t, or has this form:
- An element of a realized fontset is FACE-ID which is a face to use
- for displaying the corresponding character.
+ [CHARSET-ORDERED-LIST-TICK PREFERRED-CHARSET-ID PREFERRED-FAMILY
+ RFONT-DEF0 RFONT-DEF1 ...].
- All single byte characters (ASCII and 8bit-unibyte) share the same
- element in a fontset. The element is stored in the first element
- of the fontset.
+ RFONT-DEFn (i.e. Realized FONT-DEF) has this form:
- To access or set each element, use macros FONTSET_REF and
- FONTSET_SET respectively for efficiency.
+ [ FACE-ID FONT-INDEX FONT-DEF OPENED-FONT-NAME ]
- A fontset has 3 extra slots.
+ RFONT-DEFn is automatically reordered by the current charset
+ priority list.
- The 1st slot is an ID number of the fontset.
+ The value nil means that we have not yet generated the above vector
+ from the base of the fontset.
- The 2nd slot is a name of the fontset. This is nil for a realized
- face.
+ The value t means that no font is available for the corresponding
+ range of characters.
- The 3rd slot is a frame that the fontset belongs to. This is nil
- for a default face.
- A parent of a base fontset is nil. A parent of a realized fontset
- is a base fontset.
+ A fontset has 9 extra slots.
- All fontsets are recorded in Vfontset_table.
+ The 1st slot: the ID number of the fontset
+
+ The 2nd slot:
+ base: the name of the fontset
+ realized: nil
+
+ The 3rd slot:
+ base: nil
+ realized: the base fontset
+
+ The 4th slot:
+ base: nil
+ realized: the frame that the fontset belongs to
+
+ The 5th slot:
+ base: the font name for ASCII characters
+ realized: nil
+
+ The 6th slot:
+ base: nil
+ realized: the ID number of a face to use for characters that
+ has no font in a realized fontset.
+
+ The 7th slot:
+ base: nil
+ realized: Alist of font index vs the corresponding repertory
+ char-table.
+
+ The 8th slot:
+ base: nil
+ realized: If the base is not the default fontset, a fontset
+ realized from the default fontset, else nil.
+
+ The 9th slot:
+ base: Same as element value (but for fallback fonts).
+ realized: Likewise.
+
+ All fontsets are recorded in the vector Vfontset_table.
DEFAULT FONTSET
- There's a special fontset named `default fontset' which defines a
- default fontname pattern. When a base fontset doesn't specify a
- font for a specific character, the corresponding value in the
- default fontset is used. The format is the same as a base fontset.
+ There's a special base fontset named `default fontset' which
+ defines the default font specifications. When a base fontset
+ doesn't specify a font for a specific character, the corresponding
+ value in the default fontset is used.
The parent of a realized fontset created for such a face that has
no fontset is the default fontset.
These structures are hidden from the other codes than this file.
The other codes handle fontsets only by their ID numbers. They
- usually use variable name `fontset' for IDs. But, in this file, we
- always use variable name `id' for IDs, and name `fontset' for the
- actual fontset objects.
+ usually use the variable name `fontset' for IDs. But, in this
+ file, we always use varialbe name `id' for IDs, and name `fontset'
+ for an actual fontset object, i.e., char-table.
*/
/********** VARIABLES and FUNCTION PROTOTYPES **********/
extern Lisp_Object Qfont;
-Lisp_Object Qfontset;
+static Lisp_Object Qfontset;
+static Lisp_Object Qfontset_info;
+static Lisp_Object Qprepend, Qappend;
+static Lisp_Object Qlatin;
/* Vector containing all fontsets. */
static Lisp_Object Vfontset_table;
static int next_fontset_id;
/* The default fontset. This gives default FAMILY and REGISTRY of
- font for each characters. */
+ font for each character. */
static Lisp_Object Vdefault_fontset;
-/* Alist of font specifications. It override the font specification
- in the default fontset. */
-static Lisp_Object Voverriding_fontspec_alist;
-
Lisp_Object Vfont_encoding_alist;
+Lisp_Object Vfont_encoding_charset_alist;
Lisp_Object Vuse_default_ascent;
Lisp_Object Vignore_relative_composition;
Lisp_Object Valternate_fontname_alist;
Lisp_Object Vfontset_alias_alist;
Lisp_Object Vvertical_centering_font_regexp;
+Lisp_Object Votf_script_alist;
/* The following six are declarations of callback functions depending
on window system. See the comments in src/fontset.h for more
This function set the member `encoder' of the structure. */
void (*find_ccl_program_func) P_ ((struct font_info *));
+Lisp_Object (*get_font_repertory_func) P_ ((struct frame *,
+ struct font_info *));
+
/* Check if any window system is used now. */
void (*check_window_system_func) P_ ((void));
/* Prototype declarations for static functions. */
-static Lisp_Object fontset_ref P_ ((Lisp_Object, int));
-static Lisp_Object lookup_overriding_fontspec P_ ((Lisp_Object, int));
-static void fontset_set P_ ((Lisp_Object, int, Lisp_Object));
+static Lisp_Object fontset_add P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
+ Lisp_Object));
+static void reorder_font_vector P_ ((Lisp_Object, int, Lisp_Object));
+static Lisp_Object fontset_font P_ ((Lisp_Object, int, struct face *, int));
static Lisp_Object make_fontset P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
-static int fontset_id_valid_p P_ ((int));
static Lisp_Object fontset_pattern_regexp P_ ((Lisp_Object));
-static Lisp_Object font_family_registry P_ ((Lisp_Object, int));
-static Lisp_Object regularize_fontname P_ ((Lisp_Object));
+static void accumulate_script_ranges P_ ((Lisp_Object, Lisp_Object,
+ Lisp_Object));
+Lisp_Object find_font_encoding P_ ((Lisp_Object));
+
+static void set_fontset_font P_ ((Lisp_Object, Lisp_Object));
+
+#ifdef FONTSET_DEBUG
+
+/* Return 1 if ID is a valid fontset id, else return 0. */
+
+static int
+fontset_id_valid_p (id)
+ int id;
+{
+ return (id >= 0 && id < ASIZE (Vfontset_table) - 1);
+}
+
+#endif
+
\f
/********** MACROS AND FUNCTIONS TO HANDLE FONTSET **********/
/* Macros to access special values of FONTSET. */
#define FONTSET_ID(fontset) XCHAR_TABLE (fontset)->extras[0]
+
+/* Macros to access special values of (base) FONTSET. */
#define FONTSET_NAME(fontset) XCHAR_TABLE (fontset)->extras[1]
-#define FONTSET_FRAME(fontset) XCHAR_TABLE (fontset)->extras[2]
-#define FONTSET_ASCII(fontset) XCHAR_TABLE (fontset)->contents[0]
-#define FONTSET_BASE(fontset) XCHAR_TABLE (fontset)->parent
+#define FONTSET_ASCII(fontset) XCHAR_TABLE (fontset)->extras[4]
+
+/* Macros to access special values of (realized) FONTSET. */
+#define FONTSET_BASE(fontset) XCHAR_TABLE (fontset)->extras[2]
+#define FONTSET_FRAME(fontset) XCHAR_TABLE (fontset)->extras[3]
+#define FONTSET_NOFONT_FACE(fontset) XCHAR_TABLE (fontset)->extras[5]
+#define FONTSET_REPERTORY(fontset) XCHAR_TABLE (fontset)->extras[6]
+#define FONTSET_DEFAULT(fontset) XCHAR_TABLE (fontset)->extras[7]
+
+/* For both base and realized fontset. */
+#define FONTSET_FALLBACK(fontset) XCHAR_TABLE (fontset)->extras[8]
-#define BASE_FONTSET_P(fontset) NILP (FONTSET_BASE(fontset))
+#define BASE_FONTSET_P(fontset) (NILP (FONTSET_BASE (fontset)))
-/* Return the element of FONTSET (char-table) at index C (character). */
+/* Return the element of FONTSET for the character C. If FONTSET is a
+ base fontset other then the default fontset and FONTSET doesn't
+ contain information for C, return the information in the default
+ fontset. */
-#define FONTSET_REF(fontset, c) fontset_ref (fontset, c)
+#define FONTSET_REF(fontset, c) \
+ (EQ (fontset, Vdefault_fontset) \
+ ? CHAR_TABLE_REF (fontset, c) \
+ : fontset_ref ((fontset), (c)))
static Lisp_Object
fontset_ref (fontset, c)
Lisp_Object fontset;
int c;
{
- int charset, c1, c2;
- Lisp_Object elt, defalt;
-
- if (SINGLE_BYTE_CHAR_P (c))
- return FONTSET_ASCII (fontset);
-
- SPLIT_CHAR (c, charset, c1, c2);
- elt = XCHAR_TABLE (fontset)->contents[charset + 128];
- if (!SUB_CHAR_TABLE_P (elt))
- return elt;
- defalt = XCHAR_TABLE (elt)->defalt;
- if (c1 < 32
- || (elt = XCHAR_TABLE (elt)->contents[c1],
- NILP (elt)))
- return defalt;
- if (!SUB_CHAR_TABLE_P (elt))
- return elt;
- defalt = XCHAR_TABLE (elt)->defalt;
- if (c2 < 32
- || (elt = XCHAR_TABLE (elt)->contents[c2],
- NILP (elt)))
- return defalt;
+ Lisp_Object elt;
+
+ elt = CHAR_TABLE_REF (fontset, c);
+ if (NILP (elt) && ! EQ (fontset, Vdefault_fontset)
+ /* Don't check Vdefault_fontset for a realized fontset. */
+ && NILP (FONTSET_BASE (fontset)))
+ elt = CHAR_TABLE_REF (Vdefault_fontset, c);
return elt;
}
+/* Return the element of FONTSET for the character C, set FROM and TO
+ to the range of characters around C that have the same value as C.
+ If FONTSET is a base fontset other then the default fontset and
+ FONTSET doesn't contain information for C, return the information
+ in the default fontset. */
+
+#define FONTSET_REF_AND_RANGE(fontset, c, form, to) \
+ (EQ (fontset, Vdefault_fontset) \
+ ? char_table_ref_and_range (fontset, c, &from, &to) \
+ : fontset_ref_and_range (fontset, c, &from, &to))
+
static Lisp_Object
-lookup_overriding_fontspec (frame, c)
- Lisp_Object frame;
+fontset_ref_and_range (fontset, c, from, to)
+ Lisp_Object fontset;
int c;
+ int *from, *to;
{
- Lisp_Object tail;
+ Lisp_Object elt;
- for (tail = Voverriding_fontspec_alist; CONSP (tail); tail = XCDR (tail))
+ elt = char_table_ref_and_range (fontset, c, from, to);
+ if (NILP (elt) && ! EQ (fontset, Vdefault_fontset)
+ /* Don't check Vdefault_fontset for a realized fontset. */
+ && NILP (FONTSET_BASE (fontset)))
{
- Lisp_Object val, target, elt;
-
- val = XCAR (tail);
- target = XCAR (val);
- val = XCDR (val);
- /* Now VAL is (NO-FRAME-LIST OK-FRAME-LIST CHAR FONTNAME). */
- if (NILP (Fmemq (frame, XCAR (val)))
- && (CHAR_TABLE_P (target)
- ? ! NILP (CHAR_TABLE_REF (target, c))
- : XINT (target) == CHAR_CHARSET (c)))
- {
- val = XCDR (val);
- elt = XCDR (val);
- if (NILP (Fmemq (frame, XCAR (val))))
- {
- if (! face_font_available_p (XFRAME (frame), XCDR (elt)))
- {
- val = XCDR (XCAR (tail));
- XSETCAR (val, Fcons (frame, XCAR (val)));
- continue;
- }
- XSETCAR (val, Fcons (frame, XCAR (val)));
- }
- if (NILP (XCAR (elt)))
- XSETCAR (elt, make_number (c));
- return elt;
- }
+ int from1, to1;
+
+ elt = char_table_ref_and_range (Vdefault_fontset, c, &from1, &to1);
+ if (*from < from1)
+ *from = from1;
+ if (*to > to1)
+ *to = to1;
}
- return Qnil;
+ return elt;
}
-#define FONTSET_REF_VIA_BASE(fontset, c) fontset_ref_via_base (fontset, &c)
+
+/* Set elements of FONTSET for characters in RANGE to the value ELT.
+ RANGE is a cons (FROM . TO), where FROM and TO are character codes
+ specifying a range. */
+
+#define FONTSET_SET(fontset, range, elt) \
+ Fset_char_table_range ((fontset), (range), (elt))
+
+
+/* Modify the elements of FONTSET for characters in RANGE by replacing
+ with ELT or adding ELT. RANGE is a cons (FROM . TO), where FROM
+ and TO are character codes specifying a range. If ADD is nil,
+ replace with ELT, if ADD is `prepend', prepend ELT, otherwise,
+ append ELT. */
+
+#define FONTSET_ADD(fontset, range, elt, add) \
+ (NILP (add) \
+ ? (NILP (range) \
+ ? (FONTSET_FALLBACK (fontset) = Fmake_vector (make_number (1), (elt))) \
+ : Fset_char_table_range ((fontset), (range), \
+ Fmake_vector (make_number (1), (elt)))) \
+ : fontset_add ((fontset), (range), (elt), (add)))
static Lisp_Object
-fontset_ref_via_base (fontset, c)
- Lisp_Object fontset;
- int *c;
+fontset_add (fontset, range, elt, add)
+ Lisp_Object fontset, range, elt, add;
{
- int charset, c1, c2;
- Lisp_Object elt;
+ Lisp_Object args[2];
+ int idx = (EQ (add, Qappend) ? 0 : 1);
- if (SINGLE_BYTE_CHAR_P (*c))
- return FONTSET_ASCII (fontset);
-
- elt = Qnil;
- if (! EQ (FONTSET_BASE (fontset), Vdefault_fontset))
- elt = FONTSET_REF (FONTSET_BASE (fontset), *c);
- if (NILP (elt))
- elt = lookup_overriding_fontspec (FONTSET_FRAME (fontset), *c);
- if (NILP (elt))
- elt = FONTSET_REF (Vdefault_fontset, *c);
- if (NILP (elt))
- return Qnil;
+ args[1 - idx] = Fmake_vector (make_number (1), elt);
- *c = XINT (XCAR (elt));
- SPLIT_CHAR (*c, charset, c1, c2);
- elt = XCHAR_TABLE (fontset)->contents[charset + 128];
- if (c1 < 32)
- return (SUB_CHAR_TABLE_P (elt) ? XCHAR_TABLE (elt)->defalt : elt);
- if (!SUB_CHAR_TABLE_P (elt))
- return Qnil;
- elt = XCHAR_TABLE (elt)->contents[c1];
- if (c2 < 32)
- return (SUB_CHAR_TABLE_P (elt) ? XCHAR_TABLE (elt)->defalt : elt);
- if (!SUB_CHAR_TABLE_P (elt))
- return Qnil;
- elt = XCHAR_TABLE (elt)->contents[c2];
- return elt;
+ if (CONSP (range))
+ {
+ int from = XINT (XCAR (range));
+ int to = XINT (XCDR (range));
+ int from1, to1;
+
+ do {
+ args[idx] = char_table_ref_and_range (fontset, from, &from1, &to1);
+ if (to < to1)
+ to1 = to;
+ char_table_set_range (fontset, from, to1,
+ NILP (args[idx]) ? args[1 - idx]
+ : Fvconcat (2, args));
+ from = to1 + 1;
+ } while (from < to);
+ }
+ else
+ {
+ args[idx] = FONTSET_FALLBACK (fontset);
+ FONTSET_FALLBACK (fontset)
+ = NILP (args[idx]) ? args[1 - idx] : Fvconcat (2, args);
+ }
+ return Qnil;
}
-/* Store into the element of FONTSET at index C the value NEWELT. */
-#define FONTSET_SET(fontset, c, newelt) fontset_set(fontset, c, newelt)
+/* Update FONT-GROUP which has this form:
+ [CHARSET-ORDERED-LIST-TICK PREFERRED-CHARSET-ID PREFERRED-FAMILY
+ RFONT-DEF0 RFONT-DEF1 ...].
+ Reorder RFONT-DEFs according to the current order of charset
+ (Vcharset_ordered_list), and update CHARSET-ORDERED-LIST-TICK to
+ the latest value. */
static void
-fontset_set (fontset, c, newelt)
+reorder_font_vector (font_group, charset_id, family)
+ Lisp_Object font_group;
+ int charset_id;
+ Lisp_Object family;
+{
+ Lisp_Object list, *new_vec;
+ int size;
+ int *charset_id_table;
+ int i, idx;
+ Lisp_Object preferred_by_charset, preferred_by_family;
+
+ size = ASIZE (font_group) - 3;
+ charset_id_table = (int *) alloca (sizeof (int) * size);
+ new_vec = (Lisp_Object *) alloca (sizeof (Lisp_Object) * size);
+
+ /* At first, extract ENCODING (a chaset ID) from RFONT_DEF which
+ has this form:
+ [FACE-ID FONT-INDEX [ FONT-SPEC ENCODING REPERTORY ]]
+ In addtion, if RFONT_DEF is preferred by family or charset, store
+ it from the start of new_vec. */
+ for (i = 0, idx = 0; i < size; i++)
+ {
+ Lisp_Object rfont_def = AREF (font_group, i + 3);
+ Lisp_Object font_spec = AREF (AREF (rfont_def, 2), 0);
+ Lisp_Object this_family = AREF (font_spec, FONT_FAMILY_INDEX);
+ int id = XINT (AREF (AREF (rfont_def, 2), 1));
+ struct charset *charset = CHARSET_FROM_ID (id);
+
+ charset_id_table[i] = -1;
+ if (! NILP (this_family)
+ && (fast_string_match_ignore_case (family, SYMBOL_NAME (this_family))
+ >= 0))
+ {
+ if (idx > 0)
+ memmove (new_vec + 1, new_vec, sizeof (Lisp_Object) * idx);
+ new_vec[0] = rfont_def;
+ idx++;
+ ASET (font_group, i + 3, Qnil);
+ }
+ else if (id == charset_id)
+ {
+ new_vec[idx++] = rfont_def;
+ ASET (font_group, i + 3, Qnil);
+ }
+ else if (! charset->supplementary_p)
+ charset_id_table[i] = id;
+ }
+
+ if (idx == 0
+ && (XINT (AREF (font_group, 0)) == charset_ordered_list_tick))
+ /* No need of reordering. */
+ return;
+
+ ASET (font_group, 0, make_number (charset_ordered_list_tick));
+ ASET (font_group, 1, make_number (charset_id));
+ ASET (font_group, 2, family);
+
+ /* Then, store the remaining RFONT-DEFs in NEW_VEC in the correct
+ order. */
+ for (list = Vcharset_ordered_list; idx < size; list = XCDR (list))
+ {
+ int id = XINT (XCAR (list));
+ struct charset *charset = CHARSET_FROM_ID (id);
+
+ if (charset->supplementary_p)
+ break;
+ for (i = 0; i < size; i++)
+ if (charset_id_table[i] == XINT (XCAR (list))
+ && ! NILP (AREF (font_group, i + 2)))
+ {
+ new_vec[idx++] = AREF (font_group, i + 3);
+ ASET (font_group, i + 3, Qnil);
+ }
+ }
+ for (i = 0; i < size; i++)
+ if (! NILP (AREF (font_group, i + 3)))
+ new_vec[idx++] = AREF (font_group, i + 3);
+
+ /* At last, update elements of FONT-GROUP. */
+ for (i = 0; i < size; i++)
+ ASET (font_group, i + 3, new_vec[i]);
+}
+
+
+/* Load a font matching the font related attributes in FACE->lface and
+ font pattern in FONT_DEF of FONTSET, and return an index of the
+ font. FONT_DEF has this form:
+ [ FONT-SPEC ENCODING REPERTORY ]
+ If REPERTORY is nil, generate a char-table representing the font
+ repertory by looking into the font itself. */
+
+extern Lisp_Object QCname;
+
+static int
+load_font_get_repertory (f, face, font_def, fontset)
+ FRAME_PTR f;
+ struct face *face;
+ Lisp_Object font_def;
Lisp_Object fontset;
- int c;
- Lisp_Object newelt;
{
- int charset, code[3];
- Lisp_Object *elt;
- int i;
+ char *font_name;
+ struct font_info *font_info;
+ int charset;
+ Lisp_Object font_spec, name;
+
+ font_spec = AREF (font_def, 0);
+ name = Ffont_get (font_spec, QCname);
+ if (! NILP (name))
+ font_name = choose_face_font (f, face->lface, name, NULL);
+ else
+ font_name = choose_face_font (f, face->lface, font_spec, NULL);
+ charset = XINT (AREF (font_def, 1));
+ if (! (font_info = fs_load_font (f, font_name, charset)))
+ return -1;
+
+ if (NILP (AREF (font_def, 2))
+ && NILP (Fassq (make_number (font_info->font_idx),
+ FONTSET_REPERTORY (fontset))))
+ {
+ /* We must look into the font to get the correct repertory as a
+ char-table. */
+ Lisp_Object repertory;
+
+ repertory = (*get_font_repertory_func) (f, font_info);
+ FONTSET_REPERTORY (fontset)
+ = Fcons (Fcons (make_number (font_info->font_idx), repertory),
+ FONTSET_REPERTORY (fontset));
+ }
+
+ return font_info->font_idx;
+}
- if (SINGLE_BYTE_CHAR_P (c))
+static Lisp_Object fontset_find_font P_ ((Lisp_Object, int, struct face *,
+ int, int));
+
+/* Return RFONT-DEF (vector) in the realized fontset FONTSET for the
+ character C. If the corresponding font is not yet opened, open it
+ (if FACE is not NULL) or return Qnil (if FACE is NULL).
+ If no proper font is found for C, return Qnil.
+ ID is a charset-id that must be preferred, or -1 meaning no
+ preference.
+ If FALLBACK is nonzero, search only fallback fonts. */
+
+static Lisp_Object
+fontset_find_font (fontset, c, face, id, fallback)
+ Lisp_Object fontset;
+ int c;
+ struct face *face;
+ int id, fallback;
+{
+ Lisp_Object base_fontset, elt, vec, font_def;
+ int i, from, to;
+ int font_idx;
+ FRAME_PTR f = XFRAME (FONTSET_FRAME (fontset));
+
+ base_fontset = FONTSET_BASE (fontset);
+ if (! fallback)
+ vec = CHAR_TABLE_REF (fontset, c);
+ else
+ vec = FONTSET_FALLBACK (fontset);
+ if (NILP (vec))
{
- FONTSET_ASCII (fontset) = newelt;
- return;
+ Lisp_Object range;
+
+ /* We have not yet decided a font for C. */
+ if (! face)
+ return Qnil;
+ if (! fallback)
+ {
+ elt = FONTSET_REF_AND_RANGE (base_fontset, c, from, to);
+ range = Fcons (make_number (from), make_number (to));
+ if (EQ (base_fontset, Vdefault_fontset))
+ {
+ Lisp_Object script = CHAR_TABLE_REF (Vchar_script_table, c);
+
+ if (! NILP (script))
+ {
+ Lisp_Object font_spec = Ffont_spec (0, NULL);
+ Lisp_Object args[2], tmp;
+
+ ASET (font_spec, FONT_REGISTRY_INDEX, Qiso10646_1);
+ ASET (font_spec, FONT_EXTRA_INDEX,
+ Fcons (Fcons (QCscript, script), Qnil));
+ args[0] = elt;
+ tmp = Fmake_vector (make_number (3), Qnil);
+ ASET (tmp, 0, font_spec);
+ ASET (tmp, 1, CHARSET_SYMBOL_ID (Qunicode_bmp));
+ args[1] = Fvector (1, &tmp);
+ elt = Fvconcat (2, args);
+ }
+ }
+ }
+ else
+ {
+ elt = FONTSET_FALLBACK (base_fontset);
+ }
+ if (NILP (elt))
+ {
+ /* Qt means we have no font for characters of this range. */
+ vec = Qt;
+ }
+ else
+ {
+ /* Build a vector [ -1 -1 nil NEW-ELT0 NEW-ELT1 NEW-ELT2 ... ],
+ where the first -1 is to force reordering of NEW-ELTn,
+ NEW-ELTn is [nil nil AREF (elt, n) nil]. */
+ vec = Fmake_vector (make_number (ASIZE (elt) + 3), Qnil);
+ ASET (vec, 0, make_number (-1));
+ ASET (vec, 1, make_number (-1));
+ for (i = 0; i < ASIZE (elt); i++)
+ {
+ Lisp_Object tmp;
+ tmp = Fmake_vector (make_number (5), Qnil);
+ ASET (tmp, 2, AREF (elt, i));
+ ASET (vec, i + 3, tmp);
+ }
+ }
+ /* Then store it in the fontset. */
+ if (! fallback)
+ FONTSET_SET (fontset, range, vec);
+ else
+ FONTSET_FALLBACK (fontset) = vec;
}
+ if (EQ (vec, Qt))
+ return Qnil;
- SPLIT_CHAR (c, charset, code[0], code[1]);
- code[2] = 0; /* anchor */
- elt = &XCHAR_TABLE (fontset)->contents[charset + 128];
- for (i = 0; code[i] > 0; i++)
+ if (ASIZE (vec) > 4
+ && (XINT (AREF (vec, 0)) != charset_ordered_list_tick
+ || (id >= 0 && XINT (AREF (vec, 1)) != id)
+ || NILP (Fequal (AREF (vec, 2), face->lface[LFACE_FAMILY_INDEX]))))
+ /* We have just created VEC,
+ or the charset priorities were changed,
+ or the preferred charset was changed,
+ or the preferred family was changed. */
+ reorder_font_vector (vec, id, face->lface[LFACE_FAMILY_INDEX]);
+
+ /* Find the first available font in the vector of RFONT-DEF. */
+ for (i = 3; i < ASIZE (vec); i++)
{
- if (!SUB_CHAR_TABLE_P (*elt))
+ elt = AREF (vec, i);
+ if (NILP (elt))
+ continue;
+ /* ELT == [ FACE-ID FONT-INDEX FONT-DEF ... ] */
+ if (INTEGERP (AREF (elt, 1)) && XINT (AREF (elt, 1)) < 0)
+ /* We couldn't open this font last time. */
+ continue;
+
+ if (!face && NILP (AREF (elt, 1)))
+ /* We have not yet opened the font. */
+ return Qnil;
+
+ font_def = AREF (elt, 2);
+ /* FONT_DEF == [ FONT-SPEC ENCODING REPERTORY ] */
+
+#ifdef USE_FONT_BACKEND
+ if (enable_font_backend)
{
- Lisp_Object val = *elt;
- *elt = make_sub_char_table (Qnil);
- XCHAR_TABLE (*elt)->defalt = val;
+ /* ELT == [ FACE-ID FONT-INDEX FONT-DEF FONT-LIST ]
+ where FONT-LIST is a list of font-entity or font-object. */
+ Lisp_Object font_list = AREF (elt, 3), prev = Qnil;
+ Lisp_Object font_object;
+ int has_char;
+
+ for (; CONSP (font_list);
+ prev = font_list, font_list = XCDR (font_list))
+ {
+ font_object = XCAR (font_list);
+ if (! (FONT_ENTITY_P (font_object)
+ && FONT_ENTITY_NOT_LOADABLE (font_object))
+ && (has_char = font_has_char (f, font_object, c)) != 0)
+ {
+ if (has_char < 0)
+ {
+ Lisp_Object obj = font_open_for_lface (f, font_object,
+ face->lface, Qnil);
+ if (NILP (obj))
+ {
+ FONT_ENTITY_SET_NOT_LOADABLE (font_object);
+ continue;
+ }
+ font_object = obj;
+ XSETCAR (font_list, font_object);
+ if (! font_has_char (f, font_object, c))
+ continue;
+ }
+ if (! NILP (prev))
+ {
+ /* Move this element to the head. */
+ XSETCDR (prev, XCDR (font_list));
+ ASET (elt, 3, Fcons (XCAR (font_list), AREF (elt, 3)));
+ }
+ break;
+ }
+ }
+ if (NILP (font_list))
+ {
+ Lisp_Object font_spec = AREF (font_def, 0);
+ Lisp_Object font_entity;
+
+ font_entity = font_find_for_lface (f, face->lface, font_spec, c);
+ if (NILP (font_entity))
+ continue;
+ font_list = Fcons (font_entity, AREF (elt, 3));
+ ASET (elt, 3, font_list);
+ }
+ font_object = XCAR (font_list);
+ if (FONT_ENTITY_P (font_object))
+ {
+ font_object = font_open_for_lface (f, font_object,
+ face->lface, Qnil);
+ if (NILP (font_object))
+ {
+ FONT_ENTITY_SET_NOT_LOADABLE (XCAR (font_list));
+ continue;
+ }
+ XSETCAR (font_list, font_object);
+ }
+ ASET (elt, 1, make_number (0));
}
- elt = &XCHAR_TABLE (*elt)->contents[code[i]];
+ else
+#endif /* USE_FONT_BACKEND */
+
+ if (INTEGERP (AREF (font_def, 2)))
+ {
+ /* The repertory is specified by charset ID. */
+ struct charset *charset
+ = CHARSET_FROM_ID (XINT (AREF (font_def, 2)));
+
+ if (! CHAR_CHARSET_P (c, charset))
+ /* This font can't display C. */
+ continue;
+ }
+ else if (CHAR_TABLE_P (AREF (font_def, 2)))
+ {
+ /* The repertory is specified by a char table. */
+ if (NILP (CHAR_TABLE_REF (AREF (font_def, 2), c)))
+ /* This font can't display C. */
+ continue;
+ }
+ else
+ {
+ Lisp_Object slot;
+
+ if (! INTEGERP (AREF (elt, 1)))
+ {
+ /* We have not yet opened a font matching this spec.
+ Open the best matching font now and register the
+ repertory. */
+ struct font_info *font_info;
+
+ font_idx = load_font_get_repertory (f, face, font_def, fontset);
+ ASET (elt, 1, make_number (font_idx));
+ if (font_idx < 0)
+ /* This means that we couldn't find a font matching
+ FONT_DEF. */
+ continue;
+ font_info = (*get_font_info_func) (f, font_idx);
+ ASET (elt, 3, build_string (font_info->full_name));
+ }
+
+ slot = Fassq (AREF (elt, 1), FONTSET_REPERTORY (fontset));
+ xassert (CONSP (slot));
+ if (NILP (CHAR_TABLE_REF (XCDR (slot), c)))
+ /* This font can't display C. */
+ continue;
+ }
+
+ /* Now we have decided to use this font spec to display C. */
+ if (! INTEGERP (AREF (elt, 1)))
+ {
+ /* But not yet opened the best matching font. */
+ struct font_info *font_info;
+
+ font_idx = load_font_get_repertory (f, face, font_def, fontset);
+ ASET (elt, 1, make_number (font_idx));
+ if (font_idx < 0)
+ /* Can't open it. Try the other one. */
+ continue;
+ font_info = (*get_font_info_func) (f, font_idx);
+ ASET (elt, 3, build_string (font_info->full_name));
+ }
+
+ /* Now we have the opened font. */
+ return elt;
}
- if (SUB_CHAR_TABLE_P (*elt))
- XCHAR_TABLE (*elt)->defalt = newelt;
- else
- *elt = newelt;
+ return Qnil;
}
+static Lisp_Object
+fontset_font (fontset, c, face, id)
+ Lisp_Object fontset;
+ int c;
+ struct face *face;
+ int id;
+{
+ Lisp_Object rfont_def;
+ Lisp_Object base_fontset;
+
+ /* Try a font-group for C. */
+ rfont_def = fontset_find_font (fontset, c, face, id, 0);
+ if (! NILP (rfont_def))
+ return rfont_def;
+ base_fontset = FONTSET_BASE (fontset);
+ /* Try a font-group for C of the default fontset. */
+ if (! EQ (base_fontset, Vdefault_fontset))
+ {
+ if (NILP (FONTSET_DEFAULT (fontset)))
+ FONTSET_DEFAULT (fontset)
+ = make_fontset (FONTSET_FRAME (fontset), Qnil, Vdefault_fontset);
+ rfont_def = fontset_find_font (FONTSET_DEFAULT (fontset), c, face, id, 0);
+ }
+ if (! NILP (rfont_def))
+ return rfont_def;
+ /* Try a fallback font-group. */
+ rfont_def = fontset_find_font (fontset, c, face, id, 1);
+ if (! NILP (rfont_def))
+ return rfont_def;
+ /* Try a fallback font-group of the default fontset . */
+ if (! EQ (base_fontset, Vdefault_fontset))
+ rfont_def = fontset_find_font (FONTSET_DEFAULT (fontset), c, face, id, 1);
+ return rfont_def;
+}
+
/* Return a newly created fontset with NAME. If BASE is nil, make a
- base fontset. Otherwise make a realized fontset whose parent is
+ base fontset. Otherwise make a realized fontset whose base is
BASE. */
static Lisp_Object
while (!NILP (AREF (Vfontset_table, id))) id++;
if (id + 1 == size)
- Vfontset_table = larger_vector (Vfontset_table, size + 8, Qnil);
+ Vfontset_table = larger_vector (Vfontset_table, size + 32, Qnil);
fontset = Fmake_char_table (Qfontset, Qnil);
FONTSET_ID (fontset) = make_number (id);
- FONTSET_NAME (fontset) = name;
- FONTSET_FRAME (fontset) = frame;
- FONTSET_BASE (fontset) = base;
+ if (NILP (base))
+ {
+ FONTSET_NAME (fontset) = name;
+ }
+ else
+ {
+ FONTSET_NAME (fontset) = Qnil;
+ FONTSET_FRAME (fontset) = frame;
+ FONTSET_BASE (fontset) = base;
+ }
- AREF (Vfontset_table, id) = fontset;
+ ASET (Vfontset_table, id, fontset);
next_fontset_id = id + 1;
return fontset;
}
-/* Return 1 if ID is a valid fontset id, else return 0. */
-
-static INLINE int
-fontset_id_valid_p (id)
- int id;
-{
- return (id >= 0 && id < ASIZE (Vfontset_table) - 1);
-}
-
-
-/* Extract `family' and `registry' string from FONTNAME and a cons of
- them. Actually, `family' may also contain `foundry', `registry'
- may also contain `encoding' of FONTNAME. But, if FONTNAME doesn't
- conform to XLFD nor explicitely specifies the other fields
- (i.e. not using wildcard `*'), return FONTNAME. If FORCE is
- nonzero, specifications of the other fields are ignored, and return
- a cons as far as FONTNAME conform to XLFD. */
-
-static Lisp_Object
-font_family_registry (fontname, force)
+/* Set the ASCII font of the default fontset to FONTNAME if that is
+ not yet set. */
+void
+set_default_ascii_font (fontname)
Lisp_Object fontname;
- int force;
{
- Lisp_Object family, registry;
- const char *p = SDATA (fontname);
- const char *sep[15];
- int i = 0;
-
- while (*p && i < 15)
- if (*p++ == '-')
- {
- if (!force && i >= 2 && i <= 11 && *p != '*' && p[1] != '-')
- return fontname;
- sep[i++] = p;
- }
- if (i != 14)
- return fontname;
+ if (! STRINGP (FONTSET_ASCII (Vdefault_fontset)))
+ {
+ int id = fs_query_fontset (fontname, 2);
- family = make_unibyte_string (sep[0], sep[2] - 1 - sep[0]);
- registry = make_unibyte_string (sep[12], p - sep[12]);
- return Fcons (family, registry);
+ if (id >= 0)
+ fontname = FONTSET_ASCII (FONTSET_FROM_ID (id));
+ FONTSET_ASCII (Vdefault_fontset)= fontname;
+ }
}
\f
-/********** INTERFACES TO xfaces.c and dispextern.h **********/
+/********** INTERFACES TO xfaces.c, xfns.c, and dispextern.h **********/
-/* Return name of the fontset with ID. */
+/* Return the name of the fontset who has ID. */
Lisp_Object
fontset_name (id)
int id;
{
Lisp_Object fontset;
+
fontset = FONTSET_FROM_ID (id);
return FONTSET_NAME (fontset);
}
-/* Return ASCII font name of the fontset with ID. */
+/* Return the ASCII font name of the fontset who has ID. */
Lisp_Object
fontset_ascii (id)
int id;
{
Lisp_Object fontset, elt;
+
fontset= FONTSET_FROM_ID (id);
elt = FONTSET_ASCII (fontset);
- return XCDR (elt);
+#ifdef USE_FONT_BACKEND
+ if (CONSP (elt))
+ elt = XCAR (elt);
+#endif /* USE_FONT_BACKEND */
+ /* It is assured that ELT is always a string (i.e. fontname
+ pattern). */
+ return elt;
}
-/* Free fontset of FACE. Called from free_realized_face. */
+/* Free fontset of FACE defined on frame F. Called from
+ free_realized_face. */
void
free_face_fontset (f, face)
FRAME_PTR f;
struct face *face;
{
- if (fontset_id_valid_p (face->fontset))
+ Lisp_Object fontset;
+
+ fontset = AREF (Vfontset_table, face->fontset);
+ xassert (!NILP (fontset) && ! BASE_FONTSET_P (fontset));
+ xassert (f == XFRAME (FONTSET_FRAME (fontset)));
+ ASET (Vfontset_table, face->fontset, Qnil);
+ if (face->fontset < next_fontset_id)
+ next_fontset_id = face->fontset;
+ if (! NILP (FONTSET_DEFAULT (fontset)))
{
- AREF (Vfontset_table, face->fontset) = Qnil;
- if (face->fontset < next_fontset_id)
+ int id = XINT (FONTSET_ID (FONTSET_DEFAULT (fontset)));
+
+ fontset = AREF (Vfontset_table, id);
+ xassert (!NILP (fontset) && ! BASE_FONTSET_P (fontset));
+ xassert (f == XFRAME (FONTSET_FRAME (fontset)));
+ ASET (Vfontset_table, id, Qnil);
+ if (id < next_fontset_id)
next_fontset_id = face->fontset;
}
}
/* Return 1 if FACE is suitable for displaying character C.
Otherwise return 0. Called from the macro FACE_SUITABLE_FOR_CHAR_P
- when C is not a single byte character.. */
+ when C is not an ASCII character. */
int
face_suitable_for_char_p (face, c)
struct face *face;
int c;
{
- Lisp_Object fontset, elt;
-
- if (SINGLE_BYTE_CHAR_P (c))
- return (face == face->ascii_face);
+ Lisp_Object fontset, rfont_def;
- xassert (fontset_id_valid_p (face->fontset));
fontset = FONTSET_FROM_ID (face->fontset);
- xassert (!BASE_FONTSET_P (fontset));
-
- elt = FONTSET_REF_VIA_BASE (fontset, c);
- return (!NILP (elt) && face->id == XFASTINT (elt));
+ rfont_def = fontset_font (fontset, c, NULL, -1);
+ return (VECTORP (rfont_def)
+ && INTEGERP (AREF (rfont_def, 0))
+ && face->id == XINT (AREF (rfont_def, 0)));
}
/* Return ID of face suitable for displaying character C on frame F.
- The selection of face is done based on the fontset of FACE. FACE
- should already have been realized for ASCII characters. Called
- from the macro FACE_FOR_CHAR when C is not a single byte character. */
+ FACE must be reazlied for ASCII characters in advance. Called from
+ the macro FACE_FOR_CHAR. */
int
-face_for_char (f, face, c)
+face_for_char (f, face, c, pos, object)
FRAME_PTR f;
struct face *face;
- int c;
+ int c, pos;
+ Lisp_Object object;
{
- Lisp_Object fontset, elt;
+ Lisp_Object fontset, charset, rfont_def;
int face_id;
+ int id;
+
+ if (ASCII_CHAR_P (c))
+ return face->ascii_face->id;
xassert (fontset_id_valid_p (face->fontset));
fontset = FONTSET_FROM_ID (face->fontset);
xassert (!BASE_FONTSET_P (fontset));
+ if (pos < 0)
+ id = -1;
+ else
+ {
+ charset = Fget_char_property (make_number (pos), Qcharset, object);
+ if (NILP (charset))
+ id = -1;
+ else if (CHARSETP (charset))
+ {
+ Lisp_Object val;
+
+ val = assoc_no_quit (charset, Vfont_encoding_charset_alist);
+ if (CONSP (val) && CHARSETP (XCDR (val)))
+ charset = XCDR (val);
+ id = XINT (CHARSET_SYMBOL_ID (charset));
+ }
+ }
+ rfont_def = fontset_font (fontset, c, face, id);
+ if (VECTORP (rfont_def))
+ {
+#ifdef USE_FONT_BACKEND
+ if (enable_font_backend
+ && NILP (AREF (rfont_def, 0)))
+ {
+ struct font *font = XSAVE_VALUE (XCAR (AREF (rfont_def, 3)))->pointer;
- elt = FONTSET_REF_VIA_BASE (fontset, c);
- if (!NILP (elt))
- return XINT (elt);
+ face_id = face_for_font (f, font, face);
+ ASET (rfont_def, 0, make_number (face_id));
+ }
+ else
+#endif /* USE_FONT_BACKEND */
+ if (NILP (AREF (rfont_def, 0)))
+ {
+ /* We have not yet made a realized face that uses this font. */
+ int font_idx = XINT (AREF (rfont_def, 1));
- /* No face is recorded for C in the fontset of FACE. Make a new
- realized face for C that has the same fontset. */
- face_id = lookup_face (f, face->lface, c, face);
+ face_id = lookup_non_ascii_face (f, font_idx, face);
+ ASET (rfont_def, 0, make_number (face_id));
+ }
+ return XINT (AREF (rfont_def, 0));
+ }
- /* Record the face ID in FONTSET at the same index as the
- information in the base fontset. */
- FONTSET_SET (fontset, c, make_number (face_id));
- return face_id;
+ if (NILP (FONTSET_NOFONT_FACE (fontset)))
+ {
+ face_id = lookup_non_ascii_face (f, -1, face);
+ FONTSET_NOFONT_FACE (fontset) = make_number (face_id);
+ }
+ return XINT (FONTSET_NOFONT_FACE (fontset));
}
Called from realize_x_face. */
int
-make_fontset_for_ascii_face (f, base_fontset_id)
+make_fontset_for_ascii_face (f, base_fontset_id, face)
FRAME_PTR f;
int base_fontset_id;
+ struct face *face;
{
Lisp_Object base_fontset, fontset, frame;
if (!BASE_FONTSET_P (base_fontset))
base_fontset = FONTSET_BASE (base_fontset);
xassert (BASE_FONTSET_P (base_fontset));
+ if (! BASE_FONTSET_P (base_fontset))
+ abort ();
}
else
base_fontset = Vdefault_fontset;
fontset = make_fontset (frame, Qnil, base_fontset);
- return XINT (FONTSET_ID (fontset));
-}
-
-
-/* Return the font name pattern for C that is recorded in the fontset
- with ID. If a font name pattern is specified (instead of a cons of
- family and registry), check if a font can be opened by that pattern
- to get the fullname. If a font is opened, return that name.
- Otherwise, return nil. If ID is -1, or the fontset doesn't contain
- information about C, get the registry and encoding of C from the
- default fontset. Called from choose_face_font. */
+ {
+ Lisp_Object elt, rfont_def, val;
-Lisp_Object
-fontset_font_pattern (f, id, c)
- FRAME_PTR f;
- int id, c;
-{
- Lisp_Object fontset, elt;
- struct font_info *fontp;
+ elt = FONTSET_REF (base_fontset, 0);
+ xassert (VECTORP (elt) && ASIZE (elt) > 0);
+ rfont_def = Fmake_vector (make_number (4), Qnil);
+#ifdef USE_FONT_BACKEND
+ if (enable_font_backend && face->font_info)
+ {
+ struct font *font = (struct font *) face->font_info;
- elt = Qnil;
- if (fontset_id_valid_p (id))
+ ASET (rfont_def, 3, Fcons (font->entity, Qnil));
+ }
+ else
+#endif /* USE_FONT_BACKEND */
{
- fontset = FONTSET_FROM_ID (id);
- xassert (!BASE_FONTSET_P (fontset));
- fontset = FONTSET_BASE (fontset);
- if (! EQ (fontset, Vdefault_fontset))
- elt = FONTSET_REF (fontset, c);
+ ASET (rfont_def, 3, build_string (face->font_name));
}
- if (NILP (elt))
- {
- Lisp_Object frame;
-
- XSETFRAME (frame, f);
- elt = lookup_overriding_fontspec (frame, c);
- }
- if (NILP (elt))
- elt = FONTSET_REF (Vdefault_fontset, c);
-
- if (!CONSP (elt))
- return Qnil;
- if (CONSP (XCDR (elt)))
- return XCDR (elt);
-
- /* The fontset specifies only a font name pattern (not cons of
- family and registry). If a font can be opened by that pattern,
- return the name of opened font. Otherwise return nil. The
- exception is a font for single byte characters. In that case, we
- return a cons of FAMILY and REGISTRY extracted from the opened
- font name. */
- elt = XCDR (elt);
- xassert (STRINGP (elt));
- fontp = FS_LOAD_FONT (f, c, SDATA (elt), -1);
- if (!fontp)
- return Qnil;
-
- return font_family_registry (build_string (fontp->full_name),
- SINGLE_BYTE_CHAR_P (c));
+ ASET (rfont_def, 1, make_number (face->font_info_id));
+ ASET (rfont_def, 2, AREF (elt, 0));
+ elt = Fmake_vector (make_number (4), Qnil);
+ ASET (elt, 0, make_number (charset_ordered_list_tick));
+ ASET (elt, 1, make_number (charset_ascii));
+ ASET (elt, 2, rfont_def);
+ ASET (elt, 3, rfont_def);
+
+ val = Fcons (Qlatin, Qnil);
+ map_char_table (accumulate_script_ranges, Qnil, Vchar_script_table, val);
+ for (val = XCDR (val); CONSP (val); val = XCDR (val))
+ char_table_set_range (fontset, XINT (XCAR (XCAR (val))),
+ XINT (XCDR (XCAR (val))), elt);
+ FONTSET_FALLBACK (fontset) = elt;
+ }
+ return XINT (FONTSET_ID (fontset));
}
#pragma optimize("", off)
#endif
-/* Load a font named FONTNAME to display character C on frame F.
- Return a pointer to the struct font_info of the loaded font. If
- loading fails, return NULL. If FACE is non-zero and a fontset is
- assigned to it, record FACE->id in the fontset for C. If FONTNAME
- is NULL, the name is taken from the fontset of FACE or what
- specified by ID. */
+/* Load a font named FONTNAME on frame F. Return a pointer to the
+ struct font_info of the loaded font. If loading fails, return
+ NULL. CHARSET is an ID of charset to encode characters for this
+ font. If it is -1, find one from Vfont_encoding_alist. */
struct font_info *
-fs_load_font (f, c, fontname, id, face)
+fs_load_font (f, fontname, charset)
FRAME_PTR f;
- int c;
char *fontname;
- int id;
- struct face *face;
+ int charset;
{
- Lisp_Object fontset;
- Lisp_Object list, elt, fullname;
- int size = 0;
struct font_info *fontp;
- int charset = CHAR_CHARSET (c);
-
- if (face)
- id = face->fontset;
- if (id < 0)
- fontset = Qnil;
- else
- fontset = FONTSET_FROM_ID (id);
-
- if (!NILP (fontset)
- && !BASE_FONTSET_P (fontset))
- {
- elt = FONTSET_REF_VIA_BASE (fontset, c);
- if (!NILP (elt))
- {
- /* A suitable face for C is already recorded, which means
- that a proper font is already loaded. */
- int face_id = XINT (elt);
-
- xassert (face_id == face->id);
- face = FACE_FROM_ID (f, face_id);
- return (*get_font_info_func) (f, face->font_info_id);
- }
-
- if (!fontname && charset == CHARSET_ASCII)
- {
- elt = FONTSET_ASCII (fontset);
- fontname = SDATA (XCDR (elt));
- }
- }
+ Lisp_Object fullname;
if (!fontname)
/* No way to get fontname. */
- return 0;
+ return NULL;
- fontp = (*load_font_func) (f, fontname, size);
- if (!fontp)
- return 0;
-
- /* Fill in members (charset, vertical_centering, encoding, etc) of
- font_info structure that are not set by (*load_font_func). */
- fontp->charset = charset;
+ fontp = (*load_font_func) (f, fontname, 0);
+ if (! fontp || fontp->charset >= 0)
+ return fontp;
+ fontname = fontp->full_name;
fullname = build_string (fontp->full_name);
- fontp->vertical_centering
- = (STRINGP (Vvertical_centering_font_regexp)
- && (fast_string_match_ignore_case
- (Vvertical_centering_font_regexp, fullname) >= 0));
- if (fontp->encoding[1] != FONT_ENCODING_NOT_DECIDED)
+ if (charset < 0)
{
- /* The font itself tells which code points to be used. Use this
- encoding for all other charsets. */
- int i;
-
- fontp->encoding[0] = fontp->encoding[1];
- for (i = MIN_CHARSET_OFFICIAL_DIMENSION1; i <= MAX_CHARSET; i++)
- fontp->encoding[i] = fontp->encoding[1];
+ Lisp_Object charset_symbol;
+
+ charset_symbol = find_font_encoding (fullname);
+ if (CONSP (charset_symbol))
+ charset_symbol = XCAR (charset_symbol);
+ if (NILP (charset_symbol))
+ charset_symbol = Qascii;
+ charset = XINT (CHARSET_SYMBOL_ID (charset_symbol));
}
- else
- {
- /* The font itself doesn't have information about encoding. */
- int i;
+ fontp->charset = charset;
+ fontp->vertical_centering = 0;
+ fontp->font_encoder = NULL;
- /* By default, encoding of ASCII chars is 0 (i.e. 0x00..0x7F),
- others is 1 (i.e. 0x80..0xFF). */
- fontp->encoding[0] = 0;
- for (i = MIN_CHARSET_OFFICIAL_DIMENSION1; i <= MAX_CHARSET; i++)
- fontp->encoding[i] = 1;
- /* Then override them by a specification in Vfont_encoding_alist. */
- for (list = Vfont_encoding_alist; CONSP (list); list = XCDR (list))
- {
- elt = XCAR (list);
- if (CONSP (elt)
- && STRINGP (XCAR (elt)) && CONSP (XCDR (elt))
- && (fast_string_match_ignore_case (XCAR (elt), fullname) >= 0))
- {
- Lisp_Object tmp;
+ if (charset != charset_ascii)
+ {
+ fontp->vertical_centering
+ = (STRINGP (Vvertical_centering_font_regexp)
+ && (fast_string_match_ignore_case
+ (Vvertical_centering_font_regexp, fullname) >= 0));
- for (tmp = XCDR (elt); CONSP (tmp); tmp = XCDR (tmp))
- if (CONSP (XCAR (tmp))
- && ((i = get_charset_id (XCAR (XCAR (tmp))))
- >= 0)
- && INTEGERP (XCDR (XCAR (tmp)))
- && XFASTINT (XCDR (XCAR (tmp))) < 4)
- fontp->encoding[i]
- = XFASTINT (XCDR (XCAR (tmp)));
- }
- }
+ if (find_ccl_program_func)
+ (*find_ccl_program_func) (fontp);
}
- if (! fontp->font_encoder && find_ccl_program_func)
- (*find_ccl_program_func) (fontp);
-
- /* If we loaded a font for a face that has fontset, record the face
- ID in the fontset for C. */
- if (face
- && !NILP (fontset)
- && !BASE_FONTSET_P (fontset))
- FONTSET_SET (fontset, c, make_number (face->id));
return fontp;
}
#pragma optimize("", on)
#endif
-/* Set the ASCII font of the default fontset to FONTNAME if that is
- not yet set. */
-void
-set_default_ascii_font (fontname)
+\f
+/* Return ENCODING or a cons of ENCODING and REPERTORY of the font
+ FONTNAME. ENCODING is a charset symbol that specifies the encoding
+ of the font. REPERTORY is a charset symbol or nil. */
+
+
+Lisp_Object
+find_font_encoding (fontname)
Lisp_Object fontname;
{
- if (! CONSP (FONTSET_ASCII (Vdefault_fontset)))
- {
- int id = fs_query_fontset (fontname, 2);
+ Lisp_Object tail, elt;
- if (id >= 0)
- fontname = XCDR (FONTSET_ASCII (FONTSET_FROM_ID (id)));
- FONTSET_ASCII (Vdefault_fontset)
- = Fcons (make_number (0), fontname);
+ for (tail = Vfont_encoding_alist; CONSP (tail); tail = XCDR (tail))
+ {
+ elt = XCAR (tail);
+ if (CONSP (elt)
+ && STRINGP (XCAR (elt))
+ && fast_string_match_ignore_case (XCAR (elt), fontname) >= 0
+ && (SYMBOLP (XCDR (elt))
+ ? CHARSETP (XCDR (elt))
+ : CONSP (XCDR (elt)) && CHARSETP (XCAR (XCDR (elt)))))
+ return (XCDR (elt));
}
+ /* We don't know the encoding of this font. Let's assume `ascii'. */
+ return Qascii;
}
-\f
+
/* Cache data used by fontset_pattern_regexp. The car part is a
pattern string containing at least one wild card, the cdr part is
the corresponding regular expression. */
if (name_pattern != 1)
{
tem = Frassoc (name, Vfontset_alias_alist);
+ if (NILP (tem))
+ tem = Fassoc (name, Vfontset_alias_alist);
if (CONSP (tem) && STRINGP (XCAR (tem)))
name = XCAR (tem);
else if (name_pattern == 0)
return FONTSET_NAME (fontset);
}
-/* Return a list of base fontset names matching PATTERN on frame F.
- If SIZE is not 0, it is the size (maximum bound width) of fontsets
- to be listed. */
+/* Return a list of base fontset names matching PATTERN on frame F. */
+
+Lisp_Object
+list_fontsets (f, pattern, size)
+ FRAME_PTR f;
+ Lisp_Object pattern;
+ int size;
+{
+ Lisp_Object frame, regexp, val;
+ int id;
+
+ XSETFRAME (frame, f);
+
+ regexp = fontset_pattern_regexp (pattern);
+ val = Qnil;
+
+ for (id = 0; id < ASIZE (Vfontset_table); id++)
+ {
+ Lisp_Object fontset, name;
+
+ fontset = FONTSET_FROM_ID (id);
+ if (NILP (fontset)
+ || !BASE_FONTSET_P (fontset)
+ || !EQ (frame, FONTSET_FRAME (fontset)))
+ continue;
+ name = FONTSET_NAME (fontset);
+
+ if (STRINGP (regexp)
+ ? (fast_string_match (regexp, name) < 0)
+ : strcmp (SDATA (pattern), SDATA (name)))
+ continue;
+
+ val = Fcons (Fcopy_sequence (FONTSET_NAME (fontset)), val);
+ }
+
+ return val;
+}
+
+
+/* Free all realized fontsets whose base fontset is BASE. */
+
+static void
+free_realized_fontsets (base)
+ Lisp_Object base;
+{
+ int id;
+
+#if 0
+ /* For the moment, this doesn't work because free_realized_face
+ doesn't remove FACE from a cache. Until we find a solution, we
+ suppress this code, and simply use Fclear_face_cache even though
+ that is not efficient. */
+ BLOCK_INPUT;
+ for (id = 0; id < ASIZE (Vfontset_table); id++)
+ {
+ Lisp_Object this = AREF (Vfontset_table, id);
+
+ if (EQ (FONTSET_BASE (this), base))
+ {
+ Lisp_Object tail;
+
+ for (tail = FONTSET_FACE_ALIST (this); CONSP (tail);
+ tail = XCDR (tail))
+ {
+ FRAME_PTR f = XFRAME (FONTSET_FRAME (this));
+ int face_id = XINT (XCDR (XCAR (tail)));
+ struct face *face = FACE_FROM_ID (f, face_id);
+
+ /* Face THIS itself is also freed by the following call. */
+ free_realized_face (f, face);
+ }
+ }
+ }
+ UNBLOCK_INPUT;
+#else /* not 0 */
+ /* But, we don't have to call Fclear_face_cache if no fontset has
+ been realized from BASE. */
+ for (id = 0; id < ASIZE (Vfontset_table); id++)
+ {
+ Lisp_Object this = AREF (Vfontset_table, id);
+
+ if (CHAR_TABLE_P (this) && EQ (FONTSET_BASE (this), base))
+ {
+ Fclear_face_cache (Qt);
+ break;
+ }
+ }
+#endif /* not 0 */
+}
+
+
+/* Check validity of NAME as a fontset name and return the
+ corresponding fontset. If not valid, signal an error.
+ If NAME is t, return Vdefault_fontset. */
+
+static Lisp_Object
+check_fontset_name (name)
+ Lisp_Object name;
+{
+ int id;
+
+ if (EQ (name, Qt))
+ return Vdefault_fontset;
+
+ CHECK_STRING (name);
+ /* First try NAME as literal. */
+ id = fs_query_fontset (name, 2);
+ if (id < 0)
+ /* For backward compatibility, try again NAME as pattern. */
+ id = fs_query_fontset (name, 0);
+ if (id < 0)
+ error ("Fontset `%s' does not exist", SDATA (name));
+ return FONTSET_FROM_ID (id);
+}
+
+static void
+accumulate_script_ranges (arg, range, val)
+ Lisp_Object arg, range, val;
+{
+ if (EQ (XCAR (arg), val))
+ {
+ if (CONSP (range))
+ XSETCDR (arg, Fcons (Fcons (XCAR (range), XCDR (range)), XCDR (arg)));
+ else
+ XSETCDR (arg, Fcons (Fcons (range, range), XCDR (arg)));
+ }
+}
+
+
+/* Return an ASCII font name generated from fontset name NAME and
+ font-spec ASCII_SPEC. NAME is a string conforming to XLFD. */
+
+static INLINE Lisp_Object
+generate_ascii_font_name (name, ascii_spec)
+ Lisp_Object name, ascii_spec;
+{
+ Lisp_Object font_spec = Ffont_spec (0, NULL);
+ Lisp_Object vec;
+ int i;
+ char xlfd[256];
+
+ if (font_parse_xlfd (SDATA (name), font_spec) < 0)
+ error ("Not an XLFD font name: %s", SDATA (name));
+ for (i = FONT_FOUNDRY_INDEX; i <= FONT_WIDTH_INDEX; i++)
+ if (! NILP (AREF (ascii_spec, i)))
+ ASET (font_spec, i, AREF (ascii_spec, i));
+ i = font_unparse_xlfd (font_spec, 0, xlfd, 256);
+ if (i < 0)
+ error ("Not an XLFD font name: %s", SDATA (name));
+ return make_unibyte_string (xlfd, i);
+}
+
+/* Variables referred in set_fontset_font. They are set before
+ map_charset_chars is called in Fset_fontset_font. */
+static Lisp_Object font_def_arg, add_arg;
+static int from_arg, to_arg;
+
+/* Callback function for map_charset_chars in Fset_fontset_font. In
+ FONTSET, set font_def_arg in a fashion specified by add_arg for
+ characters in RANGE while ignoring the range between from_arg and
+ to_arg. */
+
+static void
+set_fontset_font (fontset, range)
+ Lisp_Object fontset, range;
+{
+ if (from_arg < to_arg)
+ {
+ int from = XINT (XCAR (range)), to = XINT (XCDR (range));
+
+ if (from < from_arg)
+ {
+ if (to > to_arg)
+ {
+ Lisp_Object range2;
+
+ range2 = Fcons (make_number (to_arg), XCDR (range));
+ FONTSET_ADD (fontset, range, font_def_arg, add_arg);
+ to = to_arg;
+ }
+ if (to > from_arg)
+ range = Fcons (XCAR (range), make_number (from_arg));
+ }
+ else if (to <= to_arg)
+ return;
+ else
+ {
+ if (from < to_arg)
+ range = Fcons (make_number (to_arg), XCDR (range));
+ }
+ }
+ FONTSET_ADD (fontset, range, font_def_arg, add_arg);
+}
+
+extern Lisp_Object QCfamily, QCregistry;
+
+DEFUN ("set-fontset-font", Fset_fontset_font, Sset_fontset_font, 3, 5, 0,
+ doc: /*
+Modify fontset NAME to use FONT-SPEC for TARGET characters.
+
+TARGET may be a cons; (FROM . TO), where FROM and TO are characters.
+In that case, use FONT-SPEC for all characters in the range FROM and
+TO (inclusive).
+
+TARGET may be a script name symbol. In that case, use FONT-SPEC for
+all characters that belong to the script.
+
+TARGET may be a charset. In that case, use FONT-SPEC for all
+characters in the charset.
+
+TARGET may be nil. In that case, use FONT-SPEC for any characters for
+that no FONT-SPEC is specified.
+
+FONT-SPEC may one of these:
+ * A cons (FAMILY . REGISTRY), where FAMILY is a font family name and
+ REGISTRY is a font registry name. FAMILY may contains foundry
+ name, and REGISTRY may contains encoding name.
+ * A font name string.
-Lisp_Object
-list_fontsets (f, pattern, size)
- FRAME_PTR f;
- Lisp_Object pattern;
- int size;
+Optional 4th argument FRAME, if non-nil, is a frame. This argument is
+kept for backward compatibility and has no meaning.
+
+Optional 5th argument ADD, if non-nil, specifies how to add FONT-SPEC
+to the font specifications for TARGET previously set. If it is
+`prepend', FONT-SPEC is prepended. If it is `append', FONT-SPEC is
+appended. By default, FONT-SPEC overrides the previous settings. */)
+ (name, target, font_spec, frame, add)
+ Lisp_Object name, target, font_spec, frame, add;
{
- Lisp_Object frame, regexp, val;
- int id;
+ Lisp_Object fontset;
+ Lisp_Object font_def, registry, family;
+ Lisp_Object encoding, repertory;
+ Lisp_Object range_list;
+ struct charset *charset = NULL;
- XSETFRAME (frame, f);
+ fontset = check_fontset_name (name);
- regexp = fontset_pattern_regexp (pattern);
- val = Qnil;
+ /* The arg FRAME is kept for backward compatibility. We only check
+ the validity. */
+ if (!NILP (frame))
+ CHECK_LIVE_FRAME (frame);
- for (id = 0; id < ASIZE (Vfontset_table); id++)
+ if (VECTORP (font_spec))
{
- Lisp_Object fontset, name;
-
- fontset = FONTSET_FROM_ID (id);
- if (NILP (fontset)
- || !BASE_FONTSET_P (fontset)
- || !EQ (frame, FONTSET_FRAME (fontset)))
- continue;
- name = FONTSET_NAME (fontset);
+ if (! FONT_SPEC_P (font_spec))
+ Fsignal (Qfont, list2 (build_string ("invalid font-spec"), font_spec));
+ }
+ else if (CONSP (font_spec))
+ {
+ Lisp_Object args[4];
+ int i= 0;
- if (!NILP (regexp)
- ? (fast_string_match (regexp, name) < 0)
- : strcmp (SDATA (pattern), SDATA (name)))
- continue;
+ family = XCAR (font_spec);
+ registry = XCDR (font_spec);
- if (size)
+ if (! NILP (family))
{
- struct font_info *fontp;
- fontp = FS_LOAD_FONT (f, 0, NULL, id);
- if (!fontp || size != fontp->size)
- continue;
+ CHECK_STRING (family);
+ args[i++] = QCfamily;
+ args[i++] = family;
}
- val = Fcons (Fcopy_sequence (FONTSET_NAME (fontset)), val);
+ CHECK_STRING (registry);
+ args[i++] = QCregistry;
+ args[i++] = registry;
+ font_spec = Ffont_spec (i, args);
}
+ else
+ {
+ Lisp_Object args[2];
- return val;
-}
-
-DEFUN ("new-fontset", Fnew_fontset, Snew_fontset, 2, 2, 0,
- doc: /* Create a new fontset NAME that contains font information in FONTLIST.
-FONTLIST is an alist of charsets vs corresponding font name patterns. */)
- (name, fontlist)
- Lisp_Object name, fontlist;
-{
- Lisp_Object fontset, elements, ascii_font;
- Lisp_Object tem, tail, elt;
- int id;
+ CHECK_STRING (font_spec);
+ args[0] = QCname;
+ args[1] = font_spec;
+ font_spec = Ffont_spec (2, args);
+ }
- (*check_window_system_func) ();
+ family = AREF (font_spec, FONT_FAMILY_INDEX);
+ if (! NILP (family) && SYMBOLP (family))
+ family = SYMBOL_NAME (family);
+ registry = AREF (font_spec, FONT_REGISTRY_INDEX);
+ if (! NILP (registry) && SYMBOLP (registry))
+ registry = SYMBOL_NAME (registry);
- CHECK_STRING (name);
- CHECK_LIST (fontlist);
+ encoding = find_font_encoding (concat2 (family, registry));
+ if (NILP (encoding))
+ encoding = Qascii;
- name = Fdowncase (name);
- id = fs_query_fontset (name, 2);
- if (id >= 0)
+ if (SYMBOLP (encoding))
{
- fontset = FONTSET_FROM_ID (id);
- tem = FONTSET_NAME (fontset);
- error ("Fontset `%s' matches the existing fontset `%s'",
- SDATA (name), SDATA (tem));
+ CHECK_CHARSET (encoding);
+ encoding = repertory = CHARSET_SYMBOL_ID (encoding);
+ }
+ else
+ {
+ repertory = XCDR (encoding);
+ encoding = XCAR (encoding);
+ CHECK_CHARSET (encoding);
+ encoding = CHARSET_SYMBOL_ID (encoding);
+ if (! NILP (repertory) && SYMBOLP (repertory))
+ {
+ CHECK_CHARSET (repertory);
+ repertory = CHARSET_SYMBOL_ID (repertory);
+ }
}
+ font_def = Fmake_vector (make_number (3), font_spec);
+ ASET (font_def, 1, encoding);
+ ASET (font_def, 2, repertory);
- /* Check the validity of FONTLIST while creating a template for
- fontset elements. */
- elements = ascii_font = Qnil;
- for (tail = fontlist; CONSP (tail); tail = XCDR (tail))
+ if (CHARACTERP (target))
+ range_list = Fcons (Fcons (target, target), Qnil);
+ else if (CONSP (target))
{
- int c, charset;
+ Lisp_Object from, to;
- tem = XCAR (tail);
- if (!CONSP (tem)
- || (charset = get_charset_id (XCAR (tem))) < 0
- || (!STRINGP (XCDR (tem)) && !CONSP (XCDR (tem))))
- error ("Elements of fontlist must be a cons of charset and font name pattern");
+ from = Fcar (target);
+ to = Fcdr (target);
+ CHECK_CHARACTER (from);
+ CHECK_CHARACTER (to);
+ range_list = Fcons (target, Qnil);
+ }
+ else if (SYMBOLP (target) && !NILP (target))
+ {
+ Lisp_Object script_list;
+ Lisp_Object val;
- tem = XCDR (tem);
- if (STRINGP (tem))
- tem = Fdowncase (tem);
- else
- tem = Fcons (Fdowncase (Fcar (tem)), Fdowncase (Fcdr (tem)));
- if (charset == CHARSET_ASCII)
- ascii_font = tem;
- else
+ range_list = Qnil;
+ script_list = XCHAR_TABLE (Vchar_script_table)->extras[0];
+ if (! NILP (Fmemq (target, script_list)))
+ {
+ val = Fcons (target, Qnil);
+ map_char_table (accumulate_script_ranges, Qnil, Vchar_script_table,
+ val);
+ range_list = XCDR (val);
+ if (EQ (target, Qlatin))
+ {
+ if (VECTORP (font_spec))
+ val = generate_ascii_font_name (FONTSET_NAME (fontset),
+ font_spec);
+ else
+ val = font_spec;
+ FONTSET_ASCII (fontset) = val;
+ }
+ }
+ if (CHARSETP (target))
{
- c = MAKE_CHAR (charset, 0, 0);
- elements = Fcons (Fcons (make_number (c), tem), elements);
+ if (EQ (target, Qascii))
+ {
+ if (VECTORP (font_spec))
+ font_spec = generate_ascii_font_name (FONTSET_NAME (fontset),
+ font_spec);
+ FONTSET_ASCII (fontset) = font_spec;
+ range_list = Fcons (Fcons (make_number (0), make_number (127)),
+ Qnil);
+ }
+ else
+ {
+ CHECK_CHARSET_GET_CHARSET (target, charset);
+ }
}
+ else if (NILP (range_list))
+ error ("Invalid script or charset name: %s",
+ SDATA (SYMBOL_NAME (target)));
}
+ else if (NILP (target))
+ range_list = Fcons (Qnil, Qnil);
+ else
+ error ("Invalid target for setting a font");
- if (NILP (ascii_font))
- error ("No ASCII font in the fontlist");
- fontset = make_fontset (Qnil, name, Qnil);
- FONTSET_ASCII (fontset) = Fcons (make_number (0), ascii_font);
- for (; CONSP (elements); elements = XCDR (elements))
+ if (charset)
{
- elt = XCAR (elements);
- tem = XCDR (elt);
- if (STRINGP (tem))
- tem = font_family_registry (tem, 0);
- tem = Fcons (XCAR (elt), tem);
- FONTSET_SET (fontset, XINT (XCAR (elt)), tem);
+ font_def_arg = font_def;
+ add_arg = add;
+ if (NILP (range_list))
+ from_arg = to_arg = 0;
+ else
+ from_arg = XINT (XCAR (XCAR (range_list))),
+ to_arg = XINT (XCDR (XCAR (range_list)));
+
+ map_charset_chars (set_fontset_font, Qnil, fontset, charset,
+ CHARSET_MIN_CODE (charset),
+ CHARSET_MAX_CODE (charset));
}
+ for (; CONSP (range_list); range_list = XCDR (range_list))
+ FONTSET_ADD (fontset, XCAR (range_list), font_def, add);
+
+ /* Free all realized fontsets whose base is FONTSET. This way, the
+ specified character(s) are surely redisplayed by a correct
+ font. */
+ free_realized_fontsets (fontset);
return Qnil;
}
-/* Clear all elements of FONTSET for multibyte characters. */
-
-static void
-clear_fontset_elements (fontset)
- Lisp_Object fontset;
-{
- int i;
-
- for (i = CHAR_TABLE_SINGLE_BYTE_SLOTS; i < CHAR_TABLE_ORDINARY_SLOTS; i++)
- XCHAR_TABLE (fontset)->contents[i] = Qnil;
-}
+DEFUN ("new-fontset", Fnew_fontset, Snew_fontset, 2, 2, 0,
+ doc: /* Create a new fontset NAME from font information in FONTLIST.
+FONTLIST is an alist of scripts vs the corresponding font specification list.
+Each element of FONTLIST has the form (SCRIPT FONT-SPEC ...), where a
+character of SCRIPT is displayed by a font that matches one of
+FONT-SPEC.
-/* Check validity of NAME as a fontset name and return the
- corresponding fontset. If not valid, signal an error.
- If NAME is nil, return Vdefault_fontset. */
+SCRIPT is a symbol that appears in the first extra slot of the
+char-table `char-script-table'.
-static Lisp_Object
-check_fontset_name (name)
- Lisp_Object name;
+FONT-SPEC is a vector, a cons, or a string. See the documentation of
+`set-fontset-font' for the meaning. */)
+ (name, fontlist)
+ Lisp_Object name, fontlist;
{
+ Lisp_Object fontset;
+ Lisp_Object val;
int id;
- if (EQ (name, Qnil))
- return Vdefault_fontset;
-
CHECK_STRING (name);
- /* First try NAME as literal. */
- id = fs_query_fontset (name, 2);
- if (id < 0)
- /* For backward compatibility, try again NAME as pattern. */
- id = fs_query_fontset (name, 0);
- if (id < 0)
- error ("Fontset `%s' does not exist", SDATA (name));
- return FONTSET_FROM_ID (id);
-}
-
-/* Downcase FONTNAME or car and cdr of FONTNAME. If FONTNAME is a
- string, maybe change FONTNAME to (FAMILY . REGISTRY). */
-
-static Lisp_Object
-regularize_fontname (Lisp_Object fontname)
-{
- Lisp_Object family, registry;
-
- if (STRINGP (fontname))
- return font_family_registry (Fdowncase (fontname), 0);
+ CHECK_LIST (fontlist);
- CHECK_CONS (fontname);
- family = XCAR (fontname);
- registry = XCDR (fontname);
- if (!NILP (family))
+ id = fs_query_fontset (name, 0);
+ if (id < 0)
+ {
+ name = Fdowncase (name);
+ val = split_font_name_into_vector (name);
+ if (NILP (val) || NILP (AREF (val, 12)) || NILP (AREF (val, 13)))
+ error ("Fontset name must be in XLFD format");
+ if (strcmp (SDATA (AREF (val, 12)), "fontset"))
+ error ("Registry field of fontset name must be \"fontset\"");
+ Vfontset_alias_alist
+ = Fcons (Fcons (name,
+ concat2 (concat2 (AREF (val, 12), build_string ("-")),
+ AREF (val, 13))),
+ Vfontset_alias_alist);
+ ASET (val, 12, build_string ("iso8859-1"));
+ fontset = make_fontset (Qnil, name, Qnil);
+ FONTSET_ASCII (fontset) = build_font_name_from_vector (val);
+ }
+ else
{
- CHECK_STRING (family);
- family = Fdowncase (family);
+ fontset = FONTSET_FROM_ID (id);;
+ free_realized_fontsets (fontset);
+ Fset_char_table_range (fontset, Qt, Qnil);
}
- if (!NILP (registry))
+
+ for (; ! NILP (fontlist); fontlist = Fcdr (fontlist))
{
- CHECK_STRING (registry);
- registry = Fdowncase (registry);
+ Lisp_Object elt, script;
+
+ elt = Fcar (fontlist);
+ script = Fcar (elt);
+ elt = Fcdr (elt);
+ if (CONSP (elt) && (NILP (XCDR (elt)) || CONSP (XCDR (elt))))
+ for (; CONSP (elt); elt = XCDR (elt))
+ Fset_fontset_font (name, script, XCAR (elt), Qnil, Qappend);
+ else
+ Fset_fontset_font (name, script, elt, Qnil, Qappend);
}
- return Fcons (family, registry);
+ return name;
}
-DEFUN ("set-fontset-font", Fset_fontset_font, Sset_fontset_font, 3, 4, 0,
- doc: /* Modify fontset NAME to use FONTNAME for CHARACTER.
-If NAME is nil, modify the default fontset.
-CHARACTER may be a cons; (FROM . TO), where FROM and TO are
-non-generic characters. In that case, use FONTNAME
-for all characters in the range FROM and TO (inclusive).
-CHARACTER may be a charset. In that case, use FONTNAME
-for all character in the charsets.
+/* Alist of automatically created fontsets. Each element is a cons
+ (FONTNAME . FONTSET-ID). */
+static Lisp_Object auto_fontset_alist;
-FONTNAME may be a cons; (FAMILY . REGISTRY), where FAMILY is a family
-name of a font, REGISTRY is a registry name of a font. */)
- (name, character, fontname, frame)
- Lisp_Object name, character, fontname, frame;
+int
+new_fontset_from_font_name (Lisp_Object fontname)
{
- Lisp_Object fontset, elt;
- Lisp_Object realized;
- int from, to;
+ Lisp_Object val;
+ Lisp_Object name;
+ Lisp_Object vec;
int id;
- fontset = check_fontset_name (name);
+ fontname = Fdowncase (fontname);
+ val = Fassoc (fontname, auto_fontset_alist);
+ if (CONSP (val))
+ return XINT (XCDR (val));
- if (CONSP (character))
+ vec = split_font_name_into_vector (fontname);
+ if ( NILP (vec))
+ vec = Fmake_vector (make_number (14), build_string (""));
+ ASET (vec, 12, build_string ("fontset"));
+ if (NILP (auto_fontset_alist))
{
- /* CH should be (FROM . TO) where FROM and TO are non-generic
- characters. */
- CHECK_NUMBER_CAR (character);
- CHECK_NUMBER_CDR (character);
- from = XINT (XCAR (character));
- to = XINT (XCDR (character));
- if (!char_valid_p (from, 0) || !char_valid_p (to, 0))
- error ("Character range should be by non-generic characters");
- if (!NILP (name)
- && (SINGLE_BYTE_CHAR_P (from) || SINGLE_BYTE_CHAR_P (to)))
- error ("Can't change font for a single byte character");
+ ASET (vec, 13, build_string ("startup"));
+ name = build_font_name_from_vector (vec);
}
- else if (SYMBOLP (character))
+ else
{
- elt = Fget (character, Qcharset);
- if (!VECTORP (elt) || ASIZE (elt) < 1 || !NATNUMP (AREF (elt, 0)))
- error ("Invalid charset: %s", SDATA (SYMBOL_NAME (character)));
- from = MAKE_CHAR (XINT (AREF (elt, 0)), 0, 0);
- to = from;
+ char temp[20];
+ int len = XINT (Flength (auto_fontset_alist));
+
+ sprintf (temp, "auto%d", len);
+ ASET (vec, 13, build_string (temp));
+ name = build_font_name_from_vector (vec);
}
+ name = Fnew_fontset (name, list2 (list2 (Qascii, fontname),
+ list2 (Fcons (make_number (0),
+ make_number (MAX_CHAR)),
+ fontname)));
+ id = fs_query_fontset (name, 0);
+ auto_fontset_alist
+ = Fcons (Fcons (fontname, make_number (id)), auto_fontset_alist);
+ return id;
+}
+
+#ifdef USE_FONT_BACKEND
+int
+new_fontset_from_font (font_object)
+ Lisp_Object font_object;
+{
+ Lisp_Object font_name = font_get_name (font_object);
+ Lisp_Object font_spec = font_get_spec (font_object);
+ Lisp_Object fontset_spec, short_name, name, fontset;
+
+ if (NILP (auto_fontset_alist))
+ short_name = build_string ("fontset-startup");
else
{
- CHECK_NUMBER (character);
- from = XINT (character);
- to = from;
+ char temp[32];
+ int len = XINT (Flength (auto_fontset_alist));
+
+ sprintf (temp, "fontset-auto%d", len);
+ short_name = build_string (temp);
}
- if (!char_valid_p (from, 1))
- invalid_character (from);
- if (SINGLE_BYTE_CHAR_P (from))
- error ("Can't change font for a single byte character");
- if (from < to)
+ fontset_spec = Fcopy_sequence (font_spec);
+ ASET (fontset_spec, FONT_REGISTRY_INDEX, short_name);
+ name = Ffont_xlfd_name (fontset_spec);
+ if (NILP (name))
{
- if (!char_valid_p (to, 1))
- invalid_character (to);
- if (SINGLE_BYTE_CHAR_P (to))
- error ("Can't change font for a single byte character");
- }
+ int i;
- /* The arg FRAME is kept for backward compatibility. We only check
- the validity. */
- if (!NILP (frame))
- CHECK_LIVE_FRAME (frame);
+ for (i = 0; i < FONT_SIZE_INDEX; i++)
+ if ((i != FONT_FAMILY_INDEX) && (i != FONT_REGISTRY_INDEX))
+ ASET (fontset_spec, i, Qnil);
+ name = Ffont_xlfd_name (fontset_spec);
+ if (NILP (name))
+ abort ();
+ }
+ fontset = make_fontset (Qnil, name, Qnil);
+ FONTSET_ASCII (fontset) = font_name;
+ font_spec = Fcons (SYMBOL_NAME (AREF (font_spec, FONT_FAMILY_INDEX)),
+ SYMBOL_NAME (AREF (font_spec, FONT_REGISTRY_INDEX)));
+ Fset_fontset_font (name, Qlatin, font_spec, Qnil, Qnil);
+ Fset_fontset_font (name, Qnil, font_spec, Qnil, Qnil);
+ return XINT (FONTSET_ID (fontset));
+}
- elt = Fcons (make_number (from), regularize_fontname (fontname));
- for (; from <= to; from++)
- FONTSET_SET (fontset, from, elt);
- Foptimize_char_table (fontset);
+struct font *
+fontset_ascii_font (f, id)
+ FRAME_PTR f;
+ int id;
+{
+ Lisp_Object fontset = FONTSET_FROM_ID (id);
+ Lisp_Object ascii_slot = FONTSET_ASCII (fontset);
+ Lisp_Object val, font_object;
- /* If there's a realized fontset REALIZED whose parent is FONTSET,
- clear all the elements of REALIZED and free all multibyte faces
- whose fontset is REALIZED. This way, the specified character(s)
- are surely redisplayed by a correct font. */
- for (id = 0; id < ASIZE (Vfontset_table); id++)
+ if (CONSP (ascii_slot))
{
- realized = AREF (Vfontset_table, id);
- if (!NILP (realized)
- && !BASE_FONTSET_P (realized)
- && EQ (FONTSET_BASE (realized), fontset))
+ Lisp_Object ascii_font_name = XCAR (ascii_slot);
+
+ font_object = Qnil;
+ for (val = XCDR (ascii_slot); ! NILP (val); val = XCDR (val))
+ {
+ Lisp_Object frame = font_get_frame (XCAR (val));
+
+ if (NILP (frame) || XFRAME (frame) == f)
+ {
+ font_object = XCAR (val);
+ if (XSAVE_VALUE (font_object)->integer == 0)
+ {
+ font_object = font_open_by_name (f, SDATA (ascii_font_name));
+ XSETCAR (val, font_object);
+ }
+ break;
+ }
+ }
+ if (NILP (font_object))
{
- FRAME_PTR f = XFRAME (FONTSET_FRAME (realized));
- clear_fontset_elements (realized);
- free_realized_multibyte_face (f, id);
+ font_object = font_open_by_name (f, SDATA (ascii_font_name));
+ XSETCDR (ascii_slot, Fcons (font_object, XCDR (ascii_slot)));
}
}
-
- return Qnil;
+ else
+ {
+ font_object = font_open_by_name (f, SDATA (ascii_slot));
+ FONTSET_ASCII (fontset) = Fcons (ascii_slot, Fcons (font_object, Qnil));
+ }
+ if (NILP (font_object))
+ return NULL;
+ return XSAVE_VALUE (font_object)->pointer;
}
+#endif /* USE_FONT_BACKEND */
+
DEFUN ("font-info", Ffont_info, Sfont_info, 1, 2, 0,
doc: /* Return information about a font named NAME on frame FRAME.
If FRAME is omitted or nil, use the selected frame.
FRAME_PTR f;
struct font_info *fontp;
Lisp_Object info;
+ Lisp_Object font_object;
(*check_window_system_func) ();
if (!query_font_func)
error ("Font query function is not supported");
+#ifdef USE_FONT_BACKEND
+ if (enable_font_backend)
+ {
+ font_object = font_open_by_name (f, SDATA (name));
+ if (NILP (font_object))
+ fontp = NULL;
+ else
+ fontp = (struct font_info *) XSAVE_VALUE (font_object)->pointer;
+ }
+ else
+#endif /* USE_FONT_BACKEND */
fontp = (*query_font_func) (f, SDATA (name));
if (!fontp)
return Qnil;
XVECTOR (info)->contents[5] = make_number (fontp->relative_compose);
XVECTOR (info)->contents[6] = make_number (fontp->default_ascent);
+#ifdef USE_FONT_BACKEND
+ if (! NILP (font_object))
+ font_close_object (f, font_object);
+#endif /* USE_FONT_BACKEND */
return info;
}
{
int pos, pos_byte, dummy;
int face_id;
- int c, code;
+ int c;
struct frame *f;
struct face *face;
+ Lisp_Object charset, rfont_def;
+ int cs_id;
if (NILP (position))
{
- CHECK_NATNUM (ch);
+ CHECK_CHARACTER (ch);
c = XINT (ch);
f = XFRAME (selected_frame);
face_id = DEFAULT_FACE_ID;
+ pos = -1;
+ cs_id = -1;
}
else
{
- Lisp_Object window;
+ Lisp_Object window, charset;
struct window *w;
CHECK_NUMBER_COERCE_MARKER (position);
w = XWINDOW (window);
f = XFRAME (w->frame);
face_id = face_at_buffer_position (w, pos, -1, -1, &dummy, pos + 100, 0);
+ charset = Fget_char_property (position, Qcharset, Qnil);
+ if (CHARSETP (charset))
+ cs_id = XINT (CHARSET_SYMBOL_ID (charset));
+ else
+ cs_id = -1;
}
if (! CHAR_VALID_P (c, 0))
return Qnil;
- face_id = FACE_FOR_CHAR (f, FACE_FROM_ID (f, face_id), c);
+ face_id = FACE_FOR_CHAR (f, FACE_FROM_ID (f, face_id), c, pos, Qnil);
face = FACE_FROM_ID (f, face_id);
- if (! face->font || ! face->font_name)
- return Qnil;
-
- {
- struct font_info *fontp = (*get_font_info_func) (f, face->font_info_id);
- XChar2b char2b;
- int c1, c2, charset;
-
- SPLIT_CHAR (c, charset, c1, c2);
- if (c2 > 0)
- STORE_XCHAR2B (&char2b, c1, c2);
- else
- STORE_XCHAR2B (&char2b, 0, c1);
- FRAME_RIF (f)->encode_char (c, &char2b, fontp, NULL);
- code = (XCHAR2B_BYTE1 (&char2b) << 8) | XCHAR2B_BYTE2 (&char2b);
- }
- return Fcons (build_string (face->font_name), make_number (code));
+ rfont_def = fontset_font (FONTSET_FROM_ID (face->fontset), c, face, cs_id);
+#ifdef USE_FONT_BACKEND
+ if (enable_font_backend)
+ {
+ if (VECTORP (rfont_def) && ! NILP (AREF (rfont_def, 3)))
+ {
+ Lisp_Object font_object = XCAR (AREF (rfont_def, 3));
+ struct font *font = XSAVE_VALUE (font_object)->pointer;
+ unsigned code = font->driver->encode_char (font, c);
+ Lisp_Object fontname = font_get_name (font_object);
+
+ if (code == FONT_INVALID_CODE)
+ return Fcons (fontname, Qnil);
+ if (code <= MOST_POSITIVE_FIXNUM)
+ return Fcons (fontname, make_number (code));
+ return Fcons (fontname, Fcons (make_number (code >> 16),
+ make_number (code & 0xFFFF)));
+ }
+ return Qnil;
+ }
+#endif /* USE_FONT_BACKEND */
+ if (VECTORP (rfont_def) && STRINGP (AREF (rfont_def, 3)))
+ {
+ Lisp_Object font_def;
+ struct font_info *fontp;
+ struct charset *charset;
+ XChar2b char2b;
+ int code;
+
+ font_def = AREF (rfont_def, 2);
+ charset = CHARSET_FROM_ID (XINT (AREF (font_def, 1)));
+ code = ENCODE_CHAR (charset, c);
+ if (code == CHARSET_INVALID_CODE (charset))
+ return (Fcons (AREF (rfont_def, 3), Qnil));
+ STORE_XCHAR2B (&char2b, ((code >> 8) & 0xFF), (code & 0xFF));
+ fontp = (*get_font_info_func) (f, XINT (AREF (rfont_def, 1)));
+ FRAME_RIF (f)->encode_char (c, &char2b, fontp, charset, NULL);
+ code = (XCHAR2B_BYTE1 (&char2b) << 8) | XCHAR2B_BYTE2 (&char2b);
+ return (Fcons (AREF (rfont_def, 3), make_number (code)));
+ }
+ return Qnil;
}
-/* Called from Ffontset_info via map_char_table on each leaf of
- fontset. ARG is a copy of the default fontset. The current leaf
- is indexed by CHARACTER and has value ELT. This function override
- the copy by ELT if ELT is not nil. */
-
-static void
-override_font_info (fontset, character, elt)
- Lisp_Object fontset, character, elt;
-{
- if (! NILP (elt))
- Faset (fontset, character, elt);
-}
+DEFUN ("fontset-info", Ffontset_info, Sfontset_info, 1, 2, 0,
+ doc: /* Return information about a fontset FONTSET on frame FRAME.
+The value is a char-table of which elements has this form.
-/* Called from Ffontset_info via map_char_table on each leaf of
- fontset. ARG is a list (LAST FONT-INFO ...), where LAST is `(last
- ARG)' and FONT-INFOs have this form:
- (CHAR FONT-SPEC) or ((FROM . TO) FONT-SPEC)
- The current leaf is indexed by CHARACTER and has value ELT. This
- function add the information of the current leaf to ARG by
- appending a new element or modifying the last element. */
+ ((FONT-PATTERN OPENED-FONT ...) ...)
-static void
-accumulate_font_info (arg, character, elt)
- Lisp_Object arg, character, elt;
-{
- Lisp_Object last, last_char, last_elt;
+FONT-PATTERN is a vector:
- if (!CONSP (elt) && !SINGLE_BYTE_CHAR_P (XINT (character)))
- elt = FONTSET_REF (Vdefault_fontset, XINT (character));
- if (!CONSP (elt))
- return;
- last = XCAR (arg);
- last_char = XCAR (XCAR (last));
- last_elt = XCAR (XCDR (XCAR (last)));
- elt = XCDR (elt);
- if (!NILP (Fequal (elt, last_elt)))
- {
- int this_charset = CHAR_CHARSET (XINT (character));
+ [ FAMILY WEIGHT SLANT SWIDTH ADSTYLE REGISTRY ]
- if (CONSP (last_char)) /* LAST_CHAR == (FROM . TO) */
- {
- if (this_charset == CHAR_CHARSET (XINT (XCAR (last_char))))
- {
- XSETCDR (last_char, character);
- return;
- }
- }
- else if (XINT (last_char) == XINT (character))
- return;
- else if (this_charset == CHAR_CHARSET (XINT (last_char)))
- {
- XSETCAR (XCAR (last), Fcons (last_char, character));
- return;
- }
- }
- XSETCDR (last, Fcons (Fcons (character, Fcons (elt, Qnil)), Qnil));
- XSETCAR (arg, XCDR (last));
-}
+or a string of font name pattern.
+OPENED-FONT is a name of a font actually opened.
-DEFUN ("fontset-info", Ffontset_info, Sfontset_info, 1, 2, 0,
- doc: /* Return information about a fontset named NAME on frame FRAME.
-If NAME is nil, return information about the default fontset.
-The value is a vector:
- [ SIZE HEIGHT ((CHARSET-OR-RANGE FONT-SPEC OPENED ...) ...) ],
-where,
- SIZE is the maximum bound width of ASCII font in the fontset,
- HEIGHT is the maximum bound height of ASCII font in the fontset,
- CHARSET-OR-RANGE is a charset, a character (may be a generic character)
- or a cons of two characters specifying the range of characters.
- FONT-SPEC is a fontname pattern string or a cons (FAMILY . REGISTRY),
- where FAMILY is a `FAMILY' field of a XLFD font name,
- REGISTRY is a `CHARSET_REGISTRY' field of a XLFD font name.
- FAMILY may contain a `FOUNDRY' field at the head.
- REGISTRY may contain a `CHARSET_ENCODING' field at the tail.
- OPENEDs are names of fonts actually opened.
-If the ASCII font is not yet opened, SIZE and HEIGHT are 0.
-If FRAME is omitted, it defaults to the currently selected frame. */)
- (name, frame)
- Lisp_Object name, frame;
+The char-table has one extra slot. The value is a char-table
+containing the information about the derived fonts from the default
+fontset. The format is the same as abobe. */)
+ (fontset, frame)
+ Lisp_Object fontset, frame;
{
- Lisp_Object fontset;
FRAME_PTR f;
- int indices[3];
- Lisp_Object val, tail, elt;
- Lisp_Object *realized;
- struct font_info *fontp = NULL;
- int n_realized = 0;
- int i;
+ Lisp_Object *realized[2], fontsets[2], tables[2];
+ Lisp_Object val, elt;
+ int c, i, j, k;
(*check_window_system_func) ();
- fontset = check_fontset_name (name);
+ fontset = check_fontset_name (fontset);
if (NILP (frame))
frame = selected_frame;
CHECK_LIVE_FRAME (frame);
f = XFRAME (frame);
- /* Recode realized fontsets whose base is FONTSET in the table
- `realized'. */
- realized = (Lisp_Object *) alloca (sizeof (Lisp_Object)
- * ASIZE (Vfontset_table));
- for (i = 0; i < ASIZE (Vfontset_table); i++)
+ /* Recode fontsets realized on FRAME from the base fontset FONTSET
+ in the table `realized'. */
+ realized[0] = (Lisp_Object *) alloca (sizeof (Lisp_Object)
+ * ASIZE (Vfontset_table));
+ for (i = j = 0; i < ASIZE (Vfontset_table); i++)
{
elt = FONTSET_FROM_ID (i);
if (!NILP (elt)
- && EQ (FONTSET_BASE (elt), fontset))
- realized[n_realized++] = elt;
+ && EQ (FONTSET_BASE (elt), fontset)
+ && EQ (FONTSET_FRAME (elt), frame))
+ realized[0][j++] = elt;
}
+ realized[0][j] = Qnil;
- if (! EQ (fontset, Vdefault_fontset))
+ realized[1] = (Lisp_Object *) alloca (sizeof (Lisp_Object)
+ * ASIZE (Vfontset_table));
+ for (i = j = 0; ! NILP (realized[0][i]); i++)
{
- /* Merge FONTSET onto the default fontset. */
- val = Fcopy_sequence (Vdefault_fontset);
- map_char_table (override_font_info, Qnil, fontset, fontset, val, 0, indices);
- fontset = val;
+ elt = FONTSET_DEFAULT (realized[0][i]);
+ if (! NILP (elt))
+ realized[1][j++] = elt;
}
+ realized[1][j] = Qnil;
- /* Accumulate information of the fontset in VAL. The format is
- (LAST FONT-INFO FONT-INFO ...), where FONT-INFO is (CHAR-OR-RANGE
- FONT-SPEC). See the comment for accumulate_font_info for the
- detail. */
- val = Fcons (Fcons (make_number (0),
- Fcons (XCDR (FONTSET_ASCII (fontset)), Qnil)),
- Qnil);
- val = Fcons (val, val);
- map_char_table (accumulate_font_info, Qnil, fontset, fontset, val, 0, indices);
- val = XCDR (val);
-
- /* For each FONT-INFO, if CHAR_OR_RANGE (car part) is a generic
- character for a charset, replace it with the charset symbol. If
- fonts are opened for FONT-SPEC, append the names of the fonts to
- FONT-SPEC. */
- for (tail = val; CONSP (tail); tail = XCDR (tail))
+ tables[0] = Fmake_char_table (Qfontset_info, Qnil);
+ tables[1] = Fmake_char_table (Qnil, Qnil);
+ XCHAR_TABLE (tables[0])->extras[0] = tables[1];
+ fontsets[0] = fontset;
+ fontsets[1] = Vdefault_fontset;
+
+ /* Accumulate information of the fontset in TABLE. The format of
+ each element is ((FONT-SPEC OPENED-FONT ...) ...). */
+ for (k = 0; k <= 1; k++)
{
- int c;
- elt = XCAR (tail);
- if (INTEGERP (XCAR (elt)))
- {
- int charset, c1, c2;
- c = XINT (XCAR (elt));
- SPLIT_CHAR (c, charset, c1, c2);
- if (c1 == 0)
- XSETCAR (elt, CHARSET_SYMBOL (charset));
- }
- else
- c = XINT (XCAR (XCAR (elt)));
- for (i = 0; i < n_realized; i++)
+ for (c = 0; c <= MAX_CHAR; )
{
- Lisp_Object face_id, font;
- struct face *face;
+ int from, to;
- face_id = FONTSET_REF_VIA_BASE (realized[i], c);
- if (INTEGERP (face_id))
+ if (c <= MAX_5_BYTE_CHAR)
+ {
+ val = char_table_ref_and_range (fontsets[k], c, &from, &to);
+ if (to > MAX_5_BYTE_CHAR)
+ to = MAX_5_BYTE_CHAR;
+ }
+ else
{
- face = FACE_FROM_ID (f, XINT (face_id));
- if (face && face->font && face->font_name)
+ val = FONTSET_FALLBACK (fontsets[k]);
+ to = MAX_CHAR;
+ }
+ if (VECTORP (val))
+ {
+ Lisp_Object alist;
+
+ /* At first, set ALIST to ((FONT-SPEC) ...). */
+ for (alist = Qnil, i = 0; i < ASIZE (val); i++)
+ alist = Fcons (Fcons (AREF (AREF (val, i), 0), Qnil), alist);
+ alist = Fnreverse (alist);
+
+ /* Then store opend font names to cdr of each elements. */
+ for (i = 0; ! NILP (realized[k][i]); i++)
{
- font = build_string (face->font_name);
- if (NILP (Fmember (font, XCDR (XCDR (elt)))))
- XSETCDR (XCDR (elt), Fcons (font, XCDR (XCDR (elt))));
+ if (c <= MAX_5_BYTE_CHAR)
+ val = FONTSET_REF (realized[k][i], c);
+ else
+ val = FONTSET_FALLBACK (realized[k][i]);
+ if (! VECTORP (val))
+ continue;
+ /* VAL is [int int ?
+ [FACE-ID FONT-INDEX FONT-DEF FONT-NAME] ...].
+ If a font of an element is already opened,
+ FONT-NAME is the name of a opened font. */
+ for (j = 3; j < ASIZE (val); j++)
+ if (STRINGP (AREF (AREF (val, j), 3)))
+ {
+ Lisp_Object font_idx;
+
+ font_idx = AREF (AREF (val, j), 1);
+ elt = Fassq (AREF (AREF (AREF (val, j), 2), 0), alist);
+ if (CONSP (elt)
+ && NILP (Fmemq (font_idx, XCDR(elt))))
+ nconc2 (elt, Fcons (font_idx, Qnil));
+ }
}
+ for (val = alist; CONSP (val); val = XCDR (val))
+ for (elt = XCDR (XCAR (val)); CONSP (elt); elt = XCDR (elt))
+ {
+ struct font_info *font_info
+ = (*get_font_info_func) (f, XINT (XCAR (elt)));
+ XSETCAR (elt, build_string (font_info->full_name));
+ }
+
+ /* Store ALIST in TBL for characters C..TO. */
+ if (c <= MAX_5_BYTE_CHAR)
+ char_table_set_range (tables[k], c, to, alist);
+ else
+ XCHAR_TABLE (tables[k])->defalt = alist;
}
+ c = to + 1;
}
}
- elt = Fcdr (Fcdr (Fassq (CHARSET_SYMBOL (CHARSET_ASCII), val)));
- if (CONSP (elt))
- {
- elt = XCAR (elt);
- fontp = (*query_font_func) (f, SDATA (elt));
- }
- val = Fmake_vector (make_number (3), val);
- AREF (val, 0) = fontp ? make_number (fontp->size) : make_number (0);
- AREF (val, 1) = fontp ? make_number (fontp->height) : make_number (0);
- return val;
+ return tables[0];
}
-DEFUN ("fontset-font", Ffontset_font, Sfontset_font, 2, 2, 0,
+
+DEFUN ("fontset-font", Ffontset_font, Sfontset_font, 2, 3, 0,
doc: /* Return a font name pattern for character CH in fontset NAME.
-If NAME is nil, find a font name pattern in the default fontset. */)
- (name, ch)
- Lisp_Object name, ch;
+If NAME is t, find a pattern in the default fontset.
+
+The value has the form (FAMILY . REGISTRY), where FAMILY is a font
+family name and REGISTRY is a font registry name. This is actually
+the first font name pattern for CH in the fontset or in the default
+fontset.
+
+If the 2nd optional arg ALL is non-nil, return a list of all font name
+patterns. */)
+ (name, ch, all)
+ Lisp_Object name, ch, all;
{
int c;
- Lisp_Object fontset, elt;
+ Lisp_Object fontset, elt, list, repertory, val;
+ int i, j;
fontset = check_fontset_name (name);
- CHECK_NUMBER (ch);
+ CHECK_CHARACTER (ch);
c = XINT (ch);
- if (!char_valid_p (c, 1))
- invalid_character (c);
-
- elt = FONTSET_REF (fontset, c);
- if (CONSP (elt))
- elt = XCDR (elt);
+ list = Qnil;
+ while (1)
+ {
+ for (i = 0, elt = FONTSET_REF (fontset, c); i < 2;
+ i++, elt = FONTSET_FALLBACK (fontset))
+ if (VECTORP (elt))
+ for (j = 0; j < ASIZE (elt); j++)
+ {
+ val = AREF (elt, j);
+ repertory = AREF (val, 1);
+ if (INTEGERP (repertory))
+ {
+ struct charset *charset = CHARSET_FROM_ID (XINT (repertory));
- return elt;
+ if (! CHAR_CHARSET_P (c, charset))
+ continue;
+ }
+ else if (CHAR_TABLE_P (repertory))
+ {
+ if (NILP (CHAR_TABLE_REF (repertory, c)))
+ continue;
+ }
+ val = AREF (val, 0);
+ val = Fcons (AREF (val, 0), AREF (val, 5));
+ if (NILP (all))
+ return val;
+ list = Fcons (val, list);
+ }
+ if (EQ (fontset, Vdefault_fontset))
+ break;
+ fontset = Vdefault_fontset;
+ }
+ return (Fnreverse (list));
}
DEFUN ("fontset-list", Ffontset_list, Sfontset_list, 0, 0, 0,
return list;
}
-DEFUN ("set-overriding-fontspec-internal", Fset_overriding_fontspec_internal,
- Sset_overriding_fontspec_internal, 1, 1, 0,
- doc: /* Internal use only.
-
-FONTLIST is an alist of TARGET vs FONTNAME, where TARGET is a charset
-or a char-table, FONTNAME have the same meanings as in
-`set-fontset-font'.
-It overrides the font specifications for each TARGET in the default
-fontset by the corresponding FONTNAME.
-
-If TARGET is a charset, targets are all characters in the charset. If
-TARGET is a char-table, targets are characters whose value is non-nil
-in the table.
+#ifdef FONTSET_DEBUG
-It is intended that this function is called only from
-`set-language-environment'. */)
- (fontlist)
- Lisp_Object fontlist;
+Lisp_Object
+dump_fontset (fontset)
+ Lisp_Object fontset;
{
- Lisp_Object tail;
+ Lisp_Object vec;
- fontlist = Fcopy_sequence (fontlist);
- /* Now FONTLIST is ((TARGET . FONTNAME) ...). Reform it to ((TARGET
- nil nil nil FONTSPEC) ...), where TARGET is a charset-id or a
- char-table. */
- for (tail = fontlist; CONSP (tail); tail = XCDR (tail))
+ vec = Fmake_vector (make_number (3), Qnil);
+ ASET (vec, 0, FONTSET_ID (fontset));
+
+ if (BASE_FONTSET_P (fontset))
+ {
+ ASET (vec, 1, FONTSET_NAME (fontset));
+ }
+ else
{
- Lisp_Object elt, target;
+ Lisp_Object frame;
- elt = XCAR (tail);
- target = Fcar (elt);
- elt = Fcons (Qnil, regularize_fontname (Fcdr (elt)));
- if (! CHAR_TABLE_P (target))
+ frame = FONTSET_FRAME (fontset);
+ if (FRAMEP (frame))
{
- int charset, c;
-
- CHECK_SYMBOL (target);
- charset = get_charset_id (target);
- if (charset < 0)
- error ("Invalid charset %s", SDATA (SYMBOL_NAME (target)));
- target = make_number (charset);
- c = MAKE_CHAR (charset, 0, 0);
- XSETCAR (elt, make_number (c));
+ FRAME_PTR f = XFRAME (frame);
+
+ if (FRAME_LIVE_P (f))
+ ASET (vec, 1,
+ Fcons (FONTSET_NAME (FONTSET_BASE (fontset)), f->name));
+ else
+ ASET (vec, 1,
+ Fcons (FONTSET_NAME (FONTSET_BASE (fontset)), Qnil));
}
- elt = Fcons (target, Fcons (Qnil, Fcons (Qnil, elt)));
- XSETCAR (tail, elt);
+ if (!NILP (FONTSET_DEFAULT (fontset)))
+ ASET (vec, 2, FONTSET_ID (FONTSET_DEFAULT (fontset)));
}
- if (! NILP (Fequal (fontlist, Voverriding_fontspec_alist)))
- return Qnil;
- Voverriding_fontspec_alist = fontlist;
- clear_face_cache (0);
- ++windows_or_buffers_changed;
- return Qnil;
+ return vec;
+}
+
+DEFUN ("fontset-list-all", Ffontset_list_all, Sfontset_list_all, 0, 0, 0,
+ doc: /* Return a brief summary of all fontsets for debug use. */)
+ ()
+{
+ Lisp_Object val;
+ int i;
+
+ for (i = 0, val = Qnil; i < ASIZE (Vfontset_table); i++)
+ if (! NILP (AREF (Vfontset_table, i)))
+ val = Fcons (dump_fontset (AREF (Vfontset_table, i)), val);
+ return (Fnreverse (val));
}
+#endif /* FONTSET_DEBUG */
void
syms_of_fontset ()
/* Window system initializer should have set proper functions. */
abort ();
- Qfontset = intern ("fontset");
- staticpro (&Qfontset);
- Fput (Qfontset, Qchar_table_extra_slots, make_number (3));
+ DEFSYM (Qfontset, "fontset");
+ Fput (Qfontset, Qchar_table_extra_slots, make_number (9));
+ DEFSYM (Qfontset_info, "fontset-info");
+ Fput (Qfontset_info, Qchar_table_extra_slots, make_number (1));
+
+ DEFSYM (Qprepend, "prepend");
+ DEFSYM (Qappend, "append");
+ DEFSYM (Qlatin, "latin");
Vcached_fontset_data = Qnil;
staticpro (&Vcached_fontset_data);
AREF (Vfontset_table, 0) = Vdefault_fontset;
next_fontset_id = 1;
- Voverriding_fontspec_alist = Qnil;
- staticpro (&Voverriding_fontspec_alist);
+ auto_fontset_alist = Qnil;
+ staticpro (&auto_fontset_alist);
DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist,
- doc: /* Alist of fontname patterns vs corresponding encoding info.
-Each element looks like (REGEXP . ENCODING-INFO),
- where ENCODING-INFO is an alist of CHARSET vs ENCODING.
-ENCODING is one of the following integer values:
- 0: code points 0x20..0x7F or 0x2020..0x7F7F are used,
- 1: code points 0xA0..0xFF or 0xA0A0..0xFFFF are used,
- 2: code points 0x20A0..0x7FFF are used,
- 3: code points 0xA020..0xFF7F are used. */);
+ doc: /*
+Alist of fontname patterns vs the corresponding encoding and repertory info.
+Each element looks like (REGEXP . (ENCODING . REPERTORY)),
+where ENCODING is a charset or a char-table,
+and REPERTORY is a charset, a char-table, or nil.
+
+If ENCDING and REPERTORY are the same, the element can have the form
+\(REGEXP . ENCODING).
+
+ENCODING is for converting a character to a glyph code of the font.
+If ENCODING is a charset, encoding a character by the charset gives
+the corresponding glyph code. If ENCODING is a char-table, looking up
+the table by a character gives the corresponding glyph code.
+
+REPERTORY specifies a repertory of characters supported by the font.
+If REPERTORY is a charset, all characters beloging to the charset are
+supported. If REPERTORY is a char-table, all characters who have a
+non-nil value in the table are supported. It REPERTORY is nil, Emacs
+gets the repertory information by an opened font and ENCODING. */);
Vfont_encoding_alist = Qnil;
- Vfont_encoding_alist
- = Fcons (Fcons (build_string ("JISX0201"),
- Fcons (Fcons (intern ("latin-jisx0201"), make_number (0)),
- Qnil)),
- Vfont_encoding_alist);
- Vfont_encoding_alist
- = Fcons (Fcons (build_string ("ISO8859-1"),
- Fcons (Fcons (intern ("ascii"), make_number (0)),
- Qnil)),
- Vfont_encoding_alist);
+
+ DEFVAR_LISP ("font-encoding-charset-alist", &Vfont_encoding_charset_alist,
+ doc: /*
+Alist of charsets vs the charsets to determine the preferred font encoding.
+Each element looks like (CHARSET . ENCDOING-CHARSET),
+where ENCODING-CHARSET is a charset registered in the variable
+`font-encoding-alist' as ENCODING.
+
+When a text has a property `charset' and the value is CHARSET, a font
+whose encoding corresponds to ENCODING-CHARSET is preferred. */);
+ Vfont_encoding_charset_alist = Qnil;
DEFVAR_LISP ("use-default-ascent", &Vuse_default_ascent,
- doc: /* Char table of characters whose ascent values should be ignored.
+ doc: /*
+Char table of characters whose ascent values should be ignored.
If an entry for a character is non-nil, the ascent value of the glyph
is assumed to be what specified by _MULE_DEFAULT_ASCENT property of a font.
Vuse_default_ascent = Qnil;
DEFVAR_LISP ("ignore-relative-composition", &Vignore_relative_composition,
- doc: /* Char table of characters which is not composed relatively.
+ doc: /*
+Char table of characters which is not composed relatively.
If an entry for a character is non-nil, a composition sequence
which contains that character is displayed so that
the glyph of that character is put without considering
at the vertical center of lines. */);
Vvertical_centering_font_regexp = Qnil;
+ DEFVAR_LISP ("otf-script-alist", &Votf_script_alist,
+ doc: /* Alist of OpenType script tags vs the corresponding script names. */);
+ Votf_script_alist = Qnil;
+
defsubr (&Squery_fontset);
defsubr (&Snew_fontset);
defsubr (&Sset_fontset_font);
defsubr (&Sfontset_info);
defsubr (&Sfontset_font);
defsubr (&Sfontset_list);
- defsubr (&Sset_overriding_fontspec_internal);
+#ifdef FONTSET_DEBUG
+ defsubr (&Sfontset_list_all);
+#endif
}
/* arch-tag: ea861585-2f5f-4e5b-9849-d04a9c3a3537
/* Header for fontset handler.
Copyright (C) 1998, 2001, 2002, 2003, 2004, 2005,
- 2006, 2007 Free Software Foundation, Inc.
+ 2006, 2007, 2008 Free Software Foundation, Inc.
Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- 2005, 2006, 2007
+ 2005, 2006, 2007, 2008
National Institute of Advanced Industrial Science and Technology (AIST)
Registration Number H14PRO021
+ Copyright (C) 2003, 2006
+ National Institute of Advanced Industrial Science and Technology (AIST)
+ Registration Number H13PRO009
This file is part of GNU Emacs.
/* Full name of the font given by a window system. */
char *full_name;
- /* Charset of characters displayed by the font. */
+ /* Charset to encode a character code into a glyph code of the
+ font. */
int charset;
#ifdef WINDOWSNT
of lines. */
int vertical_centering;
- /* Encodings of the font indexed by CHARSET. The value is one of
+ /* Encoding type of the font. The value is one of
0, 1, 2, or 3:
0: code points 0x20..0x7F or 0x2020..0x7F7F are used
1: code points 0xA0..0xFF or 0xA0A0..0xFFFF are used
2: code points 0x20A0..0x7FFF are used
3: code points 0xA020..0xFF7F are used
- For instance, ASCII and Latin-1 characters may use the same font
- but different code points (ASCII uses 0x20..0x7F and Latin-1 uses
- 0xA0..0xFF).
-
- If the value can't be decided from information of the font, we
- consult `font-encoding-alist' to get of the corresponding charset
- whose default value is defined in lisp/fontset.el. Since there's
- no charset whose id is 1, we use encoding[1] to store the
- encoding information decided by the font itself.
-
If the member `font_encoder' is not NULL, this member is ignored.
*/
- unsigned char encoding[MAX_CHARSET + 1];
+ unsigned char encoding_type;
/* The baseline position of a font is normally `ascent' value of the
font. However, there exists many fonts which don't set `ascent'
to be used. */
#define FONT_ENCODING_NOT_DECIDED 255
+enum FONT_SPEC_INDEX
+ {
+ FONT_SPEC_FAMILY_INDEX,
+ FONT_SPEC_WEIGHT_INDEX,
+ FONT_SPEC_SLANT_INDEX,
+ FONT_SPEC_SWIDTH_INDEX,
+ FONT_SPEC_ADSTYLE_INDEX,
+ FONT_SPEC_REGISTRY_INDEX,
+ FONT_SPEC_MAX_INDEX
+ };
+
/* Forward declaration for prototypes. */
struct frame;
This function set the memer `encoder' of the structure. */
extern void (*find_ccl_program_func) P_ ((struct font_info *));
+extern Lisp_Object (*get_font_repertory_func) P_ ((struct frame *,
+ struct font_info *));
+
/* Check if any window system is used now. */
extern void (*check_window_system_func) P_ ((void));
struct face;
extern void free_face_fontset P_ ((FRAME_PTR, struct face *));
-extern Lisp_Object fontset_font_pattern P_ ((FRAME_PTR, int, int));
+extern Lisp_Object fontset_font_pattern P_ ((FRAME_PTR, struct face *, int));
extern int face_suitable_for_char_p P_ ((struct face *, int));
-extern int face_for_char P_ ((FRAME_PTR, struct face *, int));
-extern int make_fontset_for_ascii_face P_ ((FRAME_PTR, int));
+extern int face_for_char P_ ((FRAME_PTR, struct face *, int,
+ int, Lisp_Object));
+extern int make_fontset_for_ascii_face P_ ((FRAME_PTR, int, struct face *));
+extern int new_fontset_from_font_name P_ ((Lisp_Object));
extern void set_default_ascii_font P_ ((Lisp_Object));
-extern struct font_info *fs_load_font P_ ((struct frame *, int, char *, int,
- struct face *));
+extern struct font_info *fs_load_font P_ ((struct frame *, char *, int));
extern int fs_query_fontset P_ ((Lisp_Object, int));
EXFUN (Fquery_fontset, 2);
extern Lisp_Object list_fontsets P_ ((struct frame *, Lisp_Object, int));
-extern Lisp_Object Qfontset;
extern Lisp_Object Vuse_default_ascent;
extern Lisp_Object Vignore_relative_composition;
extern Lisp_Object Valternate_fontname_alist;
extern Lisp_Object Vfontset_alias_alist;
extern Lisp_Object Vvertical_centering_font_regexp;
+extern Lisp_Object Votf_script_alist;
-/* Load a font named FONTNAME for displaying character C. All fonts
- for frame F is stored in a table pointed by FONT_TABLE. Return a
- pointer to the struct font_info of the loaded font. If loading
- fails, return 0; If FONTNAME is NULL, the name is taken from the
- information of FONTSET. If FONTSET is given, try to load a font
- whose size matches that of FONTSET, and, the font index is stored
- in the table for FONTSET. */
+/* Load a font named FONTNAME on frame F. All fonts for frame F is
+ stored in a table pointed by FONT_TABLE. Return a pointer to the
+ struct font_info of the loaded font. If loading fails, return
+ NULL. */
-#define FS_LOAD_FONT(f, c, fontname, fontset) \
- fs_load_font (f, c, fontname, fontset, NULL)
+#define FS_LOAD_FONT(f, fontname) fs_load_font (f, fontname, -1)
-#define FS_LOAD_FACE_FONT(f, c, fontname, face) \
- fs_load_font (f, c, fontname, -1, face)
/* Return an immutable id for font_info FONT_INFO on frame F. The
reason for this macro is hat one cannot hold pointers to font_info
? (FRAME_X_DISPLAY_INFO ((F))->font_table + (ID)) \
: 0)
+#ifdef USE_FONT_BACKEND
+#define FONT_INFO_FROM_FACE(F, FACE) \
+ (enable_font_backend ? (FACE)->font_info \
+ : FONT_INFO_FROM_ID ((F), (FACE)->font_info_id))
+#else /* not USE_FONT_BACKEND */
+#define FONT_INFO_FROM_FACE(F, FACE) \
+ FONT_INFO_FROM_ID ((F), (FACE)->font_info_id)
+#endif /* not USE_FONT_BACKEND */
+
extern Lisp_Object fontset_name P_ ((int));
extern Lisp_Object fontset_ascii P_ ((int));
extern int fontset_height P_ ((int));
+#ifdef USE_FONT_BACKEND
+struct font;
+extern int face_for_font P_ ((struct frame *, struct font *, struct face *));
+extern int new_fontset_from_font P_ ((Lisp_Object));
+extern struct font *fontset_ascii_font P_ ((FRAME_PTR, int));
+#endif /* USE_FONT_BACKEND */
+
#endif /* EMACS_FONTSET_H */
/* arch-tag: c27cef7b-3cab-488a-8398-7a4daa96bb77
/* Generic frame functions.
Copyright (C) 1993, 1994, 1995, 1997, 1999, 2000, 2001, 2002, 2003,
- 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include <stdio.h>
#include "lisp.h"
-#include "charset.h"
+#include "character.h"
#ifdef HAVE_X_WINDOWS
#include "xterm.h"
#endif
#ifdef HAVE_WINDOW_SYSTEM
+#ifdef USE_FONT_BACKEND
+#include "font.h"
+#endif /* USE_FONT_BACKEND */
+
/* The name we're using in resource queries. Most often "emacs". */
Lisp_Object Vx_resource_name;
Lisp_Object Qtty, Qtty_type;
Lisp_Object Qfullscreen, Qfullwidth, Qfullheight, Qfullboth;
+#ifdef USE_FONT_BACKEND
+Lisp_Object Qfont_backend;
+#endif /* USE_FONT_BACKEND */
Lisp_Object Qinhibit_face_set_after_frame_default;
Lisp_Object Qface_set_after_frame_default;
#endif
f->size_hint_flags = 0;
f->win_gravity = 0;
+#ifdef USE_FONT_BACKEND
+ f->font_driver_list = NULL;
+ f->font_data_list = NULL;
+#endif /* USE_FONT_BACKEND */
root_window = make_window ();
if (mini_p)
abort ();
#else /* not MSDOS */
- #if 0 /* #ifdef MAC_OS */
+ #if 0 /* #ifdef MAC_OS8 */
/* This can happen for multi-tty when using both terminal frames and
Carbon frames. */
if (sf->output_method != output_mac)
memory. */
free_glyphs (f);
+#ifdef USE_FONT_BACKEND
+ /* Give chance to each font driver to free a frame specific data. */
+ font_update_drivers (f, Qnil);
+#endif /* USE_FONT_BACKEND */
+
/* Mark all the windows that used to be on FRAME as deleted, and then
remove the reference to them. */
delete_all_subwindows (XWINDOW (f->root_window));
static int
frame_name_fnn_p (str, len)
char *str;
- int len;
+ EMACS_INT len;
{
if (len > 1 && str[0] == 'F')
{
{"right-fringe", &Qright_fringe},
{"wait-for-wm", &Qwait_for_wm},
{"fullscreen", &Qfullscreen},
+#ifdef USE_FONT_BACKEND
+ {"font-backend", &Qfont_backend}
+#endif /* USE_FONT_BACKEND */
};
#ifdef HAVE_WINDOW_SYSTEM
Lisp_Object frame;
int old_fontset = FRAME_FONTSET(f);
+#ifdef USE_FONT_BACKEND
+ if (enable_font_backend)
+ {
+ int fontset = -1;
+ Lisp_Object font_object;
+
+ /* ARG is a fontset name, a font name, or a font object.
+ In the last case, this function never fail. */
+ if (STRINGP (arg))
+ {
+ fontset = fs_query_fontset (arg, 0);
+ if (fontset < 0)
+ font_object = font_open_by_name (f, SDATA (arg));
+ else if (fontset > 0)
+ {
+ Lisp_Object ascii_font = fontset_ascii (fontset);
+
+ font_object = font_open_by_name (f, SDATA (ascii_font));
+ }
+ }
+ else
+ font_object = arg;
+
+ if (fontset < 0 && ! NILP (font_object))
+ fontset = new_fontset_from_font (font_object);
+
+ if (fontset == 0)
+ /* Refuse the default fontset. */
+ result = Qt;
+ else if (NILP (font_object))
+ result = Qnil;
+ else
+ result = x_new_fontset2 (f, fontset, font_object);
+ }
+ else
+ {
+#endif /* USE_FONT_BACKEND */
CHECK_STRING (arg);
fontset_name = Fquery_fontset (arg, Qnil);
BLOCK_INPUT;
result = (STRINGP (fontset_name)
- ? x_new_fontset (f, SDATA (fontset_name))
- : x_new_font (f, SDATA (arg)));
+ ? x_new_fontset (f, fontset_name)
+ : x_new_fontset (f, arg));
UNBLOCK_INPUT;
+#ifdef USE_FONT_BACKEND
+ }
+#endif
if (EQ (result, Qnil))
error ("Font `%s' is not defined", SDATA (arg));
else if (EQ (result, Qt))
- error ("The characters of the given font have varying widths");
+ error ("The default fontset can't be used for a frame font");
else if (STRINGP (result))
{
set_default_ascii_font (result);
if (old_fontset == FRAME_FONTSET (f))
return;
}
- else if (!NILP (Fequal (result, oldval)))
+ store_frame_param (f, Qfont, result);
+
+ if (!NILP (Fequal (result, oldval)))
return;
/* Recalculate toolbar height. */
/* Ensure we redraw it. */
clear_current_matrices (f);
- store_frame_param (f, Qfont, result);
recompute_basic_faces (f);
}
else
}
+#ifdef USE_FONT_BACKEND
+void
+x_set_font_backend (f, new_value, old_value)
+ struct frame *f;
+ Lisp_Object new_value, old_value;
+{
+ if (! NILP (new_value)
+ && !CONSP (new_value))
+ {
+ char *p0, *p1;
+
+ CHECK_STRING (new_value);
+ p0 = p1 = SDATA (new_value);
+ new_value = Qnil;
+ while (*p0)
+ {
+ while (*p1 && *p1 != ',') p1++;
+ if (p0 < p1)
+ new_value = Fcons (Fintern (make_string (p0, p1 - p0), Qnil),
+ new_value);
+ if (*p1)
+ p1++;
+ p0 = p1;
+ }
+ new_value = Fnreverse (new_value);
+ }
+
+ if (! NILP (old_value) && ! NILP (Fequal (old_value, new_value)))
+ return;
+
+ if (FRAME_FONT_OBJECT (f))
+ free_all_realized_faces (Qnil);
+
+ new_value = font_update_drivers (f, NILP (new_value) ? Qt : new_value);
+ if (NILP (new_value))
+ {
+ if (NILP (old_value))
+ error ("No font backend available");
+ font_update_drivers (f, old_value);
+ error ("None of specified font backends are available");
+ }
+ store_frame_param (f, Qfont_backend, new_value);
+
+ if (FRAME_FONT_OBJECT (f))
+ {
+ Lisp_Object frame;
+
+ XSETFRAME (frame, f);
+ x_set_font (f, Fframe_parameter (frame, Qfont), Qnil);
+ ++face_change_count;
+ ++windows_or_buffers_changed;
+ }
+}
+#endif /* USE_FONT_BACKEND */
+
+
void
x_set_fringe_width (f, new_value, old_value)
struct frame *f;
/* Define frame-object for GNU Emacs.
Copyright (C) 1993, 1994, 1999, 2000, 2001, 2002, 2003, 2004,
- 2005, 2006, 2007 Free Software Foundation, Inc.
+ 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
This file is part of GNU Emacs.
struct terminal;
+struct font_driver_list;
+
struct frame
{
EMACS_UINT size;
/* Size of the frame window in pixels. */
int pixel_height, pixel_width;
+ /* Dots per inch of the screen the frame is on. */
+ double resx, resy;
+
/* These many pixels are the difference between the outer window (i.e. the
left and top of the window manager decoration) and FRAME_X_WINDOW. */
int x_pixels_diff, y_pixels_diff;
}
output_data;
+ /* List of font-drivers available on the frame. */
+ struct font_driver_list *font_driver_list;
+ /* List of data specific to font-driver and frame, but common to
+ faces. */
+ struct font_data_list *font_data_list;
+
/* Total width of fringes reserved for drawing truncation bitmaps,
continuation bitmaps and alike. The width is in canonical char
units of the frame. This must currently be the case because window
typedef struct frame *FRAME_PTR;
-#define XFRAME(p) (eassert (GC_FRAMEP(p)),(struct frame *) XPNTR (p))
+#define XFRAME(p) (eassert (FRAMEP(p)),(struct frame *) XPNTR (p))
#define XSETFRAME(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_FRAME))
/* Given a window, return its frame as a Lisp_Object. */
extern Lisp_Object Qline_spacing;
extern Lisp_Object Qwait_for_wm;
extern Lisp_Object Qfullscreen;
+extern Lisp_Object Qfont_backend;
extern Lisp_Object Qleft_fringe, Qright_fringe;
extern Lisp_Object Qheight, Qwidth;
extern void x_wm_set_icon_position P_ ((struct frame *, int, int));
extern Lisp_Object x_new_font P_ ((struct frame *, char *));
-extern Lisp_Object x_new_fontset P_ ((struct frame *, char *));
-
+extern Lisp_Object x_new_fontset P_ ((struct frame *, Lisp_Object));
+#ifdef USE_FONT_BACKEND
+extern Lisp_Object x_new_fontset2 P_ ((struct frame *, int, Lisp_Object));
+#endif /* USE_FONT_BACKEND */
/* These are in frame.c */
extern void x_set_line_spacing P_ ((struct frame *, Lisp_Object, Lisp_Object));
extern void x_set_screen_gamma P_ ((struct frame *, Lisp_Object, Lisp_Object));
extern void x_set_font P_ ((struct frame *, Lisp_Object, Lisp_Object));
+extern void x_set_font_backend P_ ((struct frame *, Lisp_Object, Lisp_Object));
extern void x_set_fringe_width P_ ((struct frame *, Lisp_Object, Lisp_Object));
extern void x_set_border_width P_ ((struct frame *, Lisp_Object, Lisp_Object));
extern void x_set_internal_border_width P_ ((struct frame *, Lisp_Object,
/* Fringe handling (split from xdisp.c).
Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995, 1997,
1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
- 2006, 2007 Free Software Foundation, Inc.
+ 2006, 2007, 2008 Free Software Foundation, Inc.
This file is part of GNU Emacs.
Lisp_Object face;
if ((face = fringe_faces[which], NILP (face))
- || (face_id = lookup_derived_face (f, face, 'A', FRINGE_FACE_ID, 0),
+ || (face_id = lookup_derived_face (f, face, FRINGE_FACE_ID, 0),
face_id < 0))
face_id = FRINGE_FACE_ID;
}
if (!NILP (face))
{
face_id = lookup_derived_face (SELECTED_FRAME (), face,
- 'A', FRINGE_FACE_ID, 1);
+ FRINGE_FACE_ID, 1);
if (face_id < 0)
error ("No such face");
}
/* Indentation functions.
Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995, 1998, 2000, 2001,
- 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ 2002, 2003, 2004, 2005, 2006, 2007, 2008
+ Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include "lisp.h"
#include "buffer.h"
-#include "charset.h"
+#include "character.h"
#include "category.h"
#include "indent.h"
#include "keyboard.h"
int *len, *len_byte, *width;
{
Lisp_Object prop;
- int start, end;
+ EMACS_INT start, end;
int id;
if (! find_composition (pos, -1, &start, &end, &prop, Qnil)
if (dp != 0 && VECTORP (DISP_CHAR_VECTOR (dp, c))) \
width = XVECTOR (DISP_CHAR_VECTOR (dp, c))->size; \
else \
- width = WIDTH_BY_CHAR_HEAD (*p); \
+ width = CHAR_WIDTH (c); \
if (width > 1) \
wide_column = width; \
} \
/* Buffer insertion/deletion and gap motion for GNU Emacs.
Copyright (C) 1985, 1986, 1993, 1994, 1995, 1997, 1998, 1999, 2000, 2001,
- 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ 2002, 2003, 2004, 2005, 2006, 2007, 2008
+ Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include "lisp.h"
#include "intervals.h"
#include "buffer.h"
-#include "charset.h"
+#include "character.h"
#include "window.h"
#include "blockinput.h"
#include "region-cache.h"
int bytes_left = nbytes;
Lisp_Object tbl = Qnil;
- /* We set the variable tbl to the reverse table of
- Vnonascii_translation_table in advance. */
- if (CHAR_TABLE_P (Vnonascii_translation_table))
- {
- tbl = Fchar_table_extra_slot (Vnonascii_translation_table,
- make_number (0));
- if (!CHAR_TABLE_P (tbl))
- tbl = Qnil;
- }
-
- /* Convert multibyte to single byte. */
while (bytes_left > 0)
{
int thislen, c;
c = STRING_CHAR_AND_LENGTH (from_addr, bytes_left, thislen);
- if (!SINGLE_BYTE_CHAR_P (c))
+ if (!ASCII_CHAR_P (c))
c = multibyte_char_to_unibyte (c, tbl);
*to_addr++ = c;
from_addr += thislen;
current_buffer, inherit);
adjust_point (nchars, outgoing_nbytes);
+
+ CHECK_MARKERS ();
+}
+\f
+/* Insert a sequence of NCHARS chars which occupy NBYTES bytes
+ starting at GPT_ADDR. */
+
+void
+insert_from_gap (nchars, nbytes)
+ register int nchars, nbytes;
+{
+ if (NILP (current_buffer->enable_multibyte_characters))
+ nchars = nbytes;
+
+ record_insert (GPT, nchars);
+ MODIFF++;
+
+ GAP_SIZE -= nbytes;
+ GPT += nchars;
+ ZV += nchars;
+ Z += nchars;
+ GPT_BYTE += nbytes;
+ ZV_BYTE += nbytes;
+ Z_BYTE += nbytes;
+ if (GAP_SIZE > 0) *(GPT_ADDR) = 0; /* Put an anchor. */
+
+ if (GPT_BYTE < GPT)
+ abort ();
+
+ adjust_overlays_for_insert (GPT - nchars, nchars);
+ adjust_markers_for_insert (GPT - nchars, GPT_BYTE - nbytes,
+ GPT, GPT_BYTE, 0);
+
+ if (BUF_INTERVALS (current_buffer) != 0)
+ {
+ offset_intervals (current_buffer, GPT - nchars, nchars);
+ graft_intervals_into_buffer (NULL_INTERVAL, GPT - nchars, nchars,
+ current_buffer, 0);
+ }
+
+ if (GPT - nchars < PT)
+ adjust_point (nchars, nbytes);
+
+ CHECK_MARKERS ();
}
\f
/* Insert text from BUF, NCHARS characters starting at CHARPOS, into the
/* Code for doing intervals.
Copyright (C) 1993, 1994, 1995, 1997, 1998, 2001, 2002, 2003, 2004,
- 2005, 2006, 2007 Free Software Foundation, Inc.
+ 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
This file is part of GNU Emacs.
get_property_and_range (pos, prop, val, start, end, object)
int pos;
Lisp_Object prop, *val;
- int *start, *end;
+ EMACS_INT *start, *end;
Lisp_Object object;
{
INTERVAL i, prev, next;
/* Definitions and global variables for intervals.
Copyright (C) 1993, 1994, 2000, 2001, 2002, 2003, 2004,
- 2005, 2006, 2007 Free Software Foundation, Inc.
+ 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
This file is part of GNU Emacs.
extern Lisp_Object lookup_char_property P_ ((Lisp_Object, Lisp_Object, int));
extern void move_if_not_intangible P_ ((int));
extern int get_property_and_range P_ ((int, Lisp_Object, Lisp_Object *,
- int *, int *, Lisp_Object));
+ EMACS_INT *, EMACS_INT *, Lisp_Object));
extern Lisp_Object get_local_map P_ ((int, struct buffer *, Lisp_Object));
extern INTERVAL update_interval P_ ((INTERVAL, int));
extern void set_intervals_multibyte P_ ((int));
/* Keyboard and mouse input; editor command loop.
Copyright (C) 1985, 1986, 1987, 1988, 1989, 1993, 1994, 1995,
1996, 1997, 1999, 2000, 2001, 2002, 2003, 2004,
- 2005, 2006, 2007 Free Software Foundation, Inc.
+ 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include "window.h"
#include "commands.h"
#include "buffer.h"
-#include "charset.h"
+#include "character.h"
#include "disptab.h"
#include "dispextern.h"
#include "syntax.h"
: (lose >= 0x20 && lose < 0x7f))
/* To extract the case of continuation on
wide-column characters. */
- && (WIDTH_BY_CHAR_HEAD (FETCH_BYTE (PT_BYTE)) == 1)
+ && ASCII_BYTE_P (lose)
&& (XFASTINT (XWINDOW (selected_window)->last_modified)
>= MODIFF)
&& (XFASTINT (XWINDOW (selected_window)->last_overlay_modified)
{
unsigned int c
= translate_char (Vtranslation_table_for_input,
- XFASTINT (last_command_char), 0, 0, 0);
+ XFASTINT (last_command_char));
int value;
if (NILP (Vexecuting_kbd_macro)
&& !EQ (minibuf_window, selected_window))
int last_pt;
int modified;
{
- int beg, end;
+ EMACS_INT beg, end;
Lisp_Object val, overlay, tmp;
int check_composition = 1, check_display = 1, check_invisible = 1;
int orig_pt = PT;
|| (VECTORP (current_kboard->Vkeyboard_translate_table)
&& XVECTOR (current_kboard->Vkeyboard_translate_table)->size > (unsigned) XFASTINT (c))
|| (CHAR_TABLE_P (current_kboard->Vkeyboard_translate_table)
- && CHAR_VALID_P (XINT (c), 0)))
+ && CHARACTERP (c)))
{
Lisp_Object d;
d = Faref (current_kboard->Vkeyboard_translate_table, c);
tem = XCDR (cachelist);
if (newcache && !NILP (tem))
{
- tem = concat3 (build_string (" ("), tem, build_string (")"));
+ tem = concat2 (build_string (" "), tem);
+ // tem = concat3 (build_string (" ("), tem, build_string (")"));
XSETCDR (cachelist, tem);
}
/* If KEY is not defined in any of the keymaps,
and cannot be part of a function key or translation,
- and is an upper case letter or shifted key,
- use the corresponding lower-case/unshifted key instead. */
+ and is an upper case letter
+ use the corresponding lower-case letter instead. */
+ if (first_binding >= nmaps
+ && /* indec.start >= t && fkey.start >= t && */ keytran.start >= t
+ && INTEGERP (key)
+ && ((CHARACTERP (make_number (XINT (key) & ~CHAR_MODIFIER_MASK))
+ && UPPERCASEP (XINT (key) & ~CHAR_MODIFIER_MASK))
+ || (XINT (key) & shift_modifier)))
+ {
+ Lisp_Object new_key;
+
+ original_uppercase = key;
+ original_uppercase_position = t - 1;
+
+ if (XINT (key) & shift_modifier)
+ XSETINT (new_key, XINT (key) & ~shift_modifier);
+ else
+ XSETINT (new_key, (DOWNCASE (XINT (key) & ~CHAR_MODIFIER_MASK)
+ | (XINT (key) & ~CHAR_MODIFIER_MASK)));
+
+ /* We have to do this unconditionally, regardless of whether
+ the lower-case char is defined in the keymaps, because they
+ might get translated through function-key-map. */
+ keybuf[t - 1] = new_key;
+ mock_input = max (t, mock_input);
+
+ goto replay_sequence;
+ }
+ /* If KEY is not defined in any of the keymaps,
+ and cannot be part of a function key or translation,
+ and is a shifted function key,
+ use the corresponding unshifted function key instead. */
if (first_binding >= nmaps
&& /* indec.start >= t && fkey.start >= t && */ keytran.start >= t)
{
if (modifiers & shift_modifier
/* Treat uppercase keys as shifted. */
|| (INTEGERP (key)
- & (KEY_TO_CHAR (key)
- < XCHAR_TABLE (current_buffer->downcase_table)->size)
+ && (KEY_TO_CHAR (key)
+ < XCHAR_TABLE (current_buffer->downcase_table)->size)
&& UPPERCASEP (KEY_TO_CHAR (key))))
{
Lisp_Object new_key
/* Manipulation of keymaps
Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995,
1998, 1999, 2000, 2001, 2002, 2003, 2004,
- 2005, 2006, 2007 Free Software Foundation, Inc.
+ 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include "lisp.h"
#include "commands.h"
#include "buffer.h"
+#include "character.h"
#include "charset.h"
#include "keyboard.h"
#include "frame.h"
if (CHAR_TABLE_P (XCAR (list)))
{
- int indices[3];
-
- map_char_table (fix_submap_inheritance, Qnil,
- XCAR (list), XCAR (list),
- keymap, 0, indices);
+ map_char_table (fix_submap_inheritance, Qnil, XCAR (list), keymap);
}
}
GCPRO4 (map, tail, idx, t_binding);
- /* If `t_ok' is 2, both `t' and generic-char bindings are accepted.
- If it is 1, only generic-char bindings are accepted.
- Otherwise, neither are. */
+ /* If `t_ok' is 2, both `t' is accepted. */
t_ok = t_ok ? 2 : 0;
for (tail = XCDR (map);
if (EQ (key, idx))
val = XCDR (binding);
- else if (t_ok
- && INTEGERP (idx)
- && (XINT (idx) & CHAR_MODIFIER_MASK) == 0
- && INTEGERP (key)
- && (XINT (key) & CHAR_MODIFIER_MASK) == 0
- && !SINGLE_BYTE_CHAR_P (XINT (idx))
- && !SINGLE_BYTE_CHAR_P (XINT (key))
- && CHAR_VALID_P (XINT (key), 1)
- && !CHAR_VALID_P (XINT (key), 0)
- && (CHAR_CHARSET (XINT (key))
- == CHAR_CHARSET (XINT (idx))))
- {
- /* KEY is the generic character of the charset of IDX.
- Use KEY's binding if there isn't a binding for IDX
- itself. */
- t_binding = XCDR (binding);
- t_ok = 0;
- }
else if (t_ok > 1 && EQ (key, Qt))
{
t_binding = XCDR (binding);
}
else if (CHAR_TABLE_P (binding))
{
- int indices[3];
- map_char_table (map_keymap_char_table_item, Qnil, binding, binding,
+ map_char_table (map_keymap_char_table_item, Qnil, binding,
Fcons (make_save_value (fun, 0),
Fcons (make_save_value (data, 0),
- args)),
- 0, indices);
+ args)));
}
}
UNGCPRO;
if (!CONSP (keymap) || !EQ (XCAR (keymap), Qkeymap))
error ("attempt to define a key in a non-keymap");
- /* If idx is a list (some sort of mouse click, perhaps?),
- the index we want to use is the car of the list, which
- ought to be a symbol. */
- idx = EVENT_HEAD (idx);
+ /* If idx is a cons, and the car part is a character, idx must be of
+ the form (FROM-CHAR . TO-CHAR). */
+ if (CONSP (idx) && CHARACTERP (XCAR (idx)))
+ CHECK_CHARACTER_CDR (idx);
+ else
+ /* If idx is a list (some sort of mouse click, perhaps?),
+ the index we want to use is the car of the list, which
+ ought to be a symbol. */
+ idx = EVENT_HEAD (idx);
/* If idx is a symbol, it might have modifiers, which need to
be put in the canonical order. */
ASET (elt, XFASTINT (idx), def);
return def;
}
+ else if (CONSP (idx) && CHARACTERP (XCAR (idx)))
+ {
+ int from = XFASTINT (XCAR (idx));
+ int to = XFASTINT (XCDR (idx));
+
+ if (to >= ASIZE (elt))
+ to = ASIZE (elt) - 1;
+ for (; from <= to; from++)
+ ASET (elt, from, def);
+ if (to == XFASTINT (XCDR (idx)))
+ /* We have defined all keys in IDX. */
+ return def;
+ }
insertion_point = tail;
}
else if (CHAR_TABLE_P (elt))
NILP (def) ? Qt : def);
return def;
}
+ else if (CONSP (idx) && CHARACTERP (XCAR (idx)))
+ {
+ Fset_char_table_range (elt, idx, NILP (def) ? Qt : def);
+ return def;
+ }
insertion_point = tail;
}
else if (CONSP (elt))
XSETCDR (elt, def);
return def;
}
+ else if (CONSP (idx) && CHARACTERP (XCAR (idx)))
+ {
+ int from = XFASTINT (XCAR (idx));
+ int to = XFASTINT (XCDR (idx));
+
+ if (from <= XFASTINT (XCAR (elt))
+ && to >= XFASTINT (XCAR (elt)))
+ {
+ XSETCDR (elt, def);
+ if (from == to)
+ return def;
+ }
+ }
}
else if (EQ (elt, Qkeymap))
/* If we find a 'keymap' symbol in the spine of KEYMAP,
keymap_end:
/* We have scanned the entire keymap, and not found a binding for
IDX. Let's add one. */
- CHECK_IMPURE (insertion_point);
- XSETCDR (insertion_point,
- Fcons (Fcons (idx, def), XCDR (insertion_point)));
+ {
+ Lisp_Object elt;
+
+ if (CONSP (idx) && CHARACTERP (XCAR (idx)))
+ {
+ /* IDX specifies a range of characters, and not all of them
+ were handled yet, which means this keymap doesn't have a
+ char-table. So, we insert a char-table now. */
+ elt = Fmake_char_table (Qkeymap, Qnil);
+ Fset_char_table_range (elt, idx, NILP (def) ? Qt : def);
+ }
+ else
+ elt = Fcons (idx, def);
+ CHECK_IMPURE (insertion_point);
+ XSETCDR (insertion_point, Fcons (elt, XCDR (insertion_point)));
+ }
}
return def;
copy_keymap_1 (chartable, idx, elt)
Lisp_Object chartable, idx, elt;
{
- Faset (chartable, idx, copy_keymap_item (elt));
+ Fset_char_table_range (chartable, idx, copy_keymap_item (elt));
}
DEFUN ("copy-keymap", Fcopy_keymap, Scopy_keymap, 1, 1, 0,
Lisp_Object elt = XCAR (keymap);
if (CHAR_TABLE_P (elt))
{
- int indices[3];
elt = Fcopy_sequence (elt);
- map_char_table (copy_keymap_1, Qnil, elt, elt, elt, 0, indices);
+ map_char_table (copy_keymap_1, Qnil, elt, elt);
}
else if (VECTORP (elt))
{
{
c = Faref (key, make_number (idx));
- if (CONSP (c) && lucid_event_type_list_p (c))
- c = Fevent_convert_list (c);
+ if (CONSP (c))
+ {
+ /* C may be a Lucid style event type list or a cons (FROM .
+ TO) specifying a range of characters. */
+ if (lucid_event_type_list_p (c))
+ c = Fevent_convert_list (c);
+ else if (CHARACTERP (XCAR (c)))
+ CHECK_CHARACTER_CDR (c);
+ }
if (SYMBOLP (c))
silly_event_symbol_error (c);
idx++;
}
- if (!INTEGERP (c) && !SYMBOLP (c) && !CONSP (c))
+ if (!INTEGERP (c) && !SYMBOLP (c)
+ && (!CONSP (c)
+ /* If C is a range, it must be a leaf. */
+ || (INTEGERP (XCAR (c)) && idx != length)))
error ("Key sequence contains invalid event");
if (idx == length)
int force_multibyte;
{
unsigned c2;
- int valid_p;
/* Clear all the meaningless bits above the meta bit. */
c &= meta_modifier | ~ - meta_modifier;
c2 = c & ~(alt_modifier | ctrl_modifier | hyper_modifier
| meta_modifier | shift_modifier | super_modifier);
- valid_p = SINGLE_BYTE_CHAR_P (c2) || char_valid_p (c2, 0);
- if (! valid_p)
+ if (! CHARACTERP (make_number (c2)))
{
/* KEY_DESCRIPTION_SIZE is large enough for this. */
p += sprintf (p, "[%d]", c);
}
else
{
- if (force_multibyte)
- {
- if (SINGLE_BYTE_CHAR_P (c))
- c = unibyte_char_to_multibyte (c);
- p += CHAR_STRING (c, p);
- }
- else if (NILP (current_buffer->enable_multibyte_characters))
- {
- int bit_offset;
- *p++ = '\\';
- /* The biggest character code uses 19 bits. */
- for (bit_offset = 18; bit_offset >= 0; bit_offset -= 3)
- {
- if (c >= (1 << bit_offset))
- *p++ = ((c & (7 << bit_offset)) >> bit_offset) + '0';
- }
- }
+ /* Now we are sure that C is a valid character code. */
+ if (NILP (current_buffer->enable_multibyte_characters)
+ && ! force_multibyte)
+ *p++ = multibyte_char_to_unibyte (c, Qnil);
else
- p += CHAR_STRING (c, p);
+ p += CHAR_STRING (c, (unsigned char *) p);
}
return p;
if (INTEGERP (key)) /* Normal character */
{
- unsigned int charset, c1, c2;
- int without_bits = XINT (key) & ~((-1) << CHARACTERBITS);
-
- if (SINGLE_BYTE_CHAR_P (without_bits))
- charset = 0;
- else
- SPLIT_CHAR (without_bits, charset, c1, c2);
-
- if (! CHAR_VALID_P (without_bits, 1))
- {
- char buf[256];
-
- sprintf (buf, "Invalid char code %ld", (long) XINT (key));
- return build_string (buf);
- }
- else if (charset
- && ((c1 == 0 && c2 == -1) || c2 == 0))
- {
- /* Handle a generic character. */
- Lisp_Object name;
- char buf[256];
-
- name = CHARSET_TABLE_INFO (charset, CHARSET_SHORT_NAME_IDX);
- CHECK_STRING (name);
- if (c1 == 0)
- /* Only a charset is specified. */
- sprintf (buf, "Generic char %d: all of ", without_bits);
- else
- /* 1st code-point of 2-dimensional charset is specified. */
- sprintf (buf, "Generic char %d: row %d of ", without_bits, c1);
- return concat2 (build_string (buf), name);
- }
- else
- {
- char tem[KEY_DESCRIPTION_SIZE], *end;
- int nbytes, nchars;
- Lisp_Object string;
+ char tem[KEY_DESCRIPTION_SIZE];
- end = push_key_description (XUINT (key), tem, 1);
- nbytes = end - tem;
- nchars = multibyte_chars_in_text (tem, nbytes);
- if (nchars == nbytes)
- {
- *end = '\0';
- string = build_string (tem);
- }
- else
- string = make_multibyte_string (tem, nchars, nbytes);
- return string;
- }
+ *push_key_description (XUINT (key), tem, 1) = 0;
+ return build_string (tem);
}
else if (SYMBOLP (key)) /* Function key or event-symbol */
{
CHECK_NUMBER (character);
c = XINT (character);
- if (!SINGLE_BYTE_CHAR_P (c))
+ if (!ASCII_CHAR_P (c))
{
int len = CHAR_STRING (c, str);
Faset (sequence, last, make_number (XINT (key) | meta_modifier));
}
else
- sequence = append_key (this, key);
+ {
+ if (CONSP (key))
+ key = Fcons (XCAR (key), XCDR (key));
+ sequence = append_key (this, key);
+ }
if (!NILP (where_is_cache))
{
If the definition in effect in the whole map does not match
the one in this vector, we ignore this one.
- When describing a sub-char-table, INDICES is a list of
- indices at higher levels in this char-table,
- and CHAR_TABLE_DEPTH says how many levels down we have gone.
+ ARGS is simply passed as the second argument to ELT_DESCRIBER.
+
+ INDICES and CHAR_TABLE_DEPTH are ignored. They will be removed in
+ the near future.
KEYMAP_P is 1 if vector is known to be a keymap, so map ESC to M-.
Lisp_Object definition;
Lisp_Object tem2;
Lisp_Object elt_prefix = Qnil;
- register int i;
+ int i;
Lisp_Object suppress;
Lisp_Object kludge;
int first = 1;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
/* Range of elements to be handled. */
int from, to;
- /* A flag to tell if a leaf in this level of char-table is not a
- generic character (i.e. a complete multibyte character). */
- int complete_char;
- int character;
+ Lisp_Object character;
int starting_i;
suppress = Qnil;
- if (indices == 0)
- indices = (int *) alloca (3 * sizeof (int));
-
definition = Qnil;
if (!keymap_p)
if (partial)
suppress = intern ("suppress-keymap");
- if (CHAR_TABLE_P (vector))
- {
- if (char_table_depth == 0)
- {
- /* VECTOR is a top level char-table. */
- complete_char = 1;
- from = 0;
- to = CHAR_TABLE_ORDINARY_SLOTS;
- }
- else
- {
- /* VECTOR is a sub char-table. */
- if (char_table_depth >= 3)
- /* A char-table is never that deep. */
- error ("Too deep char table");
-
- complete_char
- = (CHARSET_VALID_P (indices[0])
- && ((CHARSET_DIMENSION (indices[0]) == 1
- && char_table_depth == 1)
- || char_table_depth == 2));
-
- /* Meaningful elements are from 32th to 127th. */
- from = 32;
- to = SUB_CHAR_TABLE_ORDINARY_SLOTS;
- }
- }
- else
- {
- /* This does the right thing for ordinary vectors. */
-
- complete_char = 1;
- from = 0;
- to = XVECTOR (vector)->size;
- }
+ from = 0;
+ to = CHAR_TABLE_P (vector) ? MAX_CHAR + 1 : XVECTOR (vector)->size;
for (i = from; i < to; i++)
{
int this_shadowed = 0;
- QUIT;
+ int range_beg, range_end;
+ Lisp_Object val;
- if (CHAR_TABLE_P (vector))
- {
- if (char_table_depth == 0 && i >= CHAR_TABLE_SINGLE_BYTE_SLOTS)
- complete_char = 0;
+ QUIT;
- if (i >= CHAR_TABLE_SINGLE_BYTE_SLOTS
- && !CHARSET_DEFINED_P (i - 128))
- continue;
+ starting_i = i;
- definition
- = get_keyelt (XCHAR_TABLE (vector)->contents[i], 0);
- }
+ if (CHAR_TABLE_P (vector))
+ val = char_table_ref_and_range (vector, i, &range_beg, &i);
else
- definition = get_keyelt (AREF (vector, i), 0);
+ val = AREF (vector, i);
+ definition = get_keyelt (val, 0);
if (NILP (definition)) continue;
if (!NILP (tem)) continue;
}
- /* Set CHARACTER to the character this entry describes, if any.
- Also update *INDICES. */
- if (CHAR_TABLE_P (vector))
- {
- indices[char_table_depth] = i;
-
- if (char_table_depth == 0)
- {
- character = i;
- indices[0] = i - 128;
- }
- else if (complete_char)
- {
- character = MAKE_CHAR (indices[0], indices[1], indices[2]);
- }
- else
- character = 0;
- }
- else
- character = i;
-
- ASET (kludge, 0, make_number (character));
+ character = make_number (starting_i);
+ ASET (kludge, 0, character);
/* If this binding is shadowed by some other map, ignore it. */
- if (!NILP (shadow) && complete_char)
+ if (!NILP (shadow))
{
Lisp_Object tem;
/* Ignore this definition if it is shadowed by an earlier
one in the same keymap. */
- if (!NILP (entire_map) && complete_char)
+ if (!NILP (entire_map))
{
Lisp_Object tem;
if (first)
{
- if (char_table_depth == 0)
- insert ("\n", 1);
+ insert ("\n", 1);
first = 0;
}
- /* For a sub char-table, show the depth by indentation.
- CHAR_TABLE_DEPTH can be greater than 0 only for a char-table. */
- if (char_table_depth > 0)
- insert (" ", char_table_depth * 2); /* depth is 1 or 2. */
-
/* Output the prefix that applies to every entry in this map. */
if (!NILP (elt_prefix))
insert1 (elt_prefix);
- /* Insert or describe the character this slot is for,
- or a description of what it is for. */
- if (SUB_CHAR_TABLE_P (vector))
- {
- if (complete_char)
- insert_char (character);
- else
- {
- /* We need an octal representation for this block of
- characters. */
- char work[16];
- sprintf (work, "(row %d)", i);
- insert (work, strlen (work));
- }
- }
- else if (CHAR_TABLE_P (vector))
- {
- if (complete_char)
- insert1 (Fkey_description (kludge, prefix));
- else
- {
- /* Print the information for this character set. */
- insert_string ("<");
- tem2 = CHARSET_TABLE_INFO (i - 128, CHARSET_SHORT_NAME_IDX);
- if (STRINGP (tem2))
- insert_from_string (tem2, 0, 0, SCHARS (tem2),
- SBYTES (tem2), 0);
- else
- insert ("?", 1);
- insert (">", 1);
- }
- }
- else
- {
- insert1 (Fkey_description (kludge, prefix));
- }
-
- /* If we find a sub char-table within a char-table,
- scan it recursively; it defines the details for
- a character set or a portion of a character set. */
- if (CHAR_TABLE_P (vector) && SUB_CHAR_TABLE_P (definition))
- {
- insert ("\n", 1);
- describe_vector (definition, prefix, args, elt_describer,
- partial, shadow, entire_map,
- indices, char_table_depth + 1, keymap_p,
- mention_shadow);
- continue;
- }
-
- starting_i = i;
+ insert1 (Fkey_description (kludge, prefix));
/* Find all consecutive characters or rows that have the same
definition. But, for elements of a top level char table, if
they are for charsets, we had better describe one by one even
if they have the same definition. */
if (CHAR_TABLE_P (vector))
- {
- int limit = to;
-
- if (char_table_depth == 0)
- limit = CHAR_TABLE_SINGLE_BYTE_SLOTS;
-
- while (i + 1 < limit
- && (tem2 = get_keyelt (XCHAR_TABLE (vector)->contents[i + 1], 0),
- !NILP (tem2))
- && !NILP (Fequal (tem2, definition)))
- i++;
- }
+ while (i + 1 < to
+ && (val = char_table_ref_and_range (vector, i + 1,
+ &range_beg, &range_end),
+ tem2 = get_keyelt (val, 0),
+ !NILP (tem2))
+ && !NILP (Fequal (tem2, definition)))
+ i = range_end;
else
while (i + 1 < to
&& (tem2 = get_keyelt (AREF (vector, i + 1), 0),
&& !NILP (Fequal (tem2, definition)))
i++;
-
/* If we have a range of more than one character,
print where the range reaches to. */
if (!NILP (elt_prefix))
insert1 (elt_prefix);
- if (CHAR_TABLE_P (vector))
- {
- if (char_table_depth == 0)
- {
- insert1 (Fkey_description (kludge, prefix));
- }
- else if (complete_char)
- {
- indices[char_table_depth] = i;
- character = MAKE_CHAR (indices[0], indices[1], indices[2]);
- insert_char (character);
- }
- else
- {
- /* We need an octal representation for this block of
- characters. */
- char work[16];
- sprintf (work, "(row %d)", i);
- insert (work, strlen (work));
- }
- }
- else
- {
- insert1 (Fkey_description (kludge, prefix));
- }
+ insert1 (Fkey_description (kludge, prefix));
}
/* Print a description of the definition of this character.
}
}
- /* For (sub) char-table, print `defalt' slot at last. */
- if (CHAR_TABLE_P (vector) && !NILP (XCHAR_TABLE (vector)->defalt))
+ if (CHAR_TABLE_P (vector) && ! NILP (XCHAR_TABLE (vector)->defalt))
{
- insert (" ", char_table_depth * 2);
- insert_string ("<<default>>");
+ if (!NILP (elt_prefix))
+ insert1 (elt_prefix);
+ insert ("default", 7);
(*elt_describer) (XCHAR_TABLE (vector)->defalt, args);
}
/* Fundamental definitions for GNU Emacs Lisp interpreter.
Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1997, 1998, 1999, 2000,
- 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
+ Free Software Foundation, Inc.
This file is part of GNU Emacs.
PVEC_BUFFER = 0x20000,
PVEC_HASH_TABLE = 0x40000,
PVEC_TERMINAL = 0x80000,
- PVEC_OTHER = 0x100000,
- PVEC_TYPE_MASK = 0x1ffe00
+ PVEC_SUB_CHAR_TABLE = 0x100000,
+ PVEC_OTHER = 0x200000,
+ PVEC_TYPE_MASK = 0x2ffe00
#if 0 /* This is used to make the value of PSEUDOVECTOR_FLAG available to
GDB. It doesn't work on OS Alpha. Moved to a variable in
#define EQ(x, y) (XHASH (x) == XHASH (y))
-/* During garbage collection, XGCTYPE must be used for extracting types
- so that the mark bit is ignored. XMARKBIT accesses the markbit.
- Markbits are used only in particular slots of particular structure types.
- Other markbits are always zero.
- Outside of garbage collection, all mark bits are always zero. */
-
-#ifndef XGCTYPE
-/* The distinction does not exist now that the MARKBIT has been eliminated. */
-#define XGCTYPE(a) XTYPE (a)
-#endif
-
#ifndef XPNTR
#ifdef HAVE_SHM
/* In this representation, data is found in two widely separated segments. */
/* Extract a value or address from a Lisp_Object. */
-#define XCONS(a) (eassert (GC_CONSP(a)),(struct Lisp_Cons *) XPNTR(a))
-#define XVECTOR(a) (eassert (GC_VECTORLIKEP(a)),(struct Lisp_Vector *) XPNTR(a))
-#define XSTRING(a) (eassert (GC_STRINGP(a)),(struct Lisp_String *) XPNTR(a))
-#define XSYMBOL(a) (eassert (GC_SYMBOLP(a)),(struct Lisp_Symbol *) XPNTR(a))
-#define XFLOAT(a) (eassert (GC_FLOATP(a)),(struct Lisp_Float *) XPNTR(a))
+#define XCONS(a) (eassert (CONSP(a)),(struct Lisp_Cons *) XPNTR(a))
+#define XVECTOR(a) (eassert (VECTORLIKEP(a)),(struct Lisp_Vector *) XPNTR(a))
+#define XSTRING(a) (eassert (STRINGP(a)),(struct Lisp_String *) XPNTR(a))
+#define XSYMBOL(a) (eassert (SYMBOLP(a)),(struct Lisp_Symbol *) XPNTR(a))
+#define XFLOAT(a) (eassert (FLOATP(a)),(struct Lisp_Float *) XPNTR(a))
/* Misc types. */
/* Pseudovector types. */
-#define XPROCESS(a) (eassert (GC_PROCESSP(a)),(struct Lisp_Process *) XPNTR(a))
-#define XWINDOW(a) (eassert (GC_WINDOWP(a)),(struct window *) XPNTR(a))
-#define XTERMINAL(a) (eassert (GC_TERMINALP(a)),(struct terminal *) XPNTR(a))
-#define XSUBR(a) (eassert (GC_SUBRP(a)),(struct Lisp_Subr *) XPNTR(a))
-#define XBUFFER(a) (eassert (GC_BUFFERP(a)),(struct buffer *) XPNTR(a))
-#define XCHAR_TABLE(a) (eassert (GC_CHAR_TABLE_P (a)), (struct Lisp_Char_Table *) XPNTR(a))
-#define XBOOL_VECTOR(a) (eassert (GC_BOOL_VECTOR_P (a)), (struct Lisp_Bool_Vector *) XPNTR(a))
+#define XPROCESS(a) (eassert (PROCESSP(a)),(struct Lisp_Process *) XPNTR(a))
+#define XWINDOW(a) (eassert (WINDOWP(a)),(struct window *) XPNTR(a))
+#define XTERMINAL(a) (eassert (TERMINALP(a)),(struct terminal *) XPNTR(a))
+#define XSUBR(a) (eassert (SUBRP(a)),(struct Lisp_Subr *) XPNTR(a))
+#define XBUFFER(a) (eassert (BUFFERP(a)),(struct buffer *) XPNTR(a))
+#define XCHAR_TABLE(a) (eassert (CHAR_TABLE_P (a)), (struct Lisp_Char_Table *) XPNTR(a))
+#define XSUB_CHAR_TABLE(a) (eassert (SUB_CHAR_TABLE_P (a)), (struct Lisp_Sub_Char_Table *) XPNTR(a))
+#define XBOOL_VECTOR(a) (eassert (BOOL_VECTOR_P (a)), (struct Lisp_Bool_Vector *) XPNTR(a))
/* Construct a Lisp_Object from a value or address. */
#define XSETBUFFER(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BUFFER))
#define XSETCHAR_TABLE(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_CHAR_TABLE))
#define XSETBOOL_VECTOR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BOOL_VECTOR))
+#define XSETSUB_CHAR_TABLE(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_SUB_CHAR_TABLE))
/* Convenience macros for dealing with Lisp arrays. */
((OFFSETOF(type, nonlispfield) - OFFSETOF(struct Lisp_Vector, contents[0])) \
/ sizeof (Lisp_Object))
-/* A char table is a kind of vectorlike, with contents are like a
+/* A char-table is a kind of vectorlike, with contents are like a
vector but with a few other slots. For some purposes, it makes
- sense to handle a chartable with type struct Lisp_Vector. An
+ sense to handle a char-table with type struct Lisp_Vector. An
element of a char table can be any Lisp objects, but if it is a sub
char-table, we treat it a table that contains information of a
- group of characters of the same charsets or a specific character of
- a charset. A sub char-table has the same structure as a char table
- except for that the former omits several slots at the tail. A sub
- char table appears only in an element of a char table, and there's
- no way to access it directly from Emacs Lisp program. */
-
-/* This is the number of slots that apply to characters or character
- sets. The first 128 are for ASCII, the next 128 are for 8-bit
- European characters, and the last 128 are for multibyte characters.
- The first 256 are indexed by the code itself, but the last 128 are
- indexed by (charset-id + 128). */
-#define CHAR_TABLE_ORDINARY_SLOTS 384
-
-/* These are the slot of the default values for single byte
- characters. As 0x9A is never be a charset-id, it is safe to use
- that slot for ASCII. 0x9E and 0x80 are charset-ids of
- eight-bit-control and eight-bit-graphic respectively. */
-#define CHAR_TABLE_DEFAULT_SLOT_ASCII (0x9A + 128)
-#define CHAR_TABLE_DEFAULT_SLOT_8_BIT_CONTROL (0x9E + 128)
-#define CHAR_TABLE_DEFAULT_SLOT_8_BIT_GRAPHIC (0x80 + 128)
-
-/* This is the number of slots that apply to characters of ASCII and
- 8-bit Europeans only. */
-#define CHAR_TABLE_SINGLE_BYTE_SLOTS 256
+ specific range of characters. A sub char-table has the same
+ structure as a vector. A sub char table appears only in an element
+ of a char-table, and there's no way to access it directly from
+ Emacs Lisp program. */
/* This is the number of slots that every char table must have. This
counts the ordinary slots and the top, defalt, parent, and purpose
slots. */
-#define CHAR_TABLE_STANDARD_SLOTS (CHAR_TABLE_ORDINARY_SLOTS + 4)
-
-/* This is the number of slots that apply to position-code-1 and
- position-code-2 of a multibyte character at the 2nd and 3rd level
- sub char tables respectively. */
-#define SUB_CHAR_TABLE_ORDINARY_SLOTS 128
-
-/* This is the number of slots that every sub char table must have.
- This counts the ordinary slots and the top and defalt slot. */
-#define SUB_CHAR_TABLE_STANDARD_SLOTS (SUB_CHAR_TABLE_ORDINARY_SLOTS + 2)
+#define CHAR_TABLE_STANDARD_SLOTS (VECSIZE (struct Lisp_Char_Table) - 1)
/* Return the number of "extra" slots in the char table CT. */
(((CT)->size & PSEUDOVECTOR_SIZE_MASK) - CHAR_TABLE_STANDARD_SLOTS)
/* Almost equivalent to Faref (CT, IDX) with optimization for ASCII
- and 8-bit Europeans characters. For these characters, do not check
- validity of CT. Do not follow parent. */
-#define CHAR_TABLE_REF(CT, IDX) \
- ((IDX) >= 0 && (IDX) < CHAR_TABLE_SINGLE_BYTE_SLOTS \
- ? (!NILP (XCHAR_TABLE (CT)->contents[IDX]) \
- ? XCHAR_TABLE (CT)->contents[IDX] \
- : XCHAR_TABLE (CT)->defalt) \
- : Faref (CT, make_number (IDX)))
+ characters. Do not check validity of CT. */
+#define CHAR_TABLE_REF(CT, IDX) \
+ ((ASCII_CHAR_P (IDX) \
+ && SUB_CHAR_TABLE_P (XCHAR_TABLE (CT)->ascii) \
+ && !NILP (XSUB_CHAR_TABLE (XCHAR_TABLE (CT)->ascii)->contents[IDX])) \
+ ? XSUB_CHAR_TABLE (XCHAR_TABLE (CT)->ascii)->contents[IDX] \
+ : char_table_ref ((CT), (IDX)))
-/* Almost equivalent to Faref (CT, IDX) with optimization for ASCII
- and 8-bit Europeans characters. However, if the result is nil,
- return IDX.
+/* Almost equivalent to Faref (CT, IDX). However, if the result is
+ not a character, return IDX.
For these characters, do not check validity of CT
and do not follow parent. */
-#define CHAR_TABLE_TRANSLATE(CT, IDX) \
- ((IDX) < CHAR_TABLE_SINGLE_BYTE_SLOTS \
- ? (!NILP (XCHAR_TABLE (CT)->contents[IDX]) \
- ? XINT (XCHAR_TABLE (CT)->contents[IDX]) \
- : IDX) \
- : char_table_translate (CT, IDX))
+#define CHAR_TABLE_TRANSLATE(CT, IDX) \
+ char_table_translate (CT, IDX)
/* Equivalent to Faset (CT, IDX, VAL) with optimization for ASCII and
- 8-bit Europeans characters. Do not check validity of CT. */
-#define CHAR_TABLE_SET(CT, IDX, VAL) \
- do { \
- if (XFASTINT (IDX) < CHAR_TABLE_SINGLE_BYTE_SLOTS) \
- XCHAR_TABLE (CT)->contents[XFASTINT (IDX)] = VAL; \
- else \
- Faset (CT, IDX, VAL); \
- } while (0)
+ 8-bit European characters. Do not check validity of CT. */
+#define CHAR_TABLE_SET(CT, IDX, VAL) \
+ (((IDX) >= 0 && ASCII_CHAR_P (IDX) \
+ && SUB_CHAR_TABLE_P (XCHAR_TABLE (CT)->ascii)) \
+ ? XSUB_CHAR_TABLE (XCHAR_TABLE (CT)->ascii)->contents[IDX] = VAL \
+ : char_table_set (CT, IDX, VAL))
+
+#define CHARTAB_SIZE_BITS_0 6
+#define CHARTAB_SIZE_BITS_1 4
+#define CHARTAB_SIZE_BITS_2 5
+#define CHARTAB_SIZE_BITS_3 7
+
+extern const int chartab_size[4];
+
+struct Lisp_Sub_Char_Table;
struct Lisp_Char_Table
{
/* This is the vector's size field, which also holds the
pseudovector type information. It holds the size, too.
- The size counts the top, defalt, purpose, and parent slots.
- The last three are not counted if this is a sub char table. */
+ The size counts the defalt, parent, purpose, ascii,
+ contents, and extras slots. */
EMACS_UINT size;
struct Lisp_Vector *next;
- /* This holds a flag to tell if this is a top level char table (t)
- or a sub char table (nil). */
- Lisp_Object top;
+
/* This holds a default value,
which is used whenever the value for a specific character is nil. */
Lisp_Object defalt;
- /* This holds an actual value of each element. A sub char table
- has only SUB_CHAR_TABLE_ORDINARY_SLOTS number of elements. */
- Lisp_Object contents[CHAR_TABLE_ORDINARY_SLOTS];
- /* A sub char table doesn't has the following slots. */
-
- /* This points to another char table, which we inherit from
- when the value for a specific character is nil.
- The `defalt' slot takes precedence over this. */
+ /* This points to another char table, which we inherit from when the
+ value for a specific character is nil. The `defalt' slot takes
+ precedence over this. */
Lisp_Object parent;
- /* This should be a symbol which says what kind of use
- this char-table is meant for.
- Typically now the values can be `syntax-table' and `display-table'. */
+
+ /* This is a symbol which says what kind of use this char-table is
+ meant for. */
Lisp_Object purpose;
- /* These hold additional data. */
+
+ /* The bottom sub char-table for characters of the range 0..127. It
+ is nil if none of ASCII character has a specific value. */
+ Lisp_Object ascii;
+
+ Lisp_Object contents[(1 << CHARTAB_SIZE_BITS_0)];
+
+ /* These hold additional data. It is a vector. */
Lisp_Object extras[1];
};
+struct Lisp_Sub_Char_Table
+ {
+ /* This is the vector's size field, which also holds the
+ pseudovector type information. It holds the size, too. */
+ EMACS_INT size;
+ struct Lisp_Vector *next;
+
+ /* Depth of this sub char-table. It should be 1, 2, or 3. A sub
+ char-table of depth 1 contains 16 elments, and each element
+ covers 4096 (128*32) characters. A sub char-table of depth 2
+ contains 32 elements, and each element covers 128 characters. A
+ sub char-table of depth 3 contains 128 elements, and each element
+ is for one character. */
+ Lisp_Object depth;
+
+ /* Minimum character covered by the sub char-table. */
+ Lisp_Object min_char;
+
+ Lisp_Object contents[1];
+ };
+
/* A boolvector is a kind of vectorlike, with contents are like a string. */
struct Lisp_Bool_Vector
{
(XSETPSEUDOVECTOR (VAR, PTR, PVEC_HASH_TABLE))
#define HASH_TABLE_P(OBJ) PSEUDOVECTORP (OBJ, PVEC_HASH_TABLE)
-#define GC_HASH_TABLE_P(x) GC_PSEUDOVECTORP (x, PVEC_HASH_TABLE)
#define CHECK_HASH_TABLE(x) \
CHECK_TYPE (HASH_TABLE_P (x), Qhash_table_p, x)
(CHAR_ALT | CHAR_SUPER | CHAR_HYPER | CHAR_SHIFT | CHAR_CTL | CHAR_META)
-/* Actually, the current Emacs uses 19 bits for the character value
+/* Actually, the current Emacs uses 22 bits for the character value
itself. */
-#define CHARACTERBITS 19
+#define CHARACTERBITS 22
/* The maximum byte size consumed by push_key_description.
All callers should assure that at least this size of memory is
#define GLYPH int
/* Mask bits for face. */
-#define GLYPH_MASK_FACE 0x7FF80000
+#define GLYPH_MASK_FACE 0x7FC00000
/* Mask bits for character code. */
-#define GLYPH_MASK_CHAR 0x0007FFFF /* The lowest 19 bits */
+#define GLYPH_MASK_CHAR 0x003FFFFF /* The lowest 22 bits */
/* The FAST macros assume that we already know we're in an X window. */
/* Data type checking */
#define NILP(x) EQ (x, Qnil)
-#define GC_NILP(x) GC_EQ (x, Qnil)
#define NUMBERP(x) (INTEGERP (x) || FLOATP (x))
-#define GC_NUMBERP(x) (GC_INTEGERP (x) || GC_FLOATP (x))
#define NATNUMP(x) (INTEGERP (x) && XINT (x) >= 0)
-#define GC_NATNUMP(x) (GC_INTEGERP (x) && XINT (x) >= 0)
#define INTEGERP(x) (XTYPE ((x)) == Lisp_Int)
-#define GC_INTEGERP(x) INTEGERP (x)
#define SYMBOLP(x) (XTYPE ((x)) == Lisp_Symbol)
-#define GC_SYMBOLP(x) (XGCTYPE ((x)) == Lisp_Symbol)
#define MISCP(x) (XTYPE ((x)) == Lisp_Misc)
-#define GC_MISCP(x) (XGCTYPE ((x)) == Lisp_Misc)
#define VECTORLIKEP(x) (XTYPE ((x)) == Lisp_Vectorlike)
-#define GC_VECTORLIKEP(x) (XGCTYPE ((x)) == Lisp_Vectorlike)
#define STRINGP(x) (XTYPE ((x)) == Lisp_String)
-#define GC_STRINGP(x) (XGCTYPE ((x)) == Lisp_String)
#define CONSP(x) (XTYPE ((x)) == Lisp_Cons)
-#define GC_CONSP(x) (XGCTYPE ((x)) == Lisp_Cons)
#define FLOATP(x) (XTYPE ((x)) == Lisp_Float)
-#define GC_FLOATP(x) (XGCTYPE ((x)) == Lisp_Float)
-#define VECTORP(x) (VECTORLIKEP (x) && !(XVECTOR (x)->size & PSEUDOVECTOR_FLAG))
-#define GC_VECTORP(x) (GC_VECTORLIKEP (x) && !(XVECTOR (x)->size & PSEUDOVECTOR_FLAG))
+#define VECTORP(x) (VECTORLIKEP (x) && !(XVECTOR (x)->size & PSEUDOVECTOR_FLAG))
#define OVERLAYP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Overlay)
-#define GC_OVERLAYP(x) (GC_MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Overlay)
#define MARKERP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Marker)
-#define GC_MARKERP(x) (GC_MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Marker)
#define INTFWDP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Intfwd)
-#define GC_INTFWDP(x) (GC_MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Intfwd)
#define BOOLFWDP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Boolfwd)
-#define GC_BOOLFWDP(x) (GC_MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Boolfwd)
#define OBJFWDP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Objfwd)
-#define GC_OBJFWDP(x) (GC_MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Objfwd)
#define BUFFER_OBJFWDP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Buffer_Objfwd)
-#define GC_BUFFER_OBJFWDP(x) (GC_MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Buffer_Objfwd)
#define BUFFER_LOCAL_VALUEP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Buffer_Local_Value)
-#define GC_BUFFER_LOCAL_VALUEP(x) (GC_MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Buffer_Local_Value)
+#define SOME_BUFFER_LOCAL_VALUEP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Some_Buffer_Local_Value)
#define KBOARD_OBJFWDP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Kboard_Objfwd)
-#define GC_KBOARD_OBJFWDP(x) (GC_MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Kboard_Objfwd)
#define SAVE_VALUEP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Save_Value)
&& (((XVECTOR (x)->size & (PSEUDOVECTOR_FLAG | (code)))) \
== (PSEUDOVECTOR_FLAG | (code))))
-/* True if object X is a pseudovector whose code is CODE.
- This one works during GC. */
-#define GC_PSEUDOVECTORP(x, code) \
- (GC_VECTORLIKEP (x) \
- && (((XVECTOR (x)->size & (PSEUDOVECTOR_FLAG | (code)))) \
- == (PSEUDOVECTOR_FLAG | (code))))
-
/* Test for specific pseudovector types. */
#define WINDOW_CONFIGURATIONP(x) PSEUDOVECTORP (x, PVEC_WINDOW_CONFIGURATION)
-#define GC_WINDOW_CONFIGURATIONP(x) GC_PSEUDOVECTORP (x, PVEC_WINDOW_CONFIGURATION)
#define PROCESSP(x) PSEUDOVECTORP (x, PVEC_PROCESS)
-#define GC_PROCESSP(x) GC_PSEUDOVECTORP (x, PVEC_PROCESS)
#define WINDOWP(x) PSEUDOVECTORP (x, PVEC_WINDOW)
-#define GC_WINDOWP(x) GC_PSEUDOVECTORP (x, PVEC_WINDOW)
#define TERMINALP(x) PSEUDOVECTORP (x, PVEC_TERMINAL)
-#define GC_TERMINALP(x) GC_PSEUDOVECTORP (x, PVEC_TERMINAL)
#define SUBRP(x) PSEUDOVECTORP (x, PVEC_SUBR)
-#define GC_SUBRP(x) GC_PSEUDOVECTORP (x, PVEC_SUBR)
#define COMPILEDP(x) PSEUDOVECTORP (x, PVEC_COMPILED)
-#define GC_COMPILEDP(x) GC_PSEUDOVECTORP (x, PVEC_COMPILED)
#define BUFFERP(x) PSEUDOVECTORP (x, PVEC_BUFFER)
-#define GC_BUFFERP(x) GC_PSEUDOVECTORP (x, PVEC_BUFFER)
#define CHAR_TABLE_P(x) PSEUDOVECTORP (x, PVEC_CHAR_TABLE)
-#define GC_CHAR_TABLE_P(x) GC_PSEUDOVECTORP (x, PVEC_CHAR_TABLE)
+#define SUB_CHAR_TABLE_P(x) PSEUDOVECTORP (x, PVEC_SUB_CHAR_TABLE)
#define BOOL_VECTOR_P(x) PSEUDOVECTORP (x, PVEC_BOOL_VECTOR)
-#define GC_BOOL_VECTOR_P(x) GC_PSEUDOVECTORP (x, PVEC_BOOL_VECTOR)
#define FRAMEP(x) PSEUDOVECTORP (x, PVEC_FRAME)
-#define GC_FRAMEP(x) GC_PSEUDOVECTORP (x, PVEC_FRAME)
-
-#define SUB_CHAR_TABLE_P(x) (CHAR_TABLE_P (x) && NILP (XCHAR_TABLE (x)->top))
/* Test for image (image . spec) */
#define IMAGEP(x) (CONSP (x) && EQ (XCAR (x), Qimage))
#define ARRAYP(x) \
(VECTORP (x) || STRINGP (x) || CHAR_TABLE_P (x) || BOOL_VECTOR_P (x))
\f
-#define GC_EQ(x, y) EQ (x, y)
-
#define CHECK_LIST(x) \
CHECK_TYPE (CONSP (x) || NILP (x), Qlistp, x)
XSETCDR ((x), tmp); \
} while (0)
+#define CHECK_NATNUM_CAR(x) \
+ do { \
+ Lisp_Object tmp = XCAR (x); \
+ CHECK_NATNUM (tmp); \
+ XSETCAR ((x), tmp); \
+ } while (0)
+
+#define CHECK_NATNUM_CDR(x) \
+ do { \
+ Lisp_Object tmp = XCDR (x); \
+ CHECK_NATNUM (tmp); \
+ XSETCDR ((x), tmp); \
+ } while (0)
+
/* Cast pointers to this type to compare them. Some machines want int. */
#ifndef PNTR_COMPARISON_TYPE
#define PNTR_COMPARISON_TYPE EMACS_UINT
/* Defined in coding.c */
EXFUN (Fcoding_system_p, 1);
+EXFUN (Fcoding_system_base, 1);
+EXFUN (Fcoding_system_eol_type, 1);
+EXFUN (Fcheck_coding_system, 1);
EXFUN (Fcheck_coding_system, 1);
EXFUN (Fread_coding_system, 2);
EXFUN (Fread_non_nil_coding_system, 1);
EXFUN (Ffind_operation_coding_system, MANY);
EXFUN (Fupdate_coding_systems_internal, 0);
-EXFUN (Fencode_coding_string, 3);
-EXFUN (Fdecode_coding_string, 3);
-extern Lisp_Object detect_coding_system P_ ((const unsigned char *, int, int,
- int));
+EXFUN (Fencode_coding_string, 4);
+EXFUN (Fdecode_coding_string, 4);
+extern Lisp_Object detect_coding_system P_ ((const unsigned char *, int,
+ int, int, int, Lisp_Object));
extern void init_coding P_ ((void));
extern void init_coding_once P_ ((void));
extern void syms_of_coding P_ ((void));
-extern Lisp_Object code_convert_string_norecord P_ ((Lisp_Object, Lisp_Object,
- int));
+
+/* Defined in character.c */
+extern void init_character_once P_ ((void));
+extern void syms_of_character P_ ((void));
+EXFUN (Funibyte_char_to_multibyte, 1);
/* Defined in charset.c */
-extern EMACS_INT nonascii_insert_offset;
-extern Lisp_Object Vnonascii_translation_table;
EXFUN (Fchar_bytes, 1);
EXFUN (Fchar_width, 1);
EXFUN (Fstring, MANY);
extern int chars_in_text P_ ((const unsigned char *, int));
extern int multibyte_chars_in_text P_ ((const unsigned char *, int));
-extern int unibyte_char_to_multibyte P_ ((int));
extern int multibyte_char_to_unibyte P_ ((int, Lisp_Object));
+extern int multibyte_char_to_unibyte_safe P_ ((int));
extern Lisp_Object Qcharset;
+extern void init_charset P_ ((void));
extern void init_charset_once P_ ((void));
extern void syms_of_charset P_ ((void));
+/* Structure forward declarations. */
+struct charset;
+
+/* Defined in composite.c */
+extern void syms_of_composite P_ ((void));
/* Defined in syntax.c */
EXFUN (Fforward_word, 1);
extern Lisp_Object larger_vector P_ ((Lisp_Object, int, Lisp_Object));
extern void sweep_weak_hash_tables P_ ((void));
extern Lisp_Object Qstring_lessp;
-EXFUN (Foptimize_char_table, 1);
extern Lisp_Object Vfeatures;
-extern Lisp_Object QCtest, QCweakness, Qequal;
+extern Lisp_Object QCtest, QCweakness, Qequal, Qeq;
unsigned sxhash P_ ((Lisp_Object, int));
Lisp_Object make_hash_table P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
Lisp_Object, Lisp_Object, Lisp_Object,
extern void init_fns P_ ((void));
EXFUN (Fsxhash, 1);
EXFUN (Fmake_hash_table, MANY);
+EXFUN (Fmakehash, 1);
EXFUN (Fcopy_hash_table, 1);
EXFUN (Fhash_table_count, 1);
EXFUN (Fhash_table_rehash_size, 1);
extern Lisp_Object concat3 P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
extern Lisp_Object nconc2 P_ ((Lisp_Object, Lisp_Object));
extern Lisp_Object assq_no_quit P_ ((Lisp_Object, Lisp_Object));
+extern Lisp_Object assoc_no_quit P_ ((Lisp_Object, Lisp_Object));
extern void clear_string_char_byte_cache P_ ((void));
extern int string_char_to_byte P_ ((Lisp_Object, int));
extern int string_byte_to_char P_ ((Lisp_Object, int));
EXFUN (Fplist_get, 2);
EXFUN (Fplist_put, 3);
EXFUN (Fplist_member, 2);
-EXFUN (Fset_char_table_parent, 2);
-EXFUN (Fchar_table_extra_slot, 2);
-EXFUN (Fset_char_table_extra_slot, 3);
EXFUN (Frassoc, 2);
EXFUN (Fstring_equal, 2);
EXFUN (Fcompare_strings, 7);
EXFUN (Fstring_lessp, 2);
-extern int char_table_translate P_ ((Lisp_Object, int));
-extern void map_char_table P_ ((void (*) (Lisp_Object, Lisp_Object, Lisp_Object),
- Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, int,
- int *));
-extern Lisp_Object char_table_ref_and_index P_ ((Lisp_Object, int, int *));
extern void syms_of_fns P_ ((void));
/* Defined in floatfns.c */
extern void insert_and_inherit P_ ((const unsigned char *, int));
extern void insert_1 P_ ((const unsigned char *, int, int, int, int));
extern void insert_1_both P_ ((const unsigned char *, int, int, int, int, int));
+extern void insert_from_gap P_ ((int, int));
extern void insert_from_string P_ ((Lisp_Object, int, int, int, int, int));
extern void insert_from_buffer P_ ((struct buffer *, int, int, int));
extern void insert_char P_ ((int));
EXFUN (Fgarbage_collect, 0);
EXFUN (Fmake_byte_code, MANY);
EXFUN (Fmake_bool_vector, 2);
-EXFUN (Fmake_char_table, 2);
-extern Lisp_Object make_sub_char_table P_ ((Lisp_Object));
extern Lisp_Object Qchar_table_extra_slots;
extern struct Lisp_Vector *allocate_vector P_ ((EMACS_INT));
extern struct Lisp_Vector *allocate_pseudovector P_ ((int memlen, int lisplen, EMACS_INT tag));
extern struct buffer * allocate_buffer P_ ((void));
extern int valid_lisp_object_p P_ ((Lisp_Object));
+/* Defined in chartab.c */
+EXFUN (Fmake_char_table, 2);
+EXFUN (Fchar_table_parent, 1);
+EXFUN (Fset_char_table_parent, 2);
+EXFUN (Fchar_table_extra_slot, 2);
+EXFUN (Fset_char_table_extra_slot, 3);
+EXFUN (Fchar_table_range, 2);
+EXFUN (Fset_char_table_range, 3);
+EXFUN (Fset_char_table_default, 3);
+EXFUN (Foptimize_char_table, 1);
+EXFUN (Fmap_char_table, 2);
+extern Lisp_Object copy_char_table P_ ((Lisp_Object));
+extern Lisp_Object sub_char_table_ref P_ ((Lisp_Object, int));
+extern Lisp_Object char_table_ref P_ ((Lisp_Object, int));
+extern Lisp_Object char_table_ref_and_range P_ ((Lisp_Object, int,
+ int *, int *));
+extern Lisp_Object char_table_set P_ ((Lisp_Object, int, Lisp_Object));
+extern Lisp_Object char_table_set_range P_ ((Lisp_Object, int, int,
+ Lisp_Object));
+extern int char_table_translate P_ ((Lisp_Object, int));
+extern void map_char_table P_ ((void (*) (Lisp_Object, Lisp_Object,
+ Lisp_Object),
+ Lisp_Object, Lisp_Object, Lisp_Object));
+extern void syms_of_chartab P_ ((void));
+
/* Defined in print.c */
extern Lisp_Object Vprin1_to_string_buffer;
extern void debug_print P_ ((Lisp_Object));
extern Lisp_Object Vbuffer_alist, Vinhibit_read_only;
EXFUN (Fget_buffer, 1);
EXFUN (Fget_buffer_create, 1);
+EXFUN (Fgenerate_new_buffer_name, 2);
EXFUN (Fset_buffer, 1);
EXFUN (set_buffer_if_live, 1);
EXFUN (Fbarf_if_buffer_read_only, 0);
EXFUN (Fnext_single_property_change, 4);
EXFUN (Fnext_single_char_property_change, 4);
EXFUN (Fprevious_single_property_change, 4);
+EXFUN (Fget_text_property, 3);
EXFUN (Fput_text_property, 5);
EXFUN (Fget_text_property, 3);
EXFUN (Fprevious_char_property_change, 2);
/* Defined in category.c */
extern void init_category_once P_ ((void));
+extern Lisp_Object char_category_set P_ ((int));
extern void syms_of_category P_ ((void));
/* Defined in ccl.c */
#ifdef HAVE_WINDOW_SYSTEM
/* Defined in fontset.c */
extern void syms_of_fontset P_ ((void));
-EXFUN (Fset_fontset_font, 4);
+EXFUN (Fset_fontset_font, 5);
+EXFUN (Fnew_fontset, 2);
/* Defined in xfns.c, w32fns.c, or macfns.c */
EXFUN (Fxw_display_color_p, 1);
/* Lisp parsing and input streams.
Copyright (C) 1985, 1986, 1987, 1988, 1989, 1993, 1994, 1995,
1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- 2005, 2006, 2007 Free Software Foundation, Inc.
+ 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include "lisp.h"
#include "intervals.h"
#include "buffer.h"
+#include "character.h"
#include "charset.h"
+#include "coding.h"
#include <epaths.h>
#include "commands.h"
#include "keyboard.h"
Lisp_Object Qeval_buffer_list, Veval_buffer_list;
Lisp_Object Qfile_truename, Qdo_after_load_evaluation; /* ACM 2006/5/16 */
+/* Used instead of Qget_file_char while loading *.elc files compiled
+ by Emacs 21 or older. */
+static Lisp_Object Qget_emacs_mule_file_char;
+
+static Lisp_Object Qload_force_doc_strings;
+
extern Lisp_Object Qevent_symbol_element_mask;
extern Lisp_Object Qfile_exists_p;
/* Nonzero means read should convert strings to unibyte. */
static int load_convert_to_unibyte;
+/* Nonzero means READCHAR should read bytes one by one (not character)
+ when READCHARFUN is Qget_file_char or Qget_emacs_mule_file_char.
+ This is set to 1 by read1 temporarily while handling #@NUMBER. */
+static int load_each_byte;
+
/* Function to use for loading an Emacs Lisp source file (not
compiled) instead of readevalloop. */
Lisp_Object Vload_source_file_function;
static int read_from_string_index_byte;
static int read_from_string_limit;
-/* Number of bytes left to read in the buffer character
- that `readchar' has already advanced over. */
-static int readchar_backlog;
/* Number of characters read in the current call to Fread or
Fread_from_string. */
static int readchar_count;
static Lisp_Object Vbytecomp_version_regexp;
-static void to_multibyte P_ ((char **, char **, int *));
+static int read_emacs_mule_char P_ ((int, int (*) (int, Lisp_Object),
+ Lisp_Object));
+
static void readevalloop P_ ((Lisp_Object, FILE*, Lisp_Object,
Lisp_Object (*) (), int,
Lisp_Object, Lisp_Object,
static void end_of_file_error P_ (()) NO_RETURN;
\f
+/* Functions that read one byte from the current source READCHARFUN
+ or unreads one byte. If the integer argument C is -1, it returns
+ one read byte, or -1 when there's no more byte in the source. If C
+ is 0 or positive, it unreads C, and the return value is not
+ interesting. */
+
+static int readbyte_for_lambda P_ ((int, Lisp_Object));
+static int readbyte_from_file P_ ((int, Lisp_Object));
+static int readbyte_from_string P_ ((int, Lisp_Object));
+
/* Handle unreading and rereading of characters.
Write READCHAR to read a character,
UNREAD(c) to unread c to be read again.
- The READCHAR and UNREAD macros are meant for reading/unreading a
- byte code; they do not handle multibyte characters. The caller
- should manage them if necessary.
+ These macros correctly read/unread multibyte characters. */
- [ Actually that seems to be a lie; READCHAR will definitely read
- multibyte characters from buffer sources, at least. Is the
- comment just out of date?
- -- Colin Walters <walters@gnu.org>, 22 May 2002 16:36:50 -0400 ]
- */
-
-#define READCHAR readchar (readcharfun)
+#define READCHAR readchar (readcharfun, NULL)
#define UNREAD(c) unreadchar (readcharfun, c)
+/* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source. */
+#define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
+
+/* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
+ Qlambda, or a cons, we use this to keep an unread character because
+ a file stream can't handle multibyte-char unreading. The value -1
+ means that there's no unread character. */
+static int unread_char;
+
static int
-readchar (readcharfun)
+readchar (readcharfun, multibyte)
Lisp_Object readcharfun;
+ int *multibyte;
{
Lisp_Object tem;
register int c;
+ int (*readbyte) P_ ((int, Lisp_Object));
+ unsigned char buf[MAX_MULTIBYTE_LENGTH];
+ int i, len;
+ int emacs_mule_encoding = 0;
+
+ if (multibyte)
+ *multibyte = 0;
readchar_count++;
register struct buffer *inbuffer = XBUFFER (readcharfun);
int pt_byte = BUF_PT_BYTE (inbuffer);
- int orig_pt_byte = pt_byte;
-
- if (readchar_backlog > 0)
- /* We get the address of the byte just passed,
- which is the last byte of the character.
- The other bytes in this character are consecutive with it,
- because the gap can't be in the middle of a character. */
- return *(BUF_BYTE_ADDRESS (inbuffer, BUF_PT_BYTE (inbuffer) - 1)
- - --readchar_backlog);
if (pt_byte >= BUF_ZV_BYTE (inbuffer))
return -1;
- readchar_backlog = -1;
-
if (! NILP (inbuffer->enable_multibyte_characters))
{
/* Fetch the character code from the buffer. */
unsigned char *p = BUF_BYTE_ADDRESS (inbuffer, pt_byte);
BUF_INC_POS (inbuffer, pt_byte);
c = STRING_CHAR (p, pt_byte - orig_pt_byte);
+ if (multibyte)
+ *multibyte = 1;
}
else
{
c = BUF_FETCH_BYTE (inbuffer, pt_byte);
+ if (! ASCII_BYTE_P (c))
+ c = BYTE8_TO_CHAR (c);
pt_byte++;
}
SET_BUF_PT_BOTH (inbuffer, BUF_PT (inbuffer) + 1, pt_byte);
register struct buffer *inbuffer = XMARKER (readcharfun)->buffer;
int bytepos = marker_byte_position (readcharfun);
- int orig_bytepos = bytepos;
-
- if (readchar_backlog > 0)
- /* We get the address of the byte just passed,
- which is the last byte of the character.
- The other bytes in this character are consecutive with it,
- because the gap can't be in the middle of a character. */
- return *(BUF_BYTE_ADDRESS (inbuffer, XMARKER (readcharfun)->bytepos - 1)
- - --readchar_backlog);
if (bytepos >= BUF_ZV_BYTE (inbuffer))
return -1;
- readchar_backlog = -1;
-
if (! NILP (inbuffer->enable_multibyte_characters))
{
/* Fetch the character code from the buffer. */
unsigned char *p = BUF_BYTE_ADDRESS (inbuffer, bytepos);
BUF_INC_POS (inbuffer, bytepos);
c = STRING_CHAR (p, bytepos - orig_bytepos);
+ if (multibyte)
+ *multibyte = 1;
}
else
{
c = BUF_FETCH_BYTE (inbuffer, bytepos);
+ if (! ASCII_BYTE_P (c))
+ c = BYTE8_TO_CHAR (c);
bytepos++;
}
}
if (EQ (readcharfun, Qlambda))
- return read_bytecode_char (0);
+ {
+ readbyte = readbyte_for_lambda;
+ goto read_multibyte;
+ }
if (EQ (readcharfun, Qget_file_char))
{
- BLOCK_INPUT;
- c = getc (instream);
-#ifdef EINTR
- /* Interrupted reads have been observed while reading over the network */
- while (c == EOF && ferror (instream) && errno == EINTR)
- {
- UNBLOCK_INPUT;
- QUIT;
- BLOCK_INPUT;
- clearerr (instream);
- c = getc (instream);
- }
-#endif
- UNBLOCK_INPUT;
- return c;
+ readbyte = readbyte_from_file;
+ goto read_multibyte;
}
if (STRINGP (readcharfun))
{
if (read_from_string_index >= read_from_string_limit)
c = -1;
+ else if (STRING_MULTIBYTE (readcharfun))
+ {
+ if (multibyte)
+ *multibyte = 1;
+ FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, readcharfun,
+ read_from_string_index,
+ read_from_string_index_byte);
+ }
else
- FETCH_STRING_CHAR_ADVANCE (c, readcharfun,
- read_from_string_index,
- read_from_string_index_byte);
-
+ {
+ c = SREF (readcharfun, read_from_string_index_byte);
+ read_from_string_index++;
+ read_from_string_index_byte++;
+ }
return c;
}
+ if (CONSP (readcharfun))
+ {
+ /* This is the case that read_vector is reading from a unibyte
+ string that contains a byte sequence previously skipped
+ because of #@NUMBER. The car part of readcharfun is that
+ string, and the cdr part is a value of readcharfun given to
+ read_vector. */
+ readbyte = readbyte_from_string;
+ if (EQ (XCDR (readcharfun), Qget_emacs_mule_file_char))
+ emacs_mule_encoding = 1;
+ goto read_multibyte;
+ }
+
+ if (EQ (readcharfun, Qget_emacs_mule_file_char))
+ {
+ readbyte = readbyte_from_file;
+ emacs_mule_encoding = 1;
+ goto read_multibyte;
+ }
+
tem = call0 (readcharfun);
if (NILP (tem))
return -1;
return XINT (tem);
+
+ read_multibyte:
+ if (unread_char >= 0)
+ {
+ c = unread_char;
+ unread_char = -1;
+ return c;
+ }
+ c = (*readbyte) (-1, readcharfun);
+ if (c < 0 || load_each_byte)
+ return c;
+ if (multibyte)
+ *multibyte = 1;
+ if (ASCII_BYTE_P (c))
+ return c;
+ if (emacs_mule_encoding)
+ return read_emacs_mule_char (c, readbyte, readcharfun);
+ i = 0;
+ buf[i++] = c;
+ len = BYTES_BY_CHAR_HEAD (c);
+ while (i < len)
+ {
+ c = (*readbyte) (-1, readcharfun);
+ if (c < 0 || ! TRAILING_CODE_P (c))
+ {
+ while (--i > 1)
+ (*readbyte) (buf[i], readcharfun);
+ return BYTE8_TO_CHAR (buf[0]);
+ }
+ buf[i++] = c;
+ }
+ return STRING_CHAR (buf, i);
}
/* Unread the character C in the way appropriate for the stream READCHARFUN.
struct buffer *b = XBUFFER (readcharfun);
int bytepos = BUF_PT_BYTE (b);
- if (readchar_backlog >= 0)
- readchar_backlog++;
+ BUF_PT (b)--;
+ if (! NILP (b->enable_multibyte_characters))
+ BUF_DEC_POS (b, bytepos);
else
- {
- BUF_PT (b)--;
- if (! NILP (b->enable_multibyte_characters))
- BUF_DEC_POS (b, bytepos);
- else
- bytepos--;
+ bytepos--;
- BUF_PT_BYTE (b) = bytepos;
- }
+ BUF_PT_BYTE (b) = bytepos;
}
else if (MARKERP (readcharfun))
{
struct buffer *b = XMARKER (readcharfun)->buffer;
int bytepos = XMARKER (readcharfun)->bytepos;
- if (readchar_backlog >= 0)
- readchar_backlog++;
+ XMARKER (readcharfun)->charpos--;
+ if (! NILP (b->enable_multibyte_characters))
+ BUF_DEC_POS (b, bytepos);
else
- {
- XMARKER (readcharfun)->charpos--;
- if (! NILP (b->enable_multibyte_characters))
- BUF_DEC_POS (b, bytepos);
- else
- bytepos--;
+ bytepos--;
- XMARKER (readcharfun)->bytepos = bytepos;
- }
+ XMARKER (readcharfun)->bytepos = bytepos;
}
else if (STRINGP (readcharfun))
{
read_from_string_index_byte
= string_char_to_byte (readcharfun, read_from_string_index);
}
+ else if (CONSP (readcharfun))
+ {
+ unread_char = c;
+ }
else if (EQ (readcharfun, Qlambda))
- read_bytecode_char (1);
- else if (EQ (readcharfun, Qget_file_char))
+ {
+ unread_char = c;
+ }
+ else if (EQ (readcharfun, Qget_file_char)
+ || EQ (readcharfun, Qget_emacs_mule_file_char))
+ {
+ if (load_each_byte)
+ {
+ BLOCK_INPUT;
+ ungetc (c, instream);
+ UNBLOCK_INPUT;
+ }
+ else
+ unread_char = c;
+ }
+ else
+ call1 (readcharfun, make_number (c));
+}
+
+static int
+readbyte_for_lambda (c, readcharfun)
+ int c;
+ Lisp_Object readcharfun;
+{
+ return read_bytecode_char (c >= 0);
+}
+
+
+static int
+readbyte_from_file (c, readcharfun)
+ int c;
+ Lisp_Object readcharfun;
+{
+ if (c >= 0)
{
BLOCK_INPUT;
ungetc (c, instream);
UNBLOCK_INPUT;
+ return 0;
+ }
+
+ BLOCK_INPUT;
+ c = getc (instream);
+
+#ifdef EINTR
+ /* Interrupted reads have been observed while reading over the network */
+ while (c == EOF && ferror (instream) && errno == EINTR)
+ {
+ UNBLOCK_INPUT;
+ QUIT;
+ BLOCK_INPUT;
+ clearerr (instream);
+ c = getc (instream);
+ }
+#endif
+
+ UNBLOCK_INPUT;
+
+ return (c == EOF ? -1 : c);
+}
+
+static int
+readbyte_from_string (c, readcharfun)
+ int c;
+ Lisp_Object readcharfun;
+{
+ Lisp_Object string = XCAR (readcharfun);
+
+ if (c >= 0)
+ {
+ read_from_string_index--;
+ read_from_string_index_byte
+ = string_char_to_byte (string, read_from_string_index);
}
+
+ if (read_from_string_index >= read_from_string_limit)
+ c = -1;
else
- call1 (readcharfun, make_number (c));
+ FETCH_STRING_CHAR_ADVANCE (c, string,
+ read_from_string_index,
+ read_from_string_index_byte);
+ return c;
+}
+
+
+/* Read one non-ASCII character from INSTREAM. The character is
+ encoded in `emacs-mule' and the first byte is already read in
+ C. */
+
+extern char emacs_mule_bytes[256];
+
+static int
+read_emacs_mule_char (c, readbyte, readcharfun)
+ int c;
+ int (*readbyte) P_ ((int, Lisp_Object));
+ Lisp_Object readcharfun;
+{
+ /* Emacs-mule coding uses at most 4-byte for one character. */
+ unsigned char buf[4];
+ int len = emacs_mule_bytes[c];
+ struct charset *charset;
+ int i;
+ unsigned code;
+
+ if (len == 1)
+ /* C is not a valid leading-code of `emacs-mule'. */
+ return BYTE8_TO_CHAR (c);
+
+ i = 0;
+ buf[i++] = c;
+ while (i < len)
+ {
+ c = (*readbyte) (-1, readcharfun);
+ if (c < 0xA0)
+ {
+ while (--i > 1)
+ (*readbyte) (buf[i], readcharfun);
+ return BYTE8_TO_CHAR (buf[0]);
+ }
+ buf[i++] = c;
+ }
+
+ if (len == 2)
+ {
+ charset = emacs_mule_charset[buf[0]];
+ code = buf[1] & 0x7F;
+ }
+ else if (len == 3)
+ {
+ if (buf[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
+ || buf[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12)
+ {
+ charset = emacs_mule_charset[buf[1]];
+ code = buf[2] & 0x7F;
+ }
+ else
+ {
+ charset = emacs_mule_charset[buf[0]];
+ code = ((buf[1] << 8) | buf[2]) & 0x7F7F;
+ }
+ }
+ else
+ {
+ charset = emacs_mule_charset[buf[1]];
+ code = ((buf[2] << 8) | buf[3]) & 0x7F7F;
+ }
+ c = DECODE_CHAR (charset, code);
+ if (c < 0)
+ Fsignal (Qinvalid_read_syntax,
+ Fcons (build_string ("invalid multibyte form"), Qnil));
+ return c;
}
+
static Lisp_Object read_internal_start P_ ((Lisp_Object, Lisp_Object,
Lisp_Object));
static Lisp_Object read0 P_ ((Lisp_Object));
static Lisp_Object read_list P_ ((int, Lisp_Object));
static Lisp_Object read_vector P_ ((Lisp_Object, int));
-static int read_multibyte P_ ((int, Lisp_Object));
static Lisp_Object substitute_object_recurse P_ ((Lisp_Object, Lisp_Object,
Lisp_Object));
\f
-/* Value is non-zero if the file associated with file descriptor FD
- is a compiled Lisp file that's safe to load. Only files compiled
- with Emacs are safe to load. Files compiled with XEmacs can lead
- to a crash in Fbyte_code because of an incompatible change in the
- byte compiler. */
+/* Value is a version number of byte compiled code if the file
+ associated with file descriptor FD is a compiled Lisp file that's
+ safe to load. Only files compiled with Emacs are safe to load.
+ Files compiled with XEmacs can lead to a crash in Fbyte_code
+ because of an incompatible change in the byte compiler. */
static int
safe_to_load_p (fd)
char buf[512];
int nbytes, i;
int safe_p = 1;
+ int version = 1;
/* Read the first few bytes from the file, and look for a line
specifying the byte compiler version used. */
buf[nbytes] = '\0';
/* Skip to the next newline, skipping over the initial `ELC'
- with NUL bytes following it. */
+ with NUL bytes following it, but note the version. */
for (i = 0; i < nbytes && buf[i] != '\n'; ++i)
- ;
+ if (i == 4)
+ version = buf[i];
- if (i < nbytes
- && fast_c_string_match_ignore_case (Vbytecomp_version_regexp,
+ if (i == nbytes
+ || fast_c_string_match_ignore_case (Vbytecomp_version_regexp,
buf + i) < 0)
safe_p = 0;
}
+ if (safe_p)
+ safe_p = version;
lseek (fd, 0, SEEK_SET);
return safe_p;
int safe_p = 1;
char *fmode = "r";
Lisp_Object tmp[2];
+ int version;
+
#ifdef DOS_NT
fmode = "rt";
#endif /* DOS_NT */
tmp))
: found) ;
+ version = -1;
+
/* Check for the presence of old-style quotes and warn about them. */
specbind (Qold_style_backquotes, Qnil);
record_unwind_protect (load_warn_old_style_backquotes, file);
if (!bcmp (SDATA (found) + SBYTES (found) - 4,
- ".elc", 4))
+ ".elc", 4)
+ || (version = safe_to_load_p (fd)) > 0)
/* Load .elc files directly, but not when they are
remote and have no handler! */
{
GCPRO3 (file, found, hist_file_name);
- if (!safe_to_load_p (fd))
+ if (version < 0
+ && ! (version = safe_to_load_p (fd)))
{
safe_p = 0;
if (!load_dangerous_libraries)
load_descriptor_list
= Fcons (make_number (fileno (stream)), load_descriptor_list);
load_in_progress++;
- readevalloop (Qget_file_char, stream, hist_file_name,
- Feval, 0, Qnil, Qnil, Qnil, Qnil);
+ if (! version || version >= 22)
+ readevalloop (Qget_file_char, stream, hist_file_name,
+ Feval, 0, Qnil, Qnil, Qnil, Qnil);
+ else
+ {
+ /* We can't handle a file which was compiled with
+ byte-compile-dynamic by older version of Emacs. */
+ specbind (Qload_force_doc_strings, Qt);
+ readevalloop (Qget_emacs_mule_file_char, stream, hist_file_name, Feval,
+ 0, Qnil, Qnil, Qnil, Qnil);
+ }
unbind_to (count, Qnil);
/* Run any eval-after-load forms for this file */
record_unwind_protect (readevalloop_1, load_convert_to_unibyte ? Qt : Qnil);
load_convert_to_unibyte = !NILP (unibyte);
- readchar_backlog = -1;
-
GCPRO4 (sourcename, readfun, start, end);
/* Try to ensure sourcename is a truename, except whilst preloading. */
{
Lisp_Object retval;
- readchar_backlog = -1;
readchar_count = 0;
new_backquote_flag = 0;
read_objects = Qnil;
|| EQ (Vread_with_symbol_positions, stream))
Vread_symbol_positions_list = Qnil;
- if (STRINGP (stream))
+ if (STRINGP (stream)
+ || ((CONSP (stream) && STRINGP (XCAR (stream)))))
{
int startval, endval;
+ Lisp_Object string;
+
+ if (STRINGP (stream))
+ string = stream;
+ else
+ string = XCAR (stream);
+
if (NILP (end))
- endval = SCHARS (stream);
+ endval = SCHARS (string);
else
{
CHECK_NUMBER (end);
endval = XINT (end);
- if (endval < 0 || endval > SCHARS (stream))
- args_out_of_range (stream, end);
+ if (endval < 0 || endval > SCHARS (string))
+ args_out_of_range (string, end);
}
if (NILP (start))
CHECK_NUMBER (start);
startval = XINT (start);
if (startval < 0 || startval > endval)
- args_out_of_range (stream, start);
+ args_out_of_range (string, start);
}
read_from_string_index = startval;
- read_from_string_index_byte = string_char_to_byte (stream, startval);
+ read_from_string_index_byte = string_char_to_byte (string, startval);
read_from_string_limit = endval;
}
static int read_buffer_size;
static char *read_buffer;
-/* Read multibyte form and return it as a character. C is a first
- byte of multibyte form, and rest of them are read from
- READCHARFUN. */
-
-static int
-read_multibyte (c, readcharfun)
- register int c;
- Lisp_Object readcharfun;
-{
- /* We need the actual character code of this multibyte
- characters. */
- unsigned char str[MAX_MULTIBYTE_LENGTH];
- int len = 0;
- int bytes;
-
- if (c < 0)
- return c;
-
- str[len++] = c;
- while ((c = READCHAR) >= 0xA0
- && len < MAX_MULTIBYTE_LENGTH)
- {
- str[len++] = c;
- readchar_count--;
- }
- UNREAD (c);
- if (UNIBYTE_STR_AS_MULTIBYTE_P (str, len, bytes))
- return STRING_CHAR (str, len);
- /* The byte sequence is not valid as multibyte. Unread all bytes
- but the first one, and return the first byte. */
- while (--len > 0)
- UNREAD (str[len]);
- return str[0];
-}
-
/* Read a \-escape sequence, assuming we already read the `\'.
- If the escape sequence forces unibyte, store 1 into *BYTEREP.
- If the escape sequence forces multibyte, store 2 into *BYTEREP.
- Otherwise store 0 into *BYTEREP. */
+ If the escape sequence forces unibyte, return eight-bit char. */
static int
-read_escape (readcharfun, stringp, byterep)
+read_escape (readcharfun, stringp)
Lisp_Object readcharfun;
int stringp;
- int *byterep;
{
register int c = READCHAR;
/* \u allows up to four hex digits, \U up to eight. Default to the
behaviour for \u, and change this value in the case that \U is seen. */
int unicode_hex_count = 4;
- *byterep = 0;
-
switch (c)
{
case -1:
error ("Invalid escape character syntax");
c = READCHAR;
if (c == '\\')
- c = read_escape (readcharfun, 0, byterep);
+ c = read_escape (readcharfun, 0);
return c | meta_modifier;
case 'S':
error ("Invalid escape character syntax");
c = READCHAR;
if (c == '\\')
- c = read_escape (readcharfun, 0, byterep);
+ c = read_escape (readcharfun, 0);
return c | shift_modifier;
case 'H':
error ("Invalid escape character syntax");
c = READCHAR;
if (c == '\\')
- c = read_escape (readcharfun, 0, byterep);
+ c = read_escape (readcharfun, 0);
return c | hyper_modifier;
case 'A':
error ("Invalid escape character syntax");
c = READCHAR;
if (c == '\\')
- c = read_escape (readcharfun, 0, byterep);
+ c = read_escape (readcharfun, 0);
return c | alt_modifier;
case 's':
}
c = READCHAR;
if (c == '\\')
- c = read_escape (readcharfun, 0, byterep);
+ c = read_escape (readcharfun, 0);
return c | super_modifier;
case 'C':
case '^':
c = READCHAR;
if (c == '\\')
- c = read_escape (readcharfun, 0, byterep);
+ c = read_escape (readcharfun, 0);
if ((c & ~CHAR_MODIFIER_MASK) == '?')
return 0177 | (c & CHAR_MODIFIER_MASK);
else if (! SINGLE_BYTE_CHAR_P ((c & ~CHAR_MODIFIER_MASK)))
}
}
- *byterep = 1;
+ if (i >= 0x80 && i < 0x100)
+ i = BYTE8_TO_CHAR (i);
return i;
}
/* A hex escape, as in ANSI C. */
{
int i = 0;
+ int count = 0;
while (1)
{
c = READCHAR;
UNREAD (c);
break;
}
+ count++;
}
- *byterep = 2;
+ if (count < 3 && i >= 0x80)
+ return BYTE8_TO_CHAR (i);
return i;
}
{
int i = 0;
int count = 0;
- Lisp_Object lisp_char;
- struct gcpro gcpro1;
while (++count <= unicode_hex_count)
{
}
}
- GCPRO1 (readcharfun);
- lisp_char = call2 (intern ("decode-char"), intern ("ucs"),
- make_number (i));
- UNGCPRO;
-
- if (NILP (lisp_char))
- {
- error ("Unsupported Unicode code point: U+%x", (unsigned)i);
- }
-
- return XFASTINT (lisp_char);
+ return i;
}
default:
- if (BASE_LEADING_CODE_P (c))
- c = read_multibyte (c, readcharfun);
return c;
}
}
}
-/* Convert unibyte text in read_buffer to multibyte.
-
- Initially, *P is a pointer after the end of the unibyte text, and
- the pointer *END points after the end of read_buffer.
-
- If read_buffer doesn't have enough room to hold the result
- of the conversion, reallocate it and adjust *P and *END.
-
- At the end, make *P point after the result of the conversion, and
- return in *NCHARS the number of characters in the converted
- text. */
-
-static void
-to_multibyte (p, end, nchars)
- char **p, **end;
- int *nchars;
-{
- int nbytes;
-
- parse_str_as_multibyte (read_buffer, *p - read_buffer, &nbytes, nchars);
- if (read_buffer_size < 2 * nbytes)
- {
- int offset = *p - read_buffer;
- read_buffer_size = 2 * max (read_buffer_size, nbytes);
- read_buffer = (char *) xrealloc (read_buffer, read_buffer_size);
- *p = read_buffer + offset;
- *end = read_buffer + read_buffer_size;
- }
-
- if (nbytes != *nchars)
- nbytes = str_as_multibyte (read_buffer, read_buffer_size,
- *p - read_buffer, nchars);
-
- *p = read_buffer + nbytes;
-}
-
-
/* If the next token is ')' or ']' or '.', we store that character
in *PCH and the return value is not interesting. Else, we store
zero in *PCH and we read and return one lisp object.
{
register int c;
int uninterned_symbol = 0;
+ int multibyte;
*pch = 0;
+ load_each_byte = 0;
retry:
- c = READCHAR;
+ c = READCHAR_REPORT_MULTIBYTE (&multibyte);
if (c < 0)
end_of_file_error ();
{
Lisp_Object tmp;
tmp = read_vector (readcharfun, 0);
- if (XVECTOR (tmp)->size < CHAR_TABLE_STANDARD_SLOTS
- || XVECTOR (tmp)->size > CHAR_TABLE_STANDARD_SLOTS + 10)
+ if (XVECTOR (tmp)->size < CHAR_TABLE_STANDARD_SLOTS)
error ("Invalid size char-table");
XSETPVECTYPE (XVECTOR (tmp), PVEC_CHAR_TABLE);
- XCHAR_TABLE (tmp)->top = Qt;
return tmp;
}
else if (c == '^')
if (c == '[')
{
Lisp_Object tmp;
+ int depth, size;
+
tmp = read_vector (readcharfun, 0);
- if (XVECTOR (tmp)->size != SUB_CHAR_TABLE_STANDARD_SLOTS)
+ if (!INTEGERP (AREF (tmp, 0)))
+ error ("Invalid depth in char-table");
+ depth = XINT (AREF (tmp, 0));
+ if (depth < 1 || depth > 3)
+ error ("Invalid depth in char-table");
+ size = XVECTOR (tmp)->size - 2;
+ if (chartab_size [depth] != size)
error ("Invalid size char-table");
- XSETPVECTYPE (XVECTOR (tmp), PVEC_CHAR_TABLE);
- XCHAR_TABLE (tmp)->top = Qnil;
+ XSETPVECTYPE (XVECTOR (tmp), PVEC_SUB_CHAR_TABLE);
return tmp;
}
invalid_syntax ("#^^", 3);
UNREAD (c);
tmp = read1 (readcharfun, pch, first_in_list);
- if (size_in_chars != SCHARS (tmp)
- /* We used to print 1 char too many
- when the number of bits was a multiple of 8.
- Accept such input in case it came from an old version. */
- && ! (XFASTINT (length)
- == (SCHARS (tmp) - 1) * BOOL_VECTOR_BITS_PER_CHAR))
+ if (STRING_MULTIBYTE (tmp)
+ || (size_in_chars != SCHARS (tmp)
+ /* We used to print 1 char too many
+ when the number of bits was a multiple of 8.
+ Accept such input in case it came from an old
+ version. */
+ && ! (XFASTINT (length)
+ == (SCHARS (tmp) - 1) * BOOL_VECTOR_BITS_PER_CHAR)))
invalid_syntax ("#&...", 5);
val = Fmake_bool_vector (length, Qnil);
{
int i, nskip = 0;
+ load_each_byte = 1;
/* Read a decimal integer. */
while ((c = READCHAR) >= 0
&& c >= '0' && c <= '9')
if (c >= 0)
UNREAD (c);
- if (load_force_doc_strings && EQ (readcharfun, Qget_file_char))
+ if (load_force_doc_strings
+ && (EQ (readcharfun, Qget_file_char)
+ || EQ (readcharfun, Qget_emacs_mule_file_char)))
{
/* If we are supposed to force doc strings into core right now,
record the last string that we skipped,
c = READCHAR;
}
+ load_each_byte = 0;
goto retry;
}
if (c == '!')
case '?':
{
- int discard;
+ int modifiers;
int next_char;
int ok;
return make_number (c);
if (c == '\\')
- c = read_escape (readcharfun, 0, &discard);
- else if (BASE_LEADING_CODE_P (c))
- c = read_multibyte (c, readcharfun);
+ c = read_escape (readcharfun, 0);
+ modifiers = c & CHAR_MODIFIER_MASK;
+ c &= ~CHAR_MODIFIER_MASK;
+ if (CHAR_BYTE8_P (c))
+ c = CHAR_TO_BYTE8 (c);
+ c |= modifiers;
next_char = READCHAR;
if (next_char == '.')
char *p = read_buffer;
char *end = read_buffer + read_buffer_size;
register int c;
- /* 1 if we saw an escape sequence specifying
- a multibyte character, or a multibyte character. */
+ /* Nonzero if we saw an escape sequence specifying
+ a multibyte character. */
int force_multibyte = 0;
- /* 1 if we saw an escape sequence specifying
+ /* Nonzero if we saw an escape sequence specifying
a single-byte character. */
int force_singlebyte = 0;
- /* 1 if read_buffer contains multibyte text now. */
- int is_multibyte = 0;
int cancel = 0;
int nchars = 0;
if (c == '\\')
{
- int byterep;
+ int modifiers;
- c = read_escape (readcharfun, 1, &byterep);
+ c = read_escape (readcharfun, 1);
/* C is -1 if \ newline has just been seen */
if (c == -1)
continue;
}
- if (byterep == 1)
+ modifiers = c & CHAR_MODIFIER_MASK;
+ c = c & ~CHAR_MODIFIER_MASK;
+
+ if (CHAR_BYTE8_P (c))
force_singlebyte = 1;
- else if (byterep == 2)
+ else if (! ASCII_CHAR_P (c))
force_multibyte = 1;
- }
-
- /* A character that must be multibyte forces multibyte. */
- if (! SINGLE_BYTE_CHAR_P (c & ~CHAR_MODIFIER_MASK))
- force_multibyte = 1;
+ else /* i.e. ASCII_CHAR_P (c) */
+ {
+ /* Allow `\C- ' and `\C-?'. */
+ if (modifiers == CHAR_CTL)
+ {
+ if (c == ' ')
+ c = 0, modifiers = 0;
+ else if (c == '?')
+ c = 127, modifiers = 0;
+ }
+ if (modifiers & CHAR_SHIFT)
+ {
+ /* Shift modifier is valid only with [A-Za-z]. */
+ if (c >= 'A' && c <= 'Z')
+ modifiers &= ~CHAR_SHIFT;
+ else if (c >= 'a' && c <= 'z')
+ c -= ('a' - 'A'), modifiers &= ~CHAR_SHIFT;
+ }
+
+ if (modifiers & CHAR_META)
+ {
+ /* Move the meta bit to the right place for a
+ string. */
+ modifiers &= ~CHAR_META;
+ c = BYTE8_TO_CHAR (c | 0x80);
+ force_singlebyte = 1;
+ }
+ }
- /* If we just discovered the need to be multibyte,
- convert the text accumulated thus far. */
- if (force_multibyte && ! is_multibyte)
- {
- is_multibyte = 1;
- to_multibyte (&p, &end, &nchars);
+ /* Any modifiers remaining are invalid. */
+ if (modifiers)
+ error ("Invalid modifier in string");
+ p += CHAR_STRING (c, (unsigned char *) p);
}
-
- /* Allow `\C- ' and `\C-?'. */
- if (c == (CHAR_CTL | ' '))
- c = 0;
- else if (c == (CHAR_CTL | '?'))
- c = 127;
-
- if (c & CHAR_SHIFT)
+ else
{
- /* Shift modifier is valid only with [A-Za-z]. */
- if ((c & 0377) >= 'A' && (c & 0377) <= 'Z')
- c &= ~CHAR_SHIFT;
- else if ((c & 0377) >= 'a' && (c & 0377) <= 'z')
- c = (c & ~CHAR_SHIFT) - ('a' - 'A');
+ p += CHAR_STRING (c, (unsigned char *) p);
+ if (CHAR_BYTE8_P (c))
+ force_singlebyte = 1;
+ else if (! ASCII_CHAR_P (c))
+ force_multibyte = 1;
}
-
- if (c & CHAR_META)
- /* Move the meta bit to the right place for a string. */
- c = (c & ~CHAR_META) | 0x80;
- if (c & CHAR_MODIFIER_MASK)
- error ("Invalid modifier in string");
-
- if (is_multibyte)
- p += CHAR_STRING (c, p);
- else
- *p++ = c;
-
nchars++;
}
if (!NILP (Vpurify_flag) && NILP (Vdoc_file_name) && cancel)
return make_number (0);
- if (is_multibyte || force_singlebyte)
+ if (force_multibyte)
+ /* READ_BUFFER already contains valid multibyte forms. */
;
- else if (load_convert_to_unibyte)
- {
- Lisp_Object string;
- to_multibyte (&p, &end, &nchars);
- if (p - read_buffer != nchars)
- {
- string = make_multibyte_string (read_buffer, nchars,
- p - read_buffer);
- return Fstring_make_unibyte (string);
- }
- /* We can make a unibyte string directly. */
- is_multibyte = 0;
- }
- else if (EQ (readcharfun, Qget_file_char)
- || EQ (readcharfun, Qlambda))
+ else if (force_singlebyte)
{
- /* Nowadays, reading directly from a file is used only for
- compiled Emacs Lisp files, and those always use the
- Emacs internal encoding. Meanwhile, Qlambda is used
- for reading dynamic byte code (compiled with
- byte-compile-dynamic = t). So make the string multibyte
- if the string contains any multibyte sequences.
- (to_multibyte is a no-op if not.) */
- to_multibyte (&p, &end, &nchars);
- is_multibyte = (p - read_buffer) != nchars;
+ nchars = str_as_unibyte (read_buffer, p - read_buffer);
+ p = read_buffer + nchars;
}
else
- /* In all other cases, if we read these bytes as
- separate characters, treat them as separate characters now. */
+ /* Otherwise, READ_BUFFER contains only ASCII. */
;
/* We want readchar_count to be the number of characters, not
/* readchar_count -= (p - read_buffer) - nchars; */
if (read_pure)
return make_pure_string (read_buffer, nchars, p - read_buffer,
- is_multibyte);
+ (force_multibyte
+ || (p - read_buffer != nchars)));
return make_specified_string (read_buffer, nchars, p - read_buffer,
- is_multibyte);
+ (force_multibyte
+ || (p - read_buffer != nchars)));
}
case '.':
quoted = 1;
}
- if (! SINGLE_BYTE_CHAR_P (c))
+ if (multibyte)
p += CHAR_STRING (c, p);
else
*p++ = c;
-
c = READCHAR;
}
{
if (p1[-1] == '.')
p1[-1] = '\0';
+ /* Fixme: if we have strtol, use that, and check
+ for overflow. */
if (sizeof (int) == sizeof (EMACS_INT))
XSETINT (val, atoi (read_buffer));
else if (sizeof (long) == sizeof (EMACS_INT))
}
}
{
- Lisp_Object result = uninterned_symbol ? make_symbol (read_buffer)
- : intern (read_buffer);
+ Lisp_Object name, result;
+ EMACS_INT nbytes = p - read_buffer;
+ EMACS_INT nchars
+ = (multibyte ? multibyte_chars_in_text (read_buffer, nbytes)
+ : nbytes);
+
+ if (uninterned_symbol && ! NILP (Vpurify_flag))
+ name = make_pure_string (read_buffer, nchars, nbytes, multibyte);
+ else
+ name = make_specified_string (read_buffer, nchars, nbytes,multibyte);
+ result = (uninterned_symbol ? Fmake_symbol (name)
+ : Fintern (name, Qnil));
+
if (EQ (Vread_with_symbol_positions, Qt)
|| EQ (Vread_with_symbol_positions, readcharfun))
Vread_symbol_positions_list =
STRING_SET_CHARS (bytestr, SBYTES (bytestr));
STRING_SET_UNIBYTE (bytestr);
- item = Fread (bytestr);
+ item = Fread (Fcons (bytestr, readcharfun));
if (!CONSP (item))
error ("Invalid byte code");
/* Now handle the bytecode slot. */
ptr[COMPILED_BYTECODE] = read_pure ? Fpurecopy (bytestr) : bytestr;
}
+ else if (i == COMPILED_DOC_STRING
+ && STRINGP (item)
+ && ! STRING_MULTIBYTE (item))
+ {
+ if (EQ (readcharfun, Qget_emacs_mule_file_char))
+ item = Fdecode_coding_string (item, Qemacs_mule, Qnil, Qnil);
+ else
+ item = Fstring_as_multibyte (item);
+ }
}
ptr[i] = read_pure ? Fpurecopy (item) : item;
otem = XCONS (tem);
if (doc_reference == 2)
{
/* Get a doc string from the file we are loading.
- If it's in saved_doc_string, get it from there. */
+ If it's in saved_doc_string, get it from there.
+
+ Here, we don't know if the string is a
+ bytecode string or a doc string. As a
+ bytecode string must be unibyte, we always
+ return a unibyte string. If it is actually a
+ doc string, caller must make it
+ multibyte. */
+
int pos = XINT (XCDR (val));
/* Position is negative for user variables. */
if (pos < 0) pos = -pos;
saved_doc_string[to++] = c;
}
- return make_string (saved_doc_string + start,
- to - start);
+ return make_unibyte_string (saved_doc_string + start,
+ to - start);
}
/* Look in prev_saved_doc_string the same way. */
else if (pos >= prev_saved_doc_string_position
prev_saved_doc_string[to++] = c;
}
- return make_string (prev_saved_doc_string + start,
- to - start);
+ return make_unibyte_string (prev_saved_doc_string
+ + start,
+ to - start);
}
else
- return get_doc_string (val, 0, 0);
+ return get_doc_string (val, 1, 0);
}
return val;
Qget_file_char = intern ("get-file-char");
staticpro (&Qget_file_char);
+ Qget_emacs_mule_file_char = intern ("get-emacs-mule-file-char");
+ staticpro (&Qget_emacs_mule_file_char);
+
+ Qload_force_doc_strings = intern ("load-force-doc-strings");
+ staticpro (&Qload_force_doc_strings);
+
Qbackquote = intern ("`");
staticpro (&Qbackquote);
Qcomma = intern (",");
/* Graphical user interface functions for Mac OS.
Copyright (C) 2000, 2001, 2002, 2003, 2004,
- 2005, 2006, 2007 Free Software Foundation, Inc.
+ 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
This file is part of GNU Emacs.
{
tem = Fquery_fontset (font, Qnil);
if (STRINGP (tem))
- font = x_new_fontset (f, SDATA (tem));
+ font = x_new_fontset (f, tem);
else
font = x_new_font (f, SDATA (font));
}
font = x_new_font (f, "-ETL-fixed-medium-r-*--*-160-*-*-*-*-iso8859-1");
/* If those didn't work, look for something which will at least work. */
if (! STRINGP (font))
- font = x_new_fontset (f, "fontset-standard");
+ font = x_new_fontset (f, build_string ("fontset-standard"));
if (! STRINGP (font))
font = x_new_font (f, "-*-monaco-*-12-*-mac-roman");
if (! STRINGP (font))
{
tem = Fquery_fontset (font, Qnil);
if (STRINGP (tem))
- font = x_new_fontset (f, SDATA (tem));
+ font = x_new_fontset (f, tem);
else
font = x_new_font (f, SDATA (font));
}
font = x_new_font (f, "-ETL-fixed-medium-r-*--*-160-*-*-*-*-iso8859-1");
/* If those didn't work, look for something which will at least work. */
if (! STRINGP (font))
- font = x_new_fontset (f, "fontset-standard");
+ font = x_new_fontset (f, build_string ("fontset-standard"));
if (! STRINGP (font))
font = x_new_font (f, "-*-monaco-*-12-*-mac-roman");
if (! STRINGP (font))
/* Definitions and headers for communication on the Mac OS.
Copyright (C) 2000, 2001, 2002, 2003, 2004,
- 2005, 2006, 2007 Free Software Foundation, Inc.
+ 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
This file is part of GNU Emacs.
/* Whether to use ATSUI (Apple Type Services for Unicode Imaging) for
text drawing. */
+#if 0 /* Don't enable by default on the emacs-unicode-2 branch. */
#ifndef USE_ATSUI
#ifdef MAC_OSX
#define USE_ATSUI 1
#endif
#endif
+#endif
/* Whether to use low-level Quartz 2D (aka Core Graphics) text drawing
in preference to ATSUI for ASCII and Latin-1 characters. */
/* Implementation of GUI terminal on the Mac OS.
Copyright (C) 2000, 2001, 2002, 2003, 2004,
- 2005, 2006, 2007 Free Software Foundation, Inc.
+ 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include "intervals.h"
#include "atimer.h"
#include "keymap.h"
+#include "character.h"
+#include "ccl.h"
\f
/* Function prototypes of this page. */
static XCharStruct *x_per_char_metric P_ ((XFontStruct *, XChar2b *));
-static int mac_encode_char P_ ((int, XChar2b *, struct font_info *, int *));
+static int mac_encode_char P_ ((int, XChar2b *, struct font_info *,
+ struct charset *, int *));
static void
the two-byte form of C. Encoding is returned in *CHAR2B. */
static int
-mac_encode_char (c, char2b, font_info, two_byte_p)
+mac_encode_char (c, char2b, font_info, charset, two_byte_p)
int c;
XChar2b *char2b;
struct font_info *font_info;
+ struct charset *charset;
int *two_byte_p;
{
- int charset = CHAR_CHARSET (c);
XFontStruct *font = font_info->font;
/* FONT_INFO may define a scheme by which to encode byte1 and byte2.
check_ccl_update (ccl);
if (CHARSET_DIMENSION (charset) == 1)
{
- ccl->reg[0] = charset;
- ccl->reg[1] = char2b->byte2;
+ ccl->reg[0] = CHARSET_ID (charset);
+ ccl->reg[1] = XCHAR2B_BYTE2 (char2b);
ccl->reg[2] = -1;
}
else
{
- ccl->reg[0] = charset;
- ccl->reg[1] = char2b->byte1;
- ccl->reg[2] = char2b->byte2;
+ ccl->reg[0] = CHARSET_ID (charset);
+ ccl->reg[1] = XCHAR2B_BYTE1 (char2b);
+ ccl->reg[2] = XCHAR2B_BYTE2 (char2b);
}
- ccl_driver (ccl, NULL, NULL, 0, 0, NULL);
+ ccl_driver (ccl, NULL, NULL, 0, 0, Qnil);
/* We assume that MSBs are appropriately set/reset by CCL
program. */
if (font->max_byte1 == 0) /* 1-byte font */
- char2b->byte1 = 0, char2b->byte2 = ccl->reg[1];
+ STORE_XCHAR2B (char2b, 0, ccl->reg[1]);
else
- char2b->byte1 = ccl->reg[1], char2b->byte2 = ccl->reg[2];
+ STORE_XCHAR2B (char2b, ccl->reg[1], ccl->reg[2]);
}
- else if (font_info->encoding[charset])
+ else if (font_info->encoding_type)
{
/* Fixed encoding scheme. See fontset.h for the meaning of the
encoding numbers. */
- int enc = font_info->encoding[charset];
+ unsigned char enc = font_info->encoding_type;
if ((enc == 1 || enc == 2)
&& CHARSET_DIMENSION (charset) == 2)
char2b->byte2 |= 0x80;
if (enc == 4)
- {
- int sjis1, sjis2;
+ {
+ int code = (char2b->byte1 << 8) | char2b->byte2;
- ENCODE_SJIS (char2b->byte1, char2b->byte2, sjis1, sjis2);
- char2b->byte1 = sjis1;
- char2b->byte2 = sjis2;
- }
+ JIS_TO_SJIS (code);
+ STORE_XCHAR2B (char2b, (code >> 8), (code & 0xFF));
+ }
}
if (two_byte_p)
face = FACE_FROM_ID (s->f, MOUSE_FACE_ID);
if (s->first_glyph->type == CHAR_GLYPH)
- face_id = FACE_FOR_CHAR (s->f, face, s->first_glyph->u.ch);
+ face_id = FACE_FOR_CHAR (s->f, face, s->first_glyph->u.ch, -1, Qnil);
else
- face_id = FACE_FOR_CHAR (s->f, face, 0);
+ face_id = FACE_FOR_CHAR (s->f, face, 0, -1, Qnil);
s->face = FACE_FROM_ID (s->f, face_id);
PREPARE_FACE_FOR_DISPLAY (s->f, s->face);
/* Look for a frame with that top-level widget. Allocate the color
on that frame to get the right gamma correction value. */
- for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
- if (GC_FRAMEP (XCAR (tail))
+ for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
+ if (FRAMEP (XCAR (tail))
&& (f = XFRAME (XCAR (tail)),
(f->output_data.nothing != 1
&& FRAME_X_DISPLAY_INFO (f) == dpyinfo))
/* Don't stop displaying the initial startup message
for a switch-frame event we don't need. */
- if (GC_NILP (Vterminal_frame)
- && GC_CONSP (Vframe_list)
- && !GC_NILP (XCDR (Vframe_list)))
+ if (NILP (Vterminal_frame)
+ && CONSP (Vframe_list)
+ && !NILP (XCDR (Vframe_list)))
{
bufp->kind = FOCUS_IN_EVENT;
XSETFRAME (bufp->frame_or_window, frame);
if (dpyinfo->x_focus_frame)
{
dpyinfo->x_highlight_frame
- = ((GC_FRAMEP (FRAME_FOCUS_FRAME (dpyinfo->x_focus_frame)))
+ = ((FRAMEP (FRAME_FOCUS_FRAME (dpyinfo->x_focus_frame)))
? XFRAME (FRAME_FOCUS_FRAME (dpyinfo->x_focus_frame))
: dpyinfo->x_focus_frame);
if (! FRAME_LIVE_P (dpyinfo->x_highlight_frame))
{
int win_y, top_range;
- if (! GC_WINDOWP (bar->window))
+ if (! WINDOWP (bar->window))
abort ();
bufp->kind = SCROLL_BAR_CLICK_EVENT;
XSETVECTOR (last_mouse_scroll_bar, bar);
/* If we're dragging the bar, display it. */
- if (! GC_NILP (bar->dragging))
+ if (! NILP (bar->dragging))
{
/* Where should the handle be now? */
int new_start = y_pos - 24;
register char *fontname;
{
struct font_info *fontp
- = FS_LOAD_FONT (f, 0, fontname, -1);
+ = FS_LOAD_FONT (f, fontname);
if (!fontp)
return Qnil;
+ if (FRAME_FONT (f) == (XFontStruct *) (fontp->font))
+ /* This font is already set in frame F. There's nothing more to
+ do. */
+ return build_string (fontp->full_name);
+
FRAME_FONT (f) = (XFontStruct *) (fontp->font);
FRAME_BASELINE_OFFSET (f) = fontp->baseline_offset;
FRAME_FONTSET (f) = -1;
return build_string (fontp->full_name);
}
+\f
+/* Give frame F the fontset named FONTSETNAME as its default fontset,
+ and return the full name of that fontset. FONTSETNAME may be a
+ wildcard pattern; in that case, we choose some fontset that fits
+ the pattern. FONTSETNAME may be a font name for ASCII characters;
+ in that case, we create a fontset from that font name.
-/* Give frame F the fontset named FONTSETNAME as its default font, and
- return the full name of that fontset. FONTSETNAME may be a wildcard
- pattern; in that case, we choose some fontset that fits the pattern.
- The return value shows which fontset we chose. */
+ The return value shows which fontset we chose.
+ If FONTSETNAME specifies the default fontset, return Qt.
+ If an ASCII font in the specified fontset can't be loaded, return
+ Qnil. */
Lisp_Object
x_new_fontset (f, fontsetname)
struct frame *f;
- char *fontsetname;
+ Lisp_Object fontsetname;
{
- int fontset = fs_query_fontset (build_string (fontsetname), 0);
+ int fontset = fs_query_fontset (fontsetname, 0);
Lisp_Object result;
- if (fontset < 0)
- return Qnil;
-
- if (FRAME_FONTSET (f) == fontset)
+ if (fontset > 0 && FRAME_FONTSET(f) == fontset)
/* This fontset is already set in frame F. There's nothing more
to do. */
return fontset_name (fontset);
+ else if (fontset == 0)
+ /* The default fontset can't be the default font. */
+ return Qt;
- result = x_new_font (f, (SDATA (fontset_ascii (fontset))));
+ if (fontset > 0)
+ result = x_new_font (f, (SDATA (fontset_ascii (fontset))));
+ else
+ result = x_new_font (f, SDATA (fontsetname));
if (!STRINGP (result))
/* Can't load ASCII font. */
return Qnil;
+ if (fontset < 0)
+ fontset = new_fontset_from_font_name (result);
+
/* Since x_new_font doesn't update any fontset information, do it now. */
FRAME_FONTSET (f) = fontset;
- return build_string (fontsetname);
+ return fontset_name (fontset);
}
\f
coding.src_multibyte = 0;
coding.dst_multibyte = 1;
coding.mode |= CODING_MODE_LAST_BLOCK;
- coding.composing = COMPOSITION_DISABLED;
- buf = (char *) alloca (size);
+ coding.dst_bytes = size;
+ coding.destination = (unsigned char *) alloca (coding.dst_bytes);
- decode_coding (&coding, name, buf, strlen (name), size - 1);
- bcopy (buf, name, coding.produced);
- name[coding.produced] = '\0';
+ decode_coding_c_string (&coding, name, strlen (name), Qnil);
+ bcopy (coding.destination, name, min (coding.produced, size));
+ name[min (coding.produced, size)] = '\0';
}
}
bzero (fontp, sizeof (*fontp));
fontp->font = font;
fontp->font_idx = i;
+ fontp->charset = -1; /* fs_load_font sets it. */
fontp->name = (char *) xmalloc (strlen (fontname) + 1);
bcopy (fontname, fontp->name, strlen (fontname) + 1);
fontp->height = max_height;
}
+ /* MAC_TODO: The script encoding is irrelevant in unicode? */
/* The slot `encoding' specifies how to map a character
code-points (0x20..0x7F or 0x2020..0x7F7F) of each charset to
the font code-points (0:0x20..0x7F, 1:0xA0..0xFF), or
(0:0x2020..0x7F7F, 1:0xA0A0..0xFFFF, 3:0x20A0..0x7FFF,
2:0xA020..0xFF7F). For the moment, we don't know which charset
- uses this font. So, we set information in fontp->encoding[1]
+ uses this font. So, we set information in fontp->encoding_type
which is never used by any charset. If mapping can't be
decided, set FONT_ENCODING_NOT_DECIDED. */
if (font->mac_scriptcode == smJapanese)
- fontp->encoding[1] = 4;
+ fontp->encoding_type = 4;
else
{
- fontp->encoding[1]
+ fontp->encoding_type
= (font->max_byte1 == 0
/* 1-byte font */
? (font->min_char_or_byte2 < 0x80
# -*- Makefile -*- for GNU Emacs on the Microsoft W32 API.
# Copyright (C) 2000, 2001, 2002, 2003, 2004,
- # 2005, 2006, 2007 Free Software Foundation, Inc.
+ # 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
#
# This file is part of GNU Emacs.
#
$(BLD)/region-cache.$(O) \
$(BLD)/strftime.$(O) \
$(BLD)/charset.$(O) \
+ $(BLD)/character.$(O) \
+ $(BLD)/chartab.$(O) \
$(BLD)/coding.$(O) \
$(BLD)/category.$(O) \
$(BLD)/ccl.$(O) \
$(BLD)/image.$(O) \
$(BLD)/terminal.$(O)
+
WIN32OBJ = $(BLD)/w32term.$(O) \
$(BLD)/w32xfns.$(O) \
$(BLD)/w32fns.$(O) \
$(BLD)/w32reg.$(O) \
$(BLD)/w32bdf.$(O)
+FONTOBJ =
+ifdef USE_FONTBACKEND
+FONTOBJ = $(BLD)/font.$(O) \
+ $(BLD)/w32font.$(O)
+endif
+
LIBS = $(TLIB0) \
$(TLIB1) \
$(TLIBW32) \
$(TEMACS): $(TLIB0) $(TLIB1) $(TLIBW32) $(TLASTLIB) $(TOBJ) $(TRES) \
../nt/$(BLD)/addsection.exe
$(LINK) $(LINK_OUT)$(TEMACS_TMP) $(FULL_LINK_FLAGS) $(TOBJ) $(TRES) $(LIBS)
- "../nt/$(BLD)/addsection" "$(TEMACS_TMP)" "$(TEMACS)" EMHEAP 16
+ "../nt/$(BLD)/addsection" "$(TEMACS_TMP)" "$(TEMACS)" EMHEAP 20
echo $(OBJ0) > $(BLD)/buildobj.lst
echo $(OBJ1) >> $(BLD)/buildobj.lst
echo $(WIN32OBJ) >> $(BLD)/buildobj.lst
+ echo $(FONTOBJ) >> $(BLD)/buildobj.lst
bootstrap: bootstrap-emacs
$(TLIB1): $(OBJ1)
- $(DEL) $@
$(AR) $(AR_OUT)$@ $(ALL_DEPS)
-$(TLIBW32): $(WIN32OBJ)
+$(TLIBW32): $(WIN32OBJ) $(FONTOBJ)
- $(DEL) $@
$(AR) $(AR_OUT)$@ $(ALL_DEPS)
EMACS_ROOT = ..
SRC = .
+$(BLD)/abbrev.$(O) : \
+ $(SRC)/abbrev.c \
+ $(EMACS_ROOT)/src/s/ms-w32.h \
+ $(EMACS_ROOT)/src/m/intel386.h \
+ $(EMACS_ROOT)/src/config.h \
+ $(SRC)/buffer.h \
+ $(SRC)/character.h \
+ $(SRC)/charset.h \
+ $(SRC)/commands.h \
+ $(SRC)/dispextern.h \
+ $(SRC)/syntax.h \
+ $(SRC)/w32bdf.h \
+ $(SRC)/w32gui.h \
+ $(SRC)/window.h
+
$(BLD)/alloc.$(O) : \
$(SRC)/alloc.c \
$(EMACS_ROOT)/src/s/ms-w32.h \
$(EMACS_ROOT)/src/config.h \
$(SRC)/blockinput.h \
$(SRC)/buffer.h \
+ $(SRC)/character.h \
$(SRC)/charset.h \
$(SRC)/composite.h \
$(SRC)/dispextern.h \
$(EMACS_ROOT)/nt/inc/sys/file.h \
$(SRC)/buffer.h \
$(SRC)/ccl.h \
+ $(SRC)/character.h \
$(SRC)/charset.h \
$(SRC)/coding.h \
$(SRC)/commands.h \
$(EMACS_ROOT)/src/m/intel386.h \
$(EMACS_ROOT)/src/config.h \
$(SRC)/buffer.h \
+ $(SRC)/character.h \
$(SRC)/charset.h \
$(SRC)/commands.h \
$(SRC)/composite.h \
$(EMACS_ROOT)/src/config.h \
$(SRC)/buffer.h \
$(SRC)/category.h \
+ $(SRC)/character.h \
$(SRC)/charset.h \
$(SRC)/keymap.h
$(EMACS_ROOT)/src/m/intel386.h \
$(EMACS_ROOT)/src/config.h \
$(SRC)/ccl.h \
+ $(SRC)/character.h \
$(SRC)/charset.h \
$(SRC)/coding.h
+$(BLD)/character.$(O) : \
+ $(SRC)/character.c \
+ $(EMACS_ROOT)/src/s/ms-w32.h \
+ $(EMACS_ROOT)/src/m/intel386.h \
+ $(EMACS_ROOT)/src/config.h \
+ $(SRC)/buffer.h \
+ $(SRC)/character.h \
+ $(SRC)/charset.h \
+ $(SRC)/coding.h \
+ $(SRC)/composite.h \
+ $(SRC)/disptab.h
+
$(BLD)/charset.$(O) : \
$(SRC)/charset.c \
$(EMACS_ROOT)/src/s/ms-w32.h \
$(EMACS_ROOT)/src/config.h \
$(SRC)/buffer.h \
$(SRC)/ccl.h \
+ $(SRC)/character.h \
$(SRC)/charset.h \
$(SRC)/coding.h \
$(SRC)/composite.h \
$(SRC)/disptab.h
+$(BLD)/chartab.$(O) : \
+ $(SRC)/chartab.c \
+ $(EMACS_ROOT)/src/s/ms-w32.h \
+ $(EMACS_ROOT)/src/m/intel386.h \
+ $(EMACS_ROOT)/src/config.h \
+ $(SRC)/charset.h \
+ $(SRC)/character.h
+
$(BLD)/cm.$(O) : \
$(SRC)/cm.c \
$(EMACS_ROOT)/src/s/ms-w32.h \
$(EMACS_ROOT)/src/m/intel386.h \
$(EMACS_ROOT)/src/config.h \
$(SRC)/buffer.h \
+ $(SRC)/character.h \
$(SRC)/charset.h \
$(SRC)/commands.h \
$(SRC)/dispextern.h \
$(EMACS_ROOT)/src/config.h \
$(SRC)/buffer.h \
$(SRC)/ccl.h \
+ $(SRC)/character.h \
$(SRC)/charset.h \
$(SRC)/coding.h \
$(SRC)/composite.h \
$(EMACS_ROOT)/src/m/intel386.h \
$(EMACS_ROOT)/src/config.h \
$(SRC)/buffer.h \
+ $(SRC)/character.h \
$(SRC)/charset.h \
$(SRC)/composite.h \
$(SRC)/dispextern.h \
$(EMACS_ROOT)/src/m/intel386.h \
$(EMACS_ROOT)/src/config.h \
$(SRC)/buffer.h \
+ $(SRC)/character.h \
$(SRC)/charset.h \
$(SRC)/frame.h \
$(SRC)/keyboard.h \
$(EMACS_ROOT)/src/config.h \
$(SRC)/buffer.h \
$(SRC)/ccl.h \
+ $(SRC)/character.h \
$(SRC)/charset.h \
$(SRC)/coding.h \
$(SRC)/commands.h \
$(SRC)/atimer.h \
$(SRC)/blockinput.h \
$(SRC)/buffer.h \
+ $(SRC)/character.h \
$(SRC)/charset.h \
$(SRC)/cm.h \
$(SRC)/commands.h \
$(EMACS_ROOT)/src/config.h \
$(EMACS_ROOT)/nt/inc/sys/file.h \
$(SRC)/buffer.h \
+ $(SRC)/character.h \
$(SRC)/charset.h \
$(SRC)/keyboard.h \
$(SRC)/keymap.h
$(EMACS_ROOT)/src/s/ms-w32.h \
$(EMACS_ROOT)/src/m/intel386.h \
$(EMACS_ROOT)/src/config.h \
+ $(SRC)/character.h \
$(SRC)/charset.c
$(BLD)/editfns.$(O) : \
$(EMACS_ROOT)/nt/inc/pwd.h \
$(SRC)/buffer.h \
$(SRC)/ccl.h \
+ $(SRC)/character.h \
$(SRC)/charset.h \
$(SRC)/coding.h \
$(SRC)/composite.h \
$(EMACS_ROOT)/nt/inc/sys/file.h \
$(SRC)/buffer.h \
$(SRC)/ccl.h \
+ $(SRC)/character.h \
$(SRC)/charset.h \
$(SRC)/coding.h \
$(SRC)/commands.h \
$(EMACS_ROOT)/src/epaths.h \
$(SRC)/buffer.h \
$(SRC)/ccl.h \
+ $(SRC)/character.h \
$(SRC)/charset.h \
$(SRC)/coding.h \
$(SRC)/systime.h
$(SRC)/blockinput.h \
$(SRC)/buffer.h \
$(SRC)/ccl.h \
+ $(SRC)/character.h \
$(SRC)/charset.h \
$(SRC)/coding.h \
$(SRC)/commands.h \
$(SRC)/w32gui.h \
$(SRC)/window.h
+$(BLD)/font.$(O) : \
+ $(SRC)/font.c \
+ $(EMACS_ROOT)/src/s/ms-w32.h \
+ $(EMACS_ROOT)/src/m/intel386.h \
+ $(EMACS_ROOT)/src/config.h \
+ $(SRC)/dispextern.h \
+ $(SRC)/frame.h \
+ $(SRC)/window.h \
+ $(SRC)/ccl.h \
+ $(SRC)/character.h \
+ $(SRC)/charset.h \
+ $(SRC)/font.h
+
$(BLD)/fontset.$(O) : \
$(SRC)/fontset.c \
$(EMACS_ROOT)/src/s/ms-w32.h \
$(EMACS_ROOT)/src/config.h \
$(SRC)/buffer.h \
$(SRC)/ccl.h \
+ $(SRC)/character.h \
$(SRC)/charset.h \
$(SRC)/dispextern.h \
+ $(SRC)/font.h \
$(SRC)/fontset.h \
$(SRC)/frame.h \
$(SRC)/keyboard.h \
$(SRC)/atimer.h \
$(SRC)/blockinput.h \
$(SRC)/buffer.h \
+ $(SRC)/character.h \
$(SRC)/charset.h \
$(SRC)/commands.h \
$(SRC)/dispextern.h \
$(EMACS_ROOT)/src/config.h \
$(SRC)/buffer.h \
$(SRC)/category.h \
+ $(SRC)/character.h \
$(SRC)/charset.h \
$(SRC)/composite.h \
$(SRC)/dispextern.h \
$(SRC)/atimer.h \
$(SRC)/blockinput.h \
$(SRC)/buffer.h \
+ $(SRC)/character.h \
$(SRC)/charset.h \
$(SRC)/composite.h \
$(SRC)/dispextern.h \
$(SRC)/atimer.h \
$(SRC)/blockinput.h \
$(SRC)/buffer.h \
+ $(SRC)/character.h \
$(SRC)/charset.h \
$(SRC)/commands.h \
$(SRC)/composite.h \
$(SRC)/atimer.h \
$(SRC)/blockinput.h \
$(SRC)/buffer.h \
+ $(SRC)/character.h \
$(SRC)/charset.h \
$(SRC)/commands.h \
$(SRC)/composite.h \
$(SRC)/blockinput.h \
$(SRC)/buffer.h \
$(SRC)/ccl.h \
+ $(SRC)/character.h \
$(SRC)/charset.h \
$(SRC)/coding.h \
$(SRC)/commands.h \
$(EMACS_ROOT)/src/m/intel386.h \
$(EMACS_ROOT)/src/config.h \
$(SRC)/buffer.h \
+ $(SRC)/character.h \
$(SRC)/charset.h
$(BLD)/md5.$(O) : \
$(EMACS_ROOT)/src/m/intel386.h \
$(EMACS_ROOT)/src/config.h \
$(SRC)/buffer.h \
+ $(SRC)/character.h \
$(SRC)/charset.h \
$(SRC)/commands.h \
$(SRC)/composite.h \
$(EMACS_ROOT)/nt/inc/langinfo.h \
$(EMACS_ROOT)/nt/inc/nl_types.h \
$(SRC)/config.h \
+ $(SRC)/character.h \
$(SRC)/process.h \
$(SRC)/syssignal.h \
$(SRC)/systime.h \
$(SRC)/s/ms-w32.h \
$(SRC)/m/intel386.h \
$(SRC)/ccl.h \
+ $(SRC)/character.h \
$(SRC)/charset.h \
$(SRC)/coding.h \
$(SRC)/config.h \
$(EMACS_ROOT)/src/m/intel386.h \
$(EMACS_ROOT)/src/config.h \
$(SRC)/buffer.h \
+ $(SRC)/character.h \
$(SRC)/charset.h \
$(SRC)/composite.h \
$(SRC)/dispextern.h \
$(SRC)/blockinput.h \
$(SRC)/buffer.h \
$(SRC)/ccl.h \
+ $(SRC)/character.h \
$(SRC)/charset.h \
$(SRC)/coding.h \
$(SRC)/commands.h \
$(SRC)/m/intel386.h \
$(SRC)/buffer.h \
$(SRC)/category.h \
+ $(SRC)/character.h \
$(SRC)/charset.h \
$(SRC)/config.h \
$(SRC)/regex.h \
$(SRC)/blockinput.h \
$(SRC)/buffer.h \
$(SRC)/category.h \
+ $(SRC)/character.h \
$(SRC)/charset.h \
$(SRC)/commands.h \
$(SRC)/composite.h \
$(EMACS_ROOT)/src/config.h \
$(SRC)/buffer.h \
$(SRC)/category.h \
+ $(SRC)/character.h \
$(SRC)/charset.h \
$(SRC)/commands.h \
$(SRC)/composite.h \
$(EMACS_ROOT)/src/m/intel386.h \
$(EMACS_ROOT)/src/config.h \
$(SRC)/ccl.h \
+ $(SRC)/character.h \
$(SRC)/charset.h \
$(SRC)/cm.h \
$(SRC)/coding.h \
$(SRC)/blockinput.h \
$(SRC)/buffer.h \
$(SRC)/ccl.h \
+ $(SRC)/character.h \
$(SRC)/charset.h \
$(SRC)/coding.h \
$(SRC)/commands.h \
$(SRC)/composite.h \
$(SRC)/dispextern.h \
$(SRC)/disptab.h \
+ $(SRC)/font.h \
$(SRC)/fontset.h \
$(SRC)/frame.h \
$(SRC)/indent.h \
$(SRC)/atimer.h \
$(SRC)/blockinput.h \
$(SRC)/buffer.h \
+ $(SRC)/character.h \
$(SRC)/charset.h \
$(SRC)/composite.h \
$(SRC)/dispextern.h \
+ $(SRC)/font.h \
$(SRC)/fontset.h \
$(SRC)/frame.h \
$(SRC)/intervals.h \
$(SRC)/blockinput.h \
$(SRC)/buffer.h \
$(SRC)/ccl.h \
+ $(SRC)/character.h \
$(SRC)/charset.h \
$(SRC)/coding.h \
$(SRC)/composite.h \
$(SRC)/dispextern.h \
$(SRC)/epaths.h \
+ $(SRC)/font.h \
$(SRC)/fontset.h \
$(SRC)/frame.h \
$(SRC)/intervals.h \
$(SRC)/atimer.h \
$(SRC)/blockinput.h \
$(SRC)/buffer.h \
+ $(SRC)/character.h \
$(SRC)/charset.h \
$(SRC)/coding.h \
$(SRC)/dispextern.h \
$(SRC)/blockinput.h \
$(SRC)/buffer.h \
$(SRC)/ccl.h \
+ $(SRC)/character.h \
$(SRC)/charset.h \
$(SRC)/coding.h \
$(SRC)/composite.h \
$(SRC)/dispextern.h \
$(SRC)/disptab.h \
+ $(SRC)/font.h \
$(SRC)/fontset.h \
$(SRC)/frame.h \
$(SRC)/gnu.h \
$(SRC)/blockinput.h \
$(SRC)/buffer.h \
$(SRC)/ccl.h \
+ $(SRC)/character.h \
$(SRC)/charset.h \
$(SRC)/coding.h \
$(SRC)/composite.h \
$(EMACS_ROOT)/src/config.h \
$(SRC)/atimer.h \
$(SRC)/blockinput.h \
+ $(SRC)/character.h \
$(SRC)/charset.h \
$(SRC)/fontset.h \
$(SRC)/frame.h \
$(EMACS_ROOT)/src/config.h \
$(SRC)/atimer.h \
$(SRC)/blockinput.h \
+ $(SRC)/character.h \
$(SRC)/charset.h \
$(SRC)/dispextern.h \
$(SRC)/fontset.h \
$(SRC)/w32gui.h \
$(SRC)/w32term.h
+$(BLD)/w32font$(O): \
+ $(SRC)/w32font.c \
+ $(EMACS_ROOT)/src/s/ms-w32.h \
+ $(EMACS_ROOT)/src/m/intel386.h \
+ $(EMACS_ROOT)/src/config.h \
+ $(SRC)/character.h \
+ $(SRC)/charset.h \
+ $(SRC)/dispextern.h \
+ $(SRC)/font.h \
+ $(SRC)/fontset.h \
+ $(SRC)/frame.h \
+ $(SRC)/w32font.h \
+ $(SRC)/w32gui.h \
+ $(SRC)/w32term.h
+
# Each object file depends on stamp_BLD, because in parallel builds we must
# make sure $(BLD) exists before starting compilations.
#
-$(OBJ0) $(OBJ1) $(WIN32OBJ) $(BLD)/lastfile.$(O) $(BLD)/firstfile.$(O): stamp_BLD
+$(OBJ0) $(OBJ1) $(WIN32OBJ) $(FONTOBJ) $(BLD)/lastfile.$(O) $(BLD)/firstfile.$(O): stamp_BLD
/* Markers: examining, setting and deleting.
Copyright (C) 1985, 1997, 1998, 2001, 2002, 2003, 2004,
- 2005, 2006, 2007 Free Software Foundation, Inc.
+ 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include <config.h>
#include "lisp.h"
#include "buffer.h"
-#include "charset.h"
+#include "character.h"
/* Record one cached position found recently by
buf_charpos_to_bytepos or buf_bytepos_to_charpos. */
/* Minibuffer input and completion.
Copyright (C) 1985, 1986, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
2001, 2002, 2003, 2004, 2005,
- 2006, 2007 Free Software Foundation, Inc.
+ 2006, 2007, 2008 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include "lisp.h"
#include "commands.h"
#include "buffer.h"
-#include "charset.h"
+#include "character.h"
#include "dispextern.h"
#include "keyboard.h"
#include "frame.h"
/* Now find first word-break in the stuff found by completion.
i gets index in string of where to stop completing. */
- {
- int len, c;
- int bytes = SBYTES (completion);
- register const unsigned char *completion_string = SDATA (completion);
- for (; i_byte < SBYTES (completion); i_byte += len, i++)
- {
- c = STRING_CHAR_AND_LENGTH (completion_string + i_byte,
- bytes - i_byte,
- len);
- if (SYNTAX (c) != Sword)
- {
- i_byte += len;
- i++;
- break;
- }
- }
- }
+ while (i_byte < SBYTES (completion))
+ {
+ int c;
+
+ FETCH_STRING_CHAR_AS_MULTIBYTE_ADVANCE (c, completion, i, i_byte);
+ if (SYNTAX (c) != Sword)
+ break;
+ }
/* If got no characters, print help for user. */
doc: /* Terminate minibuffer input. */)
()
{
- if (INTEGERP (last_command_char))
+ if (CHARACTERP (last_command_char))
internal_self_insert (XINT (last_command_char), 0);
else
bitch_at_user ();
/* MS-DOS specific C utilities. -*- coding: raw-text -*-
Copyright (C) 1993, 1994, 1995, 1996, 1997, 1999, 2000, 2001, 2002,
- 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ 2003, 2004, 2005, 2006, 2007, 2008
+ Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include "dispextern.h"
#include "dosfns.h"
#include "termopts.h"
-#include "charset.h"
+#include "character.h"
#include "coding.h"
#include "disptab.h"
#include "frame.h"
screensize = screen_size * 2;
faces[0]
= lookup_derived_face (sf, intern ("msdos-menu-passive-face"),
- 0, DEFAULT_FACE_ID, 1);
+ DEFAULT_FACE_ID, 1);
faces[1]
= lookup_derived_face (sf, intern ("msdos-menu-active-face"),
- 0, DEFAULT_FACE_ID, 1);
+ DEFAULT_FACE_ID, 1);
selectface = intern ("msdos-menu-select-face");
faces[2] = lookup_derived_face (sf, selectface,
- 0, faces[0], 1);
+ faces[0], 1);
faces[3] = lookup_derived_face (sf, selectface,
- 0, faces[1], 1);
+ faces[1], 1);
/* Make sure the menu title is always displayed with
`msdos-menu-active-face', no matter where the mouse pointer is. */
/* Lisp object printing and output streams.
Copyright (C) 1985, 1986, 1988, 1993, 1994, 1995, 1997,
1998, 1999, 2000, 2001, 2002, 2003, 2004,
- 2005, 2006, 2007 Free Software Foundation, Inc.
+ 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include <stdio.h>
#include "lisp.h"
#include "buffer.h"
+#include "character.h"
#include "charset.h"
#include "keyboard.h"
#include "frame.h"
{
int chars;
+ if (print_escape_nonascii)
+ string = string_escape_byte8 (string);
+
if (STRING_MULTIBYTE (string))
chars = SCHARS (string);
- else if (EQ (printcharfun, Qt)
- ? ! NILP (buffer_defaults.enable_multibyte_characters)
- : ! NILP (current_buffer->enable_multibyte_characters))
+ else if (! print_escape_nonascii
+ && (EQ (printcharfun, Qt)
+ ? ! NILP (buffer_defaults.enable_multibyte_characters)
+ : ! NILP (current_buffer->enable_multibyte_characters)))
{
/* If unibyte string STRING contains 8-bit codes, we must
convert STRING to a multibyte string containing the same
int len;
int ch = STRING_CHAR_AND_LENGTH (SDATA (string) + i,
size_byte - i, len);
- if (!CHAR_VALID_P (ch, 0))
- {
- ch = SREF (string, i);
- len = 1;
- }
PRINTCHAR (ch);
i += len;
}
print_number_index++;
}
- switch (XGCTYPE (obj))
+ switch (XTYPE (obj))
{
case Lisp_String:
/* A string may have text properties, which can be circular. */
print_preprocess (interval->plist);
}
+/* A flag to control printing of `charset' text property.
+ The default value is Qdefault. */
+Lisp_Object Vprint_charset_text_property;
+extern Lisp_Object Qdefault;
+
+static void print_check_string_charset_prop ();
+
+#define PRINT_STRING_NON_CHARSET_FOUND 1
+#define PRINT_STRING_UNSAFE_CHARSET_FOUND 2
+
+/* Bitwize or of the abobe macros. */
+static int print_check_string_result;
+
+static void
+print_check_string_charset_prop (interval, string)
+ INTERVAL interval;
+ Lisp_Object string;
+{
+ Lisp_Object val;
+
+ if (NILP (interval->plist)
+ || (print_check_string_result == (PRINT_STRING_NON_CHARSET_FOUND
+ | PRINT_STRING_UNSAFE_CHARSET_FOUND)))
+ return;
+ for (val = interval->plist; CONSP (val) && ! EQ (XCAR (val), Qcharset);
+ val = XCDR (XCDR (val)));
+ if (! CONSP (val))
+ {
+ print_check_string_result |= PRINT_STRING_NON_CHARSET_FOUND;
+ return;
+ }
+ if (! (print_check_string_result & PRINT_STRING_NON_CHARSET_FOUND))
+ {
+ if (! EQ (val, interval->plist)
+ || CONSP (XCDR (XCDR (val))))
+ print_check_string_result |= PRINT_STRING_NON_CHARSET_FOUND;
+ }
+ if (NILP (Vprint_charset_text_property)
+ || ! (print_check_string_result & PRINT_STRING_UNSAFE_CHARSET_FOUND))
+ {
+ int i, c;
+ int charpos = interval->position;
+ int bytepos = string_char_to_byte (string, charpos);
+ Lisp_Object charset;
+
+ charset = XCAR (XCDR (val));
+ for (i = 0; i < LENGTH (interval); i++)
+ {
+ FETCH_STRING_CHAR_ADVANCE (c, string, charpos, bytepos);
+ if (! ASCII_CHAR_P (c)
+ && ! EQ (CHARSET_NAME (CHAR_CHARSET (c)), charset))
+ {
+ print_check_string_result |= PRINT_STRING_UNSAFE_CHARSET_FOUND;
+ break;
+ }
+ }
+ }
+}
+
+/* The value is (charset . nil). */
+static Lisp_Object print_prune_charset_plist;
+
+static Lisp_Object
+print_prune_string_charset (string)
+ Lisp_Object string;
+{
+ print_check_string_result = 0;
+ traverse_intervals (STRING_INTERVALS (string), 0,
+ print_check_string_charset_prop, string);
+ if (! (print_check_string_result & PRINT_STRING_UNSAFE_CHARSET_FOUND))
+ {
+ string = Fcopy_sequence (string);
+ if (print_check_string_result & PRINT_STRING_NON_CHARSET_FOUND)
+ {
+ if (NILP (print_prune_charset_plist))
+ print_prune_charset_plist = Fcons (Qcharset, Qnil);
+ Fremove_text_properties (make_number (0),
+ make_number (SCHARS (string)),
+ print_prune_charset_plist, string);
+ }
+ else
+ Fset_text_properties (make_number (0), make_number (SCHARS (string)),
+ Qnil, string);
+ }
+ return string;
+}
+
static void
print_object (obj, printcharfun, escapeflag)
Lisp_Object obj;
/* Detect circularities and truncate them. */
if (STRINGP (obj) || CONSP (obj) || VECTORP (obj)
- || COMPILEDP (obj) || CHAR_TABLE_P (obj)
+ || COMPILEDP (obj) || CHAR_TABLE_P (obj) || SUB_CHAR_TABLE_P (obj)
|| (! NILP (Vprint_gensym)
&& SYMBOLP (obj)
&& !SYMBOL_INTERNED_P (obj)))
}
#endif /* MAX_PRINT_CHARS */
- switch (XGCTYPE (obj))
+ switch (XTYPE (obj))
{
case Lisp_Int:
if (sizeof (int) == sizeof (EMACS_INT))
GCPRO1 (obj);
+ if (! EQ (Vprint_charset_text_property, Qt))
+ obj = print_prune_string_charset (obj);
+
if (!NULL_INTERVAL_P (STRING_INTERVALS (obj)))
{
PRINTCHAR ('#');
{
c = STRING_CHAR_AND_LENGTH (str + i_byte,
size_byte - i_byte, len);
- if (CHAR_VALID_P (c, 0))
- i_byte += len;
- else
- c = str[i_byte++];
+ i_byte += len;
}
else
c = str[i_byte++];
PRINTCHAR ('f');
}
else if (multibyte
- && ! ASCII_BYTE_P (c)
- && (SINGLE_BYTE_CHAR_P (c) || print_escape_multibyte))
+ && (CHAR_BYTE8_P (c)
+ || (! ASCII_CHAR_P (c) && print_escape_multibyte)))
{
/* When multibyte is disabled,
print multibyte string chars using hex escapes.
when found in a multibyte string, always use a hex escape
so it reads back as multibyte. */
unsigned char outbuf[50];
- sprintf (outbuf, "\\x%x", c);
+
+ if (CHAR_BYTE8_P (c))
+ sprintf (outbuf, "\\%03o", CHAR_TO_BYTE8 (c));
+ else
+ {
+ sprintf (outbuf, "\\x%04x", c);
+ need_nonhex = 1;
+ }
strout (outbuf, -1, -1, printcharfun, 0);
- need_nonhex = 1;
}
else if (! multibyte
&& SINGLE_BYTE_CHAR_P (c) && ! ASCII_BYTE_P (c)
{
QUIT;
c = XBOOL_VECTOR (obj)->data[i];
- if (c == '\n' && print_escape_newlines)
+ if (! ASCII_BYTE_P (c))
+ {
+ sprintf (buf, "\\%03o", c);
+ strout (buf, -1, -1, printcharfun, 0);
+ }
+ else if (c == '\n' && print_escape_newlines)
{
PRINTCHAR ('\\');
PRINTCHAR ('n');
PRINTCHAR ('#');
size &= PSEUDOVECTOR_SIZE_MASK;
}
- if (CHAR_TABLE_P (obj))
+ if (CHAR_TABLE_P (obj) || SUB_CHAR_TABLE_P (obj))
{
/* We print a char-table as if it were a vector,
lumping the parent and default slots in with the
INTERVAL interval;
Lisp_Object printcharfun;
{
+ if (NILP (interval->plist))
+ return;
PRINTCHAR (' ');
print_object (make_number (interval->position), printcharfun, 1);
PRINTCHAR (' ');
that need to be recorded in the table. */);
Vprint_number_table = Qnil;
+ DEFVAR_LISP ("print-charset-text-property", &Vprint_charset_text_property,
+ doc: /* A flag to control printing of `charset' text property on printing a string.
+The value must be nil, t, or `default'.
+
+If the value is nil, don't print the text property `charset'.
+
+If the value is t, always print the text property `charset'.
+
+If the value is `default', print the text property `charset' only when
+the value is different from what is guessed in the current charset
+priorities. */);
+ Vprint_charset_text_property = Qdefault;
+
/* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */
staticpro (&Vprin1_to_string_buffer);
Qprint_escape_nonascii = intern ("print-escape-nonascii");
staticpro (&Qprint_escape_nonascii);
+ print_prune_charset_plist = Qnil;
+ staticpro (&print_prune_charset_plist);
+
defsubr (&Swith_output_to_temp_buffer);
}
/* Asynchronous subprocess control for GNU Emacs.
Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995,
1996, 1998, 1999, 2001, 2002, 2003, 2004,
- 2005, 2006, 2007 Free Software Foundation, Inc.
+ 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include "window.h"
#include "buffer.h"
-#include "charset.h"
+#include "character.h"
#include "coding.h"
#include "process.h"
#include "frame.h"
Qt nor Qnil but is instead a property list (KEY VAL ...). */
#ifdef HAVE_SOCKETS
-#define NETCONN_P(p) (GC_CONSP (XPROCESS (p)->childp))
-#define NETCONN1_P(p) (GC_CONSP ((p)->childp))
+#define NETCONN_P(p) (CONSP (XPROCESS (p)->childp))
+#define NETCONN1_P(p) (CONSP ((p)->childp))
#else
#define NETCONN_P(p) 0
#define NETCONN1_P(p) 0
struct Lisp_Process *p = XPROCESS (process);
int inch = p->infd;
int outch = p->outfd;
+ Lisp_Object coding_system;
if (inch < 0 || outch < 0)
return;
if (!proc_decode_coding_system[inch])
proc_decode_coding_system[inch]
= (struct coding_system *) xmalloc (sizeof (struct coding_system));
- setup_coding_system (p->decode_coding_system,
- proc_decode_coding_system[inch]);
+ coding_system = p->decode_coding_system;
if (! NILP (p->filter))
{
if (!p->filter_multibyte)
- setup_raw_text_coding_system (proc_decode_coding_system[inch]);
+ coding_system = raw_text_coding_system (coding_system);
}
else if (BUFFERP (p->buffer))
{
if (NILP (XBUFFER (p->buffer)->enable_multibyte_characters))
- setup_raw_text_coding_system (proc_decode_coding_system[inch]);
+ coding_system = raw_text_coding_system (coding_system);
}
+ setup_coding_system (coding_system, proc_decode_coding_system[inch]);
if (!proc_encode_coding_system[outch])
proc_encode_coding_system[outch]
= (struct coding_system *) xmalloc (sizeof (struct coding_system));
setup_coding_system (p->encode_coding_system,
proc_encode_coding_system[outch]);
- if (proc_encode_coding_system[outch]->eol_type == CODING_EOL_UNDECIDED)
- proc_encode_coding_system[outch]->eol_type = system_eol_type;
}
\f
DEFUN ("processp", Fprocessp, Sprocessp, 1, 1, 0,
save the match data in a special nonrecursive fashion. */
running_asynch_code = 1;
- text = decode_coding_string (make_unibyte_string (chars, nbytes),
- coding, 0);
- Vlast_coding_system_used = coding->symbol;
+ decode_coding_c_string (coding, chars, nbytes, Qt);
+ text = coding->dst_object;
+ Vlast_coding_system_used = CODING_ID_NAME (coding->id);
/* A new coding system might be found. */
- if (!EQ (p->decode_coding_system, coding->symbol))
+ if (!EQ (p->decode_coding_system, Vlast_coding_system_used))
{
- p->decode_coding_system = coding->symbol;
+ p->decode_coding_system = Vlast_coding_system_used;
/* Don't call setup_coding_system for
proc_decode_coding_system[channel] here. It is done in
if (NILP (p->encode_coding_system)
&& proc_encode_coding_system[p->outfd])
{
- p->encode_coding_system = coding->symbol;
- setup_coding_system (coding->symbol,
+ p->encode_coding_system
+ = coding_inherit_eol_type (Vlast_coding_system_used, Qnil);
+ setup_coding_system (p->encode_coding_system,
proc_encode_coding_system[p->outfd]);
- if (proc_encode_coding_system[p->outfd]->eol_type
- == CODING_EOL_UNDECIDED)
- proc_encode_coding_system[p->outfd]->eol_type
- = system_eol_type;
}
}
- carryover = nbytes - coding->consumed;
- if (carryover < 0)
- abort ();
-
- if (SCHARS (p->decoding_buf) < carryover)
- p->decoding_buf = make_uninit_string (carryover);
- bcopy (chars + coding->consumed, SDATA (p->decoding_buf),
- carryover);
- p->decoding_carryover = carryover;
+ if (coding->carryover_bytes > 0)
+ {
+ if (SCHARS (p->decoding_buf) < coding->carryover_bytes)
+ p->decoding_buf = make_uninit_string (coding->carryover_bytes);
+ bcopy (coding->carryover, SDATA (p->decoding_buf),
+ coding->carryover_bytes);
+ p->decoding_carryover = coding->carryover_bytes;
+ }
/* Adjust the multibyteness of TEXT to that of the filter. */
if (!p->filter_multibyte != !STRING_MULTIBYTE (text))
text = (STRING_MULTIBYTE (text)
if (! (BEGV <= PT && PT <= ZV))
Fwiden ();
- text = decode_coding_string (make_unibyte_string (chars, nbytes),
- coding, 0);
- Vlast_coding_system_used = coding->symbol;
+ decode_coding_c_string (coding, chars, nbytes, Qt);
+ text = coding->dst_object;
+ Vlast_coding_system_used = CODING_ID_NAME (coding->id);
/* A new coding system might be found. See the comment in the
similar code in the previous `if' block. */
- if (!EQ (p->decode_coding_system, coding->symbol))
+ if (!EQ (p->decode_coding_system, Vlast_coding_system_used))
{
- p->decode_coding_system = coding->symbol;
+ p->decode_coding_system = Vlast_coding_system_used;
if (NILP (p->encode_coding_system)
&& proc_encode_coding_system[p->outfd])
{
- p->encode_coding_system = coding->symbol;
- setup_coding_system (coding->symbol,
+ p->encode_coding_system
+ = coding_inherit_eol_type (Vlast_coding_system_used, Qnil);
+ setup_coding_system (p->encode_coding_system,
proc_encode_coding_system[p->outfd]);
- if (proc_encode_coding_system[p->outfd]->eol_type
- == CODING_EOL_UNDECIDED)
- proc_encode_coding_system[p->outfd]->eol_type
- = system_eol_type;
}
}
- carryover = nbytes - coding->consumed;
- if (carryover < 0)
- abort ();
-
- if (SCHARS (p->decoding_buf) < carryover)
- p->decoding_buf = make_uninit_string (carryover);
- bcopy (chars + coding->consumed, SDATA (p->decoding_buf),
- carryover);
- p->decoding_carryover = carryover;
-
+ if (coding->carryover_bytes > 0)
+ {
+ if (SCHARS (p->decoding_buf) < coding->carryover_bytes)
+ p->decoding_buf = make_uninit_string (coding->carryover_bytes);
+ bcopy (coding->carryover, SDATA (p->decoding_buf),
+ coding->carryover_bytes);
+ p->decoding_carryover = coding->carryover_bytes;
+ }
/* Adjust the multibyteness of TEXT to that of the buffer. */
if (NILP (current_buffer->enable_multibyte_characters)
!= ! STRING_MULTIBYTE (text))
error ("Output file descriptor of %s is closed", SDATA (p->name));
coding = proc_encode_coding_system[p->outfd];
- Vlast_coding_system_used = coding->symbol;
+ Vlast_coding_system_used = CODING_ID_NAME (coding->id);
if ((STRINGP (object) && STRING_MULTIBYTE (object))
|| (BUFFERP (object)
&& !NILP (XBUFFER (object)->enable_multibyte_characters))
|| EQ (object, Qt))
{
- if (!EQ (coding->symbol, p->encode_coding_system))
+ if (!EQ (Vlast_coding_system_used, p->encode_coding_system))
/* The coding system for encoding was changed to raw-text
because we sent a unibyte text previously. Now we are
sending a multibyte text, thus we must encode it by the
original coding system specified for the current process. */
setup_coding_system (p->encode_coding_system, coding);
- if (coding->eol_type == CODING_EOL_UNDECIDED)
- coding->eol_type = system_eol_type;
- /* src_multibyte should be set to 1 _after_ a call to
- setup_coding_system, since it resets src_multibyte to
- zero. */
coding->src_multibyte = 1;
}
else
/* For sending a unibyte text, character code conversion should
not take place but EOL conversion should. So, setup raw-text
or one of the subsidiary if we have not yet done it. */
- if (coding->type != coding_type_raw_text)
+ if (CODING_REQUIRE_ENCODING (coding))
{
if (CODING_REQUIRE_FLUSHING (coding))
{
/* But, before changing the coding, we must flush out data. */
coding->mode |= CODING_MODE_LAST_BLOCK;
send_process (proc, "", 0, Qt);
+ coding->mode &= CODING_MODE_LAST_BLOCK;
}
+ setup_coding_system (raw_text_coding_system
+ (Vlast_coding_system_used),
+ coding);
coding->src_multibyte = 0;
- setup_raw_text_coding_system (coding);
}
}
coding->dst_multibyte = 0;
if (CODING_REQUIRE_ENCODING (coding))
{
- int require = encoding_buffer_size (coding, len);
- int from_byte = -1, from = -1, to = -1;
-
+ coding->dst_object = Qt;
if (BUFFERP (object))
{
- from_byte = BUF_PTR_BYTE_POS (XBUFFER (object), buf);
- from = buf_bytepos_to_charpos (XBUFFER (object), from_byte);
- to = buf_bytepos_to_charpos (XBUFFER (object), from_byte + len);
+ int from_byte, from, to;
+ int save_pt, save_pt_byte;
+ struct buffer *cur = current_buffer;
+
+ set_buffer_internal (XBUFFER (object));
+ save_pt = PT, save_pt_byte = PT_BYTE;
+
+ from_byte = PTR_BYTE_POS (buf);
+ from = BYTE_TO_CHAR (from_byte);
+ to = BYTE_TO_CHAR (from_byte + len);
+ TEMP_SET_PT_BOTH (from, from_byte);
+ encode_coding_object (coding, object, from, from_byte,
+ to, from_byte + len, Qt);
+ TEMP_SET_PT_BOTH (save_pt, save_pt_byte);
+ set_buffer_internal (cur);
}
else if (STRINGP (object))
{
- from_byte = buf - SDATA (object);
- from = string_byte_to_char (object, from_byte);
- to = string_byte_to_char (object, from_byte + len);
+ encode_coding_string (coding, object, 1);
}
-
- if (coding->composing != COMPOSITION_DISABLED)
+ else
{
- if (from_byte >= 0)
- coding_save_composition (coding, from, to, object);
- else
- coding->composing = COMPOSITION_DISABLED;
+ coding->dst_object = make_unibyte_string (buf, len);
+ coding->produced = len;
}
- if (SBYTES (p->encoding_buf) < require)
- p->encoding_buf = make_uninit_string (require);
-
- if (from_byte >= 0)
- buf = (BUFFERP (object)
- ? BUF_BYTE_ADDRESS (XBUFFER (object), from_byte)
- : SDATA (object) + from_byte);
-
- object = p->encoding_buf;
- encode_coding (coding, (char *) buf, SDATA (object),
- len, SBYTES (object));
- coding_free_composition_data (coding);
len = coding->produced;
- buf = SDATA (object);
+ buf = SDATA (coding->dst_object);
}
#ifdef VMS
UNGCPRO;
}
-static Lisp_Object
-send_process_object_unwind (buf)
- Lisp_Object buf;
-{
- Lisp_Object tembuf;
-
- if (XBUFFER (buf) == current_buffer)
- return Qnil;
- tembuf = Fcurrent_buffer ();
- Fset_buffer (buf);
- Fkill_buffer (tembuf);
- return Qnil;
-}
-
-/* Send current contents of region between START and END to PROC.
- If START is a string, send it instead.
- This function can evaluate Lisp code and can garbage collect. */
-
-static void
-send_process_object (proc, start, end)
- Lisp_Object proc, start, end;
-{
- int count = SPECPDL_INDEX ();
- Lisp_Object object = STRINGP (start) ? start : Fcurrent_buffer ();
- struct buffer *given_buffer = current_buffer;
- unsigned char *buf;
- int len;
-
- record_unwind_protect (send_process_object_unwind, Fcurrent_buffer ());
-
- if (STRINGP (object) ? STRING_MULTIBYTE (object)
- : ! NILP (XBUFFER (object)->enable_multibyte_characters))
- {
- struct Lisp_Process *p = XPROCESS (proc);
- struct coding_system *coding;
-
- if (p->raw_status_new)
- update_status (p);
- if (! EQ (p->status, Qrun))
- error ("Process %s not running", SDATA (p->name));
- if (p->outfd < 0)
- error ("Output file descriptor of %s is closed", SDATA (p->name));
-
- coding = proc_encode_coding_system[p->outfd];
- if (! EQ (coding->symbol, p->encode_coding_system))
- /* The coding system for encoding was changed to raw-text
- because we sent a unibyte text previously. Now we are
- sending a multibyte text, thus we must encode it by the
- original coding system specified for the current process. */
- setup_coding_system (p->encode_coding_system, coding);
- if (! NILP (coding->pre_write_conversion))
- {
- struct gcpro gcpro1, gcpro2;
-
- GCPRO2 (proc, object);
- call2 (coding->pre_write_conversion, start, end);
- UNGCPRO;
- if (given_buffer != current_buffer)
- {
- start = make_number (BEGV), end = make_number (ZV);
- object = Fcurrent_buffer ();
- }
- }
- }
-
- if (BUFFERP (object))
- {
- EMACS_INT start_byte;
-
- if (XINT (start) < GPT && XINT (end) > GPT)
- move_gap (XINT (end));
- start_byte = CHAR_TO_BYTE (XINT (start));
- buf = BYTE_POS_ADDR (start_byte);
- len = CHAR_TO_BYTE (XINT (end)) - start_byte;
- }
- else
- {
- buf = SDATA (object);
- len = SBYTES (object);
- }
- send_process (proc, buf, len, object);
-
- unbind_to (count, Qnil);
-}
-
DEFUN ("process-send-region", Fprocess_send_region, Sprocess_send_region,
3, 3, 0,
doc: /* Send current contents of region as input to PROCESS.
Lisp_Object process, start, end;
{
Lisp_Object proc;
+ int start1, end1;
proc = get_process (process);
validate_region (&start, &end);
- send_process_object (proc, start, end);
+
+ if (XINT (start) < GPT && XINT (end) > GPT)
+ move_gap (XINT (start));
+
+ start1 = CHAR_TO_BYTE (XINT (start));
+ end1 = CHAR_TO_BYTE (XINT (end));
+ send_process (proc, BYTE_POS_ADDR (start1), end1 - start1,
+ Fcurrent_buffer ());
+
return Qnil;
}
Lisp_Object proc;
CHECK_STRING (string);
proc = get_process (process);
- send_process_object (proc, string, Qnil);
+ send_process (proc, SDATA (string),
+ SBYTES (string), string);
return Qnil;
}
\f
{
Lisp_Object tail, proc;
- for (tail = Vprocess_alist; GC_CONSP (tail); tail = XCDR (tail))
+ for (tail = Vprocess_alist; CONSP (tail); tail = XCDR (tail))
{
proc = XCDR (XCAR (tail));
- if (GC_PROCESSP (proc)
+ if (PROCESSP (proc)
&& (NILP (buffer) || EQ (XPROCESS (proc)->buffer, buffer)))
{
if (NETCONN_P (proc))
/* Find the process that signaled us, and record its status. */
/* The process can have been deleted by Fdelete_process. */
- for (tail = deleted_pid_list; GC_CONSP (tail); tail = XCDR (tail))
+ for (tail = deleted_pid_list; CONSP (tail); tail = XCDR (tail))
{
Lisp_Object xpid = XCAR (tail);
- if ((GC_INTEGERP (xpid) && pid == (pid_t) XINT (xpid))
- || (GC_FLOATP (xpid) && pid == (pid_t) XFLOAT_DATA (xpid)))
+ if ((INTEGERP (xpid) && pid == (pid_t) XINT (xpid))
+ || (FLOATP (xpid) && pid == (pid_t) XFLOAT_DATA (xpid)))
{
XSETCAR (tail, Qnil);
goto sigchld_end_of_loop;
/* Otherwise, if it is asynchronous, it is in Vprocess_alist. */
p = 0;
- for (tail = Vprocess_alist; GC_CONSP (tail); tail = XCDR (tail))
+ for (tail = Vprocess_alist; CONSP (tail); tail = XCDR (tail))
{
proc = XCDR (XCAR (tail));
p = XPROCESS (proc);
- if (GC_EQ (p->childp, Qt) && p->pid == pid)
+ if (EQ (p->childp, Qt) && p->pid == pid)
break;
p = 0;
}
/* Look for an asynchronous process whose pid hasn't been filled
in yet. */
if (p == 0)
- for (tail = Vprocess_alist; GC_CONSP (tail); tail = XCDR (tail))
+ for (tail = Vprocess_alist; CONSP (tail); tail = XCDR (tail))
{
proc = XCDR (XCAR (tail));
p = XPROCESS (proc);
error ("Output file descriptor of %s closed", SDATA (p->name));
Fcheck_coding_system (decoding);
Fcheck_coding_system (encoding);
-
+ encoding = coding_inherit_eol_type (encoding, Qnil);
p->decode_coding_system = decoding;
p->encode_coding_system = encoding;
setup_process_coding_systems (process);
#include "lisp.h"
#include "systime.h"
-#include "charset.h"
+#include "character.h"
#include "coding.h"
#include "termopts.h"
#include "sysselect.h"
/* String search routines for GNU Emacs.
Copyright (C) 1985, 1986, 1987, 1993, 1994, 1997, 1998, 1999, 2001, 2002,
- 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ 2003, 2004, 2005, 2006, 2007, 2008
+ Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include "syntax.h"
#include "category.h"
#include "buffer.h"
+#include "character.h"
#include "charset.h"
#include "region-cache.h"
#include "commands.h"
subexpression bounds.
POSIX is nonzero if we want full backtracking (POSIX style)
for this pattern. 0 means backtrack only enough to get a valid match.
- MULTIBYTE is nonzero if we want to handle multibyte characters in
- PATTERN. 0 means all multibyte characters are recognized just as
- sequences of binary data.
The behavior also depends on Vsearch_spaces_regexp. */
static void
-compile_pattern_1 (cp, pattern, translate, regp, posix, multibyte)
+compile_pattern_1 (cp, pattern, translate, regp, posix)
struct regexp_cache *cp;
Lisp_Object pattern;
Lisp_Object translate;
struct re_registers *regp;
int posix;
- int multibyte;
{
- unsigned char *raw_pattern;
- int raw_pattern_size;
char *val;
reg_syntax_t old;
- /* MULTIBYTE says whether the text to be searched is multibyte.
- We must convert PATTERN to match that, or we will not really
- find things right. */
-
- if (multibyte == STRING_MULTIBYTE (pattern))
- {
- raw_pattern = (unsigned char *) SDATA (pattern);
- raw_pattern_size = SBYTES (pattern);
- }
- else if (multibyte)
- {
- raw_pattern_size = count_size_as_multibyte (SDATA (pattern),
- SCHARS (pattern));
- raw_pattern = (unsigned char *) alloca (raw_pattern_size + 1);
- copy_text (SDATA (pattern), raw_pattern,
- SCHARS (pattern), 0, 1);
- }
- else
- {
- /* Converting multibyte to single-byte.
-
- ??? Perhaps this conversion should be done in a special way
- by subtracting nonascii-insert-offset from each non-ASCII char,
- so that only the multibyte chars which really correspond to
- the chosen single-byte character set can possibly match. */
- raw_pattern_size = SCHARS (pattern);
- raw_pattern = (unsigned char *) alloca (raw_pattern_size + 1);
- copy_text (SDATA (pattern), raw_pattern,
- SBYTES (pattern), 1, 0);
- }
-
cp->regexp = Qnil;
cp->buf.translate = (! NILP (translate) ? translate : make_number (0));
cp->posix = posix;
- cp->buf.multibyte = multibyte;
+ cp->buf.multibyte = STRING_MULTIBYTE (pattern);
+ cp->buf.charset_unibyte = charset_unibyte;
cp->whitespace_regexp = Vsearch_spaces_regexp;
/* rms: I think BLOCK_INPUT is not needed here any more,
because regex.c defines malloc to call xmalloc.
/* BLOCK_INPUT; */
old = re_set_syntax (RE_SYNTAX_EMACS
| (posix ? 0 : RE_NO_POSIX_BACKTRACKING));
-
re_set_whitespace_regexp (NILP (Vsearch_spaces_regexp) ? NULL
: SDATA (Vsearch_spaces_regexp));
- val = (char *) re_compile_pattern ((char *)raw_pattern,
- raw_pattern_size, &cp->buf);
+ val = (char *) re_compile_pattern ((char *) SDATA (pattern),
+ SBYTES (pattern), &cp->buf);
/* If the compiled pattern hard codes some of the contents of the
syntax-table, it can only be reused with *this* syntax table. */
&& !NILP (Fstring_equal (cp->regexp, pattern))
&& EQ (cp->buf.translate, (! NILP (translate) ? translate : make_number (0)))
&& cp->posix == posix
- && cp->buf.multibyte == multibyte
&& (EQ (cp->syntax_table, Qt)
|| EQ (cp->syntax_table, current_buffer->syntax_table))
- && !NILP (Fequal (cp->whitespace_regexp, Vsearch_spaces_regexp)))
+ && !NILP (Fequal (cp->whitespace_regexp, Vsearch_spaces_regexp))
+ && cp->buf.charset_unibyte == charset_unibyte)
break;
/* If we're at the end of the cache, compile into the nil cell
if (cp->next == 0)
{
compile_it:
- compile_pattern_1 (cp, pattern, translate, regp, posix, multibyte);
+ compile_pattern_1 (cp, pattern, translate, regp, posix);
break;
}
}
if (regp)
re_set_registers (&cp->buf, regp, regp->num_regs, regp->start, regp->end);
+ /* The compiled pattern can be used both for mulitbyte and unibyte
+ target. But, we have to tell which the pattern is used for. */
+ cp->buf.target_multibyte = multibyte;
+
return &cp->buf;
}
unsigned char *base_pat;
/* Set to positive if we find a non-ASCII char that need
translation. Otherwise set to zero later. */
- int charset_base = -1;
+ int char_base = -1;
int boyer_moore_ok = 1;
/* MULTIBYTE says whether the text to be searched is multibyte.
/* Copy and optionally translate the pattern. */
len = raw_pattern_size;
len_byte = raw_pattern_size_byte;
- patbuf = (unsigned char *) alloca (len_byte);
+ patbuf = (unsigned char *) alloca (len * MAX_MULTIBYTE_LENGTH);
pat = patbuf;
base_pat = raw_pattern;
if (multibyte)
if (c != inverse && boyer_moore_ok)
{
/* Check if all equivalents belong to the same
- charset & row. Note that the check of C
- itself is done by the last iteration. Note
- also that we don't have to check ASCII
- characters because boyer-moore search can
- always handle their translation. */
- while (1)
+ group of characters. Note that the check of C
+ itself is done by the last iteration. */
+ int this_char_base = -1;
+
+ while (boyer_moore_ok)
{
if (ASCII_BYTE_P (inverse))
{
- if (charset_base > 0)
+ if (this_char_base > 0)
+ boyer_moore_ok = 0;
+ else
{
- boyer_moore_ok = 0;
- break;
+ this_char_base = 0;
+ if (char_base < 0)
+ char_base = this_char_base;
}
- charset_base = 0;
- }
- else if (SINGLE_BYTE_CHAR_P (inverse))
- {
- /* Boyer-moore search can't handle a
- translation of an eight-bit
- character. */
- boyer_moore_ok = 0;
- break;
}
- else if (charset_base < 0)
- charset_base = inverse & ~CHAR_FIELD3_MASK;
- else if ((inverse & ~CHAR_FIELD3_MASK)
- != charset_base)
+ else if (CHAR_BYTE8_P (inverse))
+ /* Boyer-moore search can't handle a
+ translation of an eight-bit
+ character. */
+ boyer_moore_ok = 0;
+ else if (this_char_base < 0)
{
- boyer_moore_ok = 0;
- break;
+ this_char_base = inverse & ~0x3F;
+ if (char_base < 0)
+ char_base = this_char_base;
+ else if (char_base > 0
+ && this_char_base != char_base)
+ boyer_moore_ok = 0;
}
+ else if ((inverse & ~0x3F) != this_char_base)
+ boyer_moore_ok = 0;
if (c == inverse)
break;
TRANSLATE (inverse, inverse_trt, inverse);
}
}
}
- if (charset_base < 0)
- charset_base = 0;
+ if (char_base < 0)
+ char_base = 0;
/* Store this character into the translated pattern. */
bcopy (str, pat, charlen);
else
{
/* Unibyte buffer. */
- charset_base = 0;
+ char_base = 0;
while (--len >= 0)
{
int c, translated;
if (boyer_moore_ok)
return boyer_moore (n, pat, len, len_byte, trt, inverse_trt,
pos, pos_byte, lim, lim_byte,
- charset_base);
+ char_base);
else
return simple_search (n, pat, len, len_byte, trt,
pos, pos_byte, lim, lim_byte);
{
int multibyte = ! NILP (current_buffer->enable_multibyte_characters);
int forward = n > 0;
+ /* Number of buffer bytes matched. Note that this may be different
+ from len_byte in a multibyte buffer. */
+ int match_byte;
if (lim > pos && multibyte)
while (n > 0)
int this_len = len;
int this_len_byte = len_byte;
unsigned char *p = pat;
- if (pos + len > lim)
+ if (pos + len > lim || pos_byte + len_byte > lim_byte)
goto stop;
while (this_len > 0)
if (this_len == 0)
{
+ match_byte = this_pos_byte - pos_byte;
pos += len;
- pos_byte += len_byte;
+ pos_byte += match_byte;
break;
}
if (this_len == 0)
{
+ match_byte = len;
pos += len;
break;
}
{
/* Try matching at position POS. */
int this_pos = pos - len;
- int this_pos_byte = pos_byte - len_byte;
+ int this_pos_byte;
int this_len = len;
int this_len_byte = len_byte;
unsigned char *p = pat;
- if (this_pos < lim || this_pos_byte < lim_byte)
+ if (this_pos < lim || (pos_byte - len_byte) < lim_byte)
goto stop;
+ this_pos_byte = CHAR_TO_BYTE (this_pos);
+ match_byte = pos_byte - this_pos_byte;
while (this_len > 0)
{
if (this_len == 0)
{
pos -= len;
- pos_byte -= len_byte;
+ pos_byte -= match_byte;
break;
}
int this_len = len;
unsigned char *p = pat;
- if (pos - len < lim)
+ if (this_pos < lim)
goto stop;
while (this_len > 0)
if (this_len == 0)
{
+ match_byte = len;
pos -= len;
break;
}
if (n == 0)
{
if (forward)
- set_search_regs ((multibyte ? pos_byte : pos) - len_byte, len_byte);
+ set_search_regs ((multibyte ? pos_byte : pos) - match_byte, match_byte);
else
- set_search_regs (multibyte ? pos_byte : pos, len_byte);
+ set_search_regs (multibyte ? pos_byte : pos, match_byte);
return pos;
}
have nontrivial translation are the same aside from the last byte.
This makes it possible to translate just the last byte of a
character, and do so after just a simple test of the context.
- CHARSET_BASE is nonzero if there is such a non-ASCII character.
+ CHAR_BASE is nonzero if there is such a non-ASCII character.
If that criterion is not satisfied, do not call this function. */
static int
boyer_moore (n, base_pat, len, len_byte, trt, inverse_trt,
- pos, pos_byte, lim, lim_byte, charset_base)
+ pos, pos_byte, lim, lim_byte, char_base)
int n;
unsigned char *base_pat;
int len, len_byte;
Lisp_Object inverse_trt;
int pos, pos_byte;
int lim, lim_byte;
- int charset_base;
+ int char_base;
{
int direction = ((n > 0) ? 1 : -1);
register int dirlen;
unsigned char simple_translate[0400];
/* These are set to the preceding bytes of a byte to be translated
- if charset_base is nonzero. As the maximum byte length of a
- multibyte character is 4, we have to check at most three previous
+ if char_base is nonzero. As the maximum byte length of a
+ multibyte character is 5, we have to check at most four previous
bytes. */
int translate_prev_byte1 = 0;
int translate_prev_byte2 = 0;
int translate_prev_byte3 = 0;
+ int translate_prev_byte4 = 0;
BM_tab = (int *) alloca (0400 * sizeof (int));
for (i = 0; i < 0400; i++)
simple_translate[i] = i;
- if (charset_base)
+ if (char_base)
{
- /* Setup translate_prev_byte1/2/3 from CHARSET_BASE. Only a
+ /* Setup translate_prev_byte1/2/3/4 from CHAR_BASE. Only a
byte following them are the target of translation. */
- int sample_char = charset_base | 0x20;
unsigned char str[MAX_MULTIBYTE_LENGTH];
- int len = CHAR_STRING (sample_char, str);
+ int len = CHAR_STRING (char_base, str);
translate_prev_byte1 = str[len - 2];
if (len > 2)
{
translate_prev_byte2 = str[len - 3];
if (len > 3)
- translate_prev_byte3 = str[len - 4];
+ {
+ translate_prev_byte3 = str[len - 4];
+ if (len > 4)
+ translate_prev_byte4 = str[len - 5];
+ }
}
}
/* If the byte currently looking at is the last of a
character to check case-equivalents, set CH to that
character. An ASCII character and a non-ASCII character
- matching with CHARSET_BASE are to be checked. */
+ matching with CHAR_BASE are to be checked. */
int ch = -1;
if (ASCII_BYTE_P (*ptr) || ! multibyte)
ch = *ptr;
- else if (charset_base
+ else if (char_base
&& ((pat_end - ptr) == 1 || CHAR_HEAD_P (ptr[1])))
{
unsigned char *charstart = ptr - 1;
while (! (CHAR_HEAD_P (*charstart)))
charstart--;
ch = STRING_CHAR (charstart, ptr - charstart + 1);
- if (charset_base != (ch & ~CHAR_FIELD3_MASK))
+ if (char_base != (ch & ~0x3F))
ch = -1;
}
if (ch >= 0400)
- j = ((unsigned char) ch) | 0200;
+ j = (ch & 0x3F) | 0200;
else
j = *ptr;
{
TRANSLATE (ch, inverse_trt, ch);
if (ch >= 0400)
- j = ((unsigned char) ch) | 0200;
+ j = (ch & 0x3F) | 0200;
else
- j = (unsigned char) ch;
+ j = ch;
/* For all the characters that map into CH,
set up simple_translate to map the last byte
{
int c;
- FETCH_STRING_CHAR_ADVANCE (c, string, i, i_byte);
+ FETCH_STRING_CHAR_AS_MULTIBYTE_ADVANCE (c, string, i, i_byte);
if (SYNTAX (c) != Sword)
{
int c;
int i_byte_orig = i_byte;
- FETCH_STRING_CHAR_ADVANCE (c, string, i, i_byte);
+ FETCH_STRING_CHAR_AS_MULTIBYTE_ADVANCE (c, string, i, i_byte);
if (SYNTAX (c) == Sword)
{
{
if (NILP (string))
{
- c = FETCH_CHAR (pos_byte);
+ c = FETCH_CHAR_AS_MULTIBYTE (pos_byte);
INC_BOTH (pos, pos_byte);
}
else
- FETCH_STRING_CHAR_ADVANCE (c, string, pos, pos_byte);
+ FETCH_STRING_CHAR_AS_MULTIBYTE_ADVANCE (c, string, pos, pos_byte);
if (LOWERCASEP (c))
{
Lisp_Object rev_tbl;
int really_changed = 0;
- rev_tbl= (!buf_multibyte && CHAR_TABLE_P (Vnonascii_translation_table)
- ? Fchar_table_extra_slot (Vnonascii_translation_table,
- make_number (0))
- : Qnil);
+ rev_tbl = Qnil;
substed_alloc_size = length * 2 + 100;
substed = (unsigned char *) xmalloc (substed_alloc_size + 1);
{
FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, newtext,
pos, pos_byte);
- if (!buf_multibyte && !SINGLE_BYTE_CHAR_P (c))
+ if (!buf_multibyte && !ASCII_CHAR_P (c))
c = multibyte_char_to_unibyte (c, rev_tbl);
}
else
/* GNU Emacs routines to deal with syntax tables; also word and list parsing.
Copyright (C) 1985, 1987, 1993, 1994, 1995, 1997, 1998, 1999, 2001,
- 2002, 2003, 2004, 2005, 2006, 2007
+ 2002, 2003, 2004, 2005, 2006, 2007, 2008
Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include "lisp.h"
#include "commands.h"
#include "buffer.h"
-#include "charset.h"
+#include "character.h"
#include "keymap.h"
#include "regex.h"
static int back_comment P_ ((EMACS_INT, EMACS_INT, EMACS_INT, int, int,
EMACS_INT *, EMACS_INT *));
static int char_quoted P_ ((int, int));
-static Lisp_Object skip_chars P_ ((int, int, Lisp_Object, Lisp_Object, int));
+static Lisp_Object skip_chars P_ ((int, Lisp_Object, Lisp_Object, int));
+static Lisp_Object skip_syntaxes P_ ((int, Lisp_Object, Lisp_Object));
static Lisp_Object scan_lists P_ ((EMACS_INT, EMACS_INT, EMACS_INT, int));
static void scan_sexps_forward P_ ((struct lisp_parse_state *,
int, int, int, int,
int c;
UPDATE_SYNTAX_TABLE_BACKWARD (charpos);
- c = FETCH_CHAR (bytepos);
+ c = FETCH_CHAR_AS_MULTIBYTE (bytepos);
code = SYNTAX (c);
if (! (code == Scharquote || code == Sescape))
break;
/* Open-paren at start of line means we may have found our
defun-start. */
- c = FETCH_CHAR (PT_BYTE);
+ c = FETCH_CHAR_AS_MULTIBYTE (PT_BYTE);
if (SYNTAX (c) == Sopen)
{
SETUP_SYNTAX_TABLE (PT + 1, -1); /* Try again... */
- c = FETCH_CHAR (PT_BYTE);
+ c = FETCH_CHAR_AS_MULTIBYTE (PT_BYTE);
if (SYNTAX (c) == Sopen)
break;
/* Now fallback to the default value. */
UPDATE_SYNTAX_TABLE_BACKWARD (from);
prev_syntax = syntax;
- c = FETCH_CHAR (from_byte);
+ c = FETCH_CHAR_AS_MULTIBYTE (from_byte);
syntax = SYNTAX_WITH_FLAGS (c);
code = SYNTAX (c);
int next = from, next_byte = from_byte, next_c, next_syntax;
DEC_BOTH (next, next_byte);
UPDATE_SYNTAX_TABLE_BACKWARD (next);
- next_c = FETCH_CHAR (next_byte);
+ next_c = FETCH_CHAR_AS_MULTIBYTE (next_byte);
next_syntax = SYNTAX_WITH_FLAGS (next_c);
if (((com2start || comnested)
&& SYNTAX_FLAGS_COMEND_SECOND (syntax)
static Lisp_Object Vsyntax_code_object;
\f
-/* Look up the value for CHARACTER in syntax table TABLE's parent
- and its parents. SYNTAX_ENTRY calls this, when TABLE itself has nil
- for CHARACTER. It's actually used only when not compiled with GCC. */
-
-Lisp_Object
-syntax_parent_lookup (table, character)
- Lisp_Object table;
- int character;
-{
- Lisp_Object value;
-
- while (1)
- {
- table = XCHAR_TABLE (table)->parent;
- if (NILP (table))
- return Qnil;
-
- value = XCHAR_TABLE (table)->contents[character];
- if (!NILP (value))
- return value;
- }
-}
-
DEFUN ("char-syntax", Fchar_syntax, Schar_syntax, 1, 1, 0,
doc: /* Return the syntax code of CHARACTER, described by a character.
For example, if CHARACTER is a word constituent,
doc: /* Set syntax for character CHAR according to string NEWENTRY.
The syntax is changed only for table SYNTAX-TABLE, which defaults to
the current buffer's syntax table.
+CHAR may be a cons (MIN . MAX), in which case, syntaxes of all characters
+in the range MIN and MAX are changed.
The first character of NEWENTRY should be one of the following:
Space or - whitespace syntax. w word constituent.
_ symbol constituent. . punctuation.
(c, newentry, syntax_table)
Lisp_Object c, newentry, syntax_table;
{
- CHECK_NUMBER (c);
+ if (CONSP (c))
+ {
+ CHECK_CHARACTER_CAR (c);
+ CHECK_CHARACTER_CDR (c);
+ }
+ else
+ CHECK_CHARACTER (c);
if (NILP (syntax_table))
syntax_table = current_buffer->syntax_table;
else
check_syntax_table (syntax_table);
- SET_RAW_SYNTAX_ENTRY (syntax_table, XINT (c), Fstring_to_syntax (newentry));
+ newentry = Fstring_to_syntax (newentry);
+ if (CONSP (c))
+ SET_RAW_SYNTAX_ENTRY_RANGE (syntax_table, c, newentry);
+ else
+ SET_RAW_SYNTAX_ENTRY (syntax_table, XINT (c), newentry);
/* We clear the regexp cache, since character classes can now have
different values from those in the compiled regexps.*/
\f
int parse_sexp_ignore_comments;
+/* Char-table of functions that find the next or previous word
+ boundary. */
+Lisp_Object Vfind_word_boundary_function_table;
+
/* Return the position across COUNT words from FROM.
If that many words cannot be found before the end of the buffer, return 0.
COUNT negative means scan backward and stop at word beginning. */
register int from_byte = CHAR_TO_BYTE (from);
register enum syntaxcode code;
int ch0, ch1;
+ Lisp_Object func, script, pos;
immediate_quit = 1;
QUIT;
return 0;
}
UPDATE_SYNTAX_TABLE_FORWARD (from);
- ch0 = FETCH_CHAR (from_byte);
+ ch0 = FETCH_CHAR_AS_MULTIBYTE (from_byte);
code = SYNTAX (ch0);
INC_BOTH (from, from_byte);
if (words_include_escapes
}
/* Now CH0 is a character which begins a word and FROM is the
position of the next character. */
- while (1)
+ func = CHAR_TABLE_REF (Vfind_word_boundary_function_table, ch0);
+ if (! NILP (Ffboundp (func)))
{
- if (from == end) break;
- UPDATE_SYNTAX_TABLE_FORWARD (from);
- ch1 = FETCH_CHAR (from_byte);
- code = SYNTAX (ch1);
- if (!(words_include_escapes
- && (code == Sescape || code == Scharquote)))
- if (code != Sword || WORD_BOUNDARY_P (ch0, ch1))
- break;
- INC_BOTH (from, from_byte);
- ch0 = ch1;
+ pos = call2 (func, make_number (from - 1), make_number (end));
+ if (INTEGERP (pos) && XINT (pos) > from)
+ {
+ from = XINT (pos);
+ from_byte = CHAR_TO_BYTE (from);
+ }
+ }
+ else
+ {
+ script = CHAR_TABLE_REF (Vchar_script_table, ch0);
+ while (1)
+ {
+ if (from == end) break;
+ UPDATE_SYNTAX_TABLE_FORWARD (from);
+ ch1 = FETCH_CHAR_AS_MULTIBYTE (from_byte);
+ code = SYNTAX (ch1);
+ if ((code != Sword
+ && (! words_include_escapes
+ || (code != Sescape && code != Scharquote)))
+ || ! EQ (CHAR_TABLE_REF (Vchar_script_table, ch1), script))
+ break;
+ INC_BOTH (from, from_byte);
+ ch0 = ch1;
+ }
}
count--;
}
}
DEC_BOTH (from, from_byte);
UPDATE_SYNTAX_TABLE_BACKWARD (from);
- ch1 = FETCH_CHAR (from_byte);
+ ch1 = FETCH_CHAR_AS_MULTIBYTE (from_byte);
code = SYNTAX (ch1);
if (words_include_escapes
&& (code == Sescape || code == Scharquote))
}
/* Now CH1 is a character which ends a word and FROM is the
position of it. */
- while (1)
+ func = CHAR_TABLE_REF (Vfind_word_boundary_function_table, ch1);
+ if (! NILP (Ffboundp (func)))
+ {
+ pos = call2 (func, make_number (from), make_number (beg));
+ if (INTEGERP (pos) && XINT (pos) < from)
+ {
+ from = XINT (pos);
+ from_byte = CHAR_TO_BYTE (from);
+ }
+ }
+ else
{
- if (from == beg)
- break;
- DEC_BOTH (from, from_byte);
- UPDATE_SYNTAX_TABLE_BACKWARD (from);
- ch0 = FETCH_CHAR (from_byte);
- code = SYNTAX (ch0);
- if (!(words_include_escapes
- && (code == Sescape || code == Scharquote)))
- if (code != Sword || WORD_BOUNDARY_P (ch0, ch1))
- {
- INC_BOTH (from, from_byte);
+ script = CHAR_TABLE_REF (Vchar_script_table, ch1);
+ while (1)
+ {
+ if (from == beg)
break;
- }
- ch1 = ch0;
+ DEC_BOTH (from, from_byte);
+ UPDATE_SYNTAX_TABLE_BACKWARD (from);
+ ch0 = FETCH_CHAR_AS_MULTIBYTE (from_byte);
+ code = SYNTAX (ch0);
+ if ((code != Sword
+ && (! words_include_escapes
+ || (code != Sescape && code != Scharquote)))
+ || ! EQ (CHAR_TABLE_REF (Vchar_script_table, ch0), script))
+ {
+ INC_BOTH (from, from_byte);
+ break;
+ }
+ ch1 = ch0;
+ }
}
count++;
}
(string, lim)
Lisp_Object string, lim;
{
- return skip_chars (1, 0, string, lim, 1);
+ return skip_chars (1, string, lim, 1);
}
DEFUN ("skip-chars-backward", Fskip_chars_backward, Sskip_chars_backward, 1, 2, 0,
(string, lim)
Lisp_Object string, lim;
{
- return skip_chars (0, 0, string, lim, 1);
+ return skip_chars (0, string, lim, 1);
}
DEFUN ("skip-syntax-forward", Fskip_syntax_forward, Sskip_syntax_forward, 1, 2, 0,
(syntax, lim)
Lisp_Object syntax, lim;
{
- return skip_chars (1, 1, syntax, lim, 0);
+ return skip_syntaxes (1, syntax, lim);
}
DEFUN ("skip-syntax-backward", Fskip_syntax_backward, Sskip_syntax_backward, 1, 2, 0,
(syntax, lim)
Lisp_Object syntax, lim;
{
- return skip_chars (0, 1, syntax, lim, 0);
+ return skip_syntaxes (0, syntax, lim);
}
static Lisp_Object
-skip_chars (forwardp, syntaxp, string, lim, handle_iso_classes)
- int forwardp, syntaxp;
+skip_chars (forwardp, string, lim, handle_iso_classes)
+ int forwardp;
Lisp_Object string, lim;
int handle_iso_classes;
{
register unsigned int c;
unsigned char fastmap[0400];
- /* If SYNTAXP is 0, STRING may contain multi-byte form of characters
- of which codes don't fit in FASTMAP. In that case, set the
- ranges of characters in CHAR_RANGES. */
+ /* Store the ranges of non-ASCII characters. */
int *char_ranges;
int n_char_ranges = 0;
int negate = 0;
register int i, i_byte;
- int multibyte = !NILP (current_buffer->enable_multibyte_characters);
+ /* Set to 1 if the current buffer is multibyte and the region
+ contains non-ASCII chars. */
+ int multibyte;
+ /* Set to 1 if STRING is multibyte and it contains non-ASCII
+ chars. */
int string_multibyte;
int size_byte;
const unsigned char *str;
Lisp_Object iso_classes;
CHECK_STRING (string);
- char_ranges = (int *) alloca (SCHARS (string) * (sizeof (int)) * 2);
- string_multibyte = STRING_MULTIBYTE (string);
- str = SDATA (string);
- size_byte = SBYTES (string);
iso_classes = Qnil;
- /* Adjust the multibyteness of the string to that of the buffer. */
- if (multibyte != string_multibyte)
- {
- int nbytes;
-
- if (multibyte)
- nbytes = count_size_as_multibyte (SDATA (string),
- SCHARS (string));
- else
- nbytes = SCHARS (string);
- if (nbytes != size_byte)
- {
- unsigned char *tmp = (unsigned char *) alloca (nbytes);
- copy_text (SDATA (string), tmp, size_byte,
- string_multibyte, multibyte);
- size_byte = nbytes;
- str = tmp;
- }
- }
-
if (NILP (lim))
XSETINT (lim, forwardp ? ZV : BEGV);
else
if (XINT (lim) < BEGV)
XSETFASTINT (lim, BEGV);
+ multibyte = (!NILP (current_buffer->enable_multibyte_characters)
+ && (XINT (lim) - PT != CHAR_TO_BYTE (XINT (lim)) - PT_BYTE));
+ string_multibyte = SBYTES (string) > SCHARS (string);
+
bzero (fastmap, sizeof fastmap);
- i_byte = 0;
+ str = SDATA (string);
+ size_byte = SBYTES (string);
+ i_byte = 0;
if (i_byte < size_byte
&& SREF (string, 0) == '^')
{
}
/* Find the characters specified and set their elements of fastmap.
- If syntaxp, each character counts as itself.
- Otherwise, handle backslashes and ranges specially. */
+ Handle backslashes and ranges specially.
- while (i_byte < size_byte)
+ If STRING contains non-ASCII characters, setup char_ranges for
+ them and use fastmap only for their leading codes. */
+
+ if (! string_multibyte)
{
- c = STRING_CHAR_AND_LENGTH (str + i_byte, size_byte - i_byte, len);
- i_byte += len;
+ int string_has_eight_bit = 0;
- if (syntaxp)
- fastmap[syntax_spec_code[c & 0377]] = 1;
- else
+ /* At first setup fastmap. */
+ while (i_byte < size_byte)
{
+ c = str[i_byte++];
+
if (handle_iso_classes && c == '['
&& i_byte < size_byte
- && STRING_CHAR (str + i_byte, size_byte - i_byte) == ':')
+ && str[i_byte] == ':')
{
const unsigned char *class_beg = str + i_byte + 1;
const unsigned char *class_end = class_beg;
if (i_byte == size_byte)
break;
+ c = str[i_byte++];
+ }
+ /* Treat `-' as range character only if another character
+ follows. */
+ if (i_byte + 1 < size_byte
+ && str[i_byte] == '-')
+ {
+ unsigned int c2;
+
+ /* Skip over the dash. */
+ i_byte++;
+
+ /* Get the end of the range. */
+ c2 = str[i_byte++];
+ if (c2 == '\\'
+ && i_byte < size_byte)
+ c2 = str[i_byte++];
+
+ if (c <= c2)
+ {
+ while (c <= c2)
+ fastmap[c++] = 1;
+ if (! ASCII_CHAR_P (c2))
+ string_has_eight_bit = 1;
+ }
+ }
+ else
+ {
+ fastmap[c] = 1;
+ if (! ASCII_CHAR_P (c))
+ string_has_eight_bit = 1;
+ }
+ }
+
+ /* If the current range is multibyte and STRING contains
+ eight-bit chars, arrange fastmap and setup char_ranges for
+ the corresponding multibyte chars. */
+ if (multibyte && string_has_eight_bit)
+ {
+ unsigned char fastmap2[0400];
+ int range_start_byte, range_start_char;
+
+ bcopy (fastmap2 + 0200, fastmap + 0200, 0200);
+ bzero (fastmap + 0200, 0200);
+ /* We are sure that this loop stops. */
+ for (i = 0200; ! fastmap2[i]; i++);
+ c = unibyte_char_to_multibyte (i);
+ fastmap[CHAR_LEADING_CODE (c)] = 1;
+ range_start_byte = i;
+ range_start_char = c;
+ char_ranges = (int *) alloca (sizeof (int) * 128 * 2);
+ for (i = 129; i < 0400; i++)
+ {
+ c = unibyte_char_to_multibyte (i);
+ fastmap[CHAR_LEADING_CODE (c)] = 1;
+ if (i - range_start_byte != c - range_start_char)
+ {
+ char_ranges[n_char_ranges++] = range_start_char;
+ char_ranges[n_char_ranges++] = ((i - 1 - range_start_byte)
+ + range_start_char);
+ range_start_byte = i;
+ range_start_char = c;
+ }
+ }
+ char_ranges[n_char_ranges++] = range_start_char;
+ char_ranges[n_char_ranges++] = ((i - 1 - range_start_byte)
+ + range_start_char);
+ }
+ }
+ else /* STRING is multibyte */
+ {
+ char_ranges = (int *) alloca (sizeof (int) * SCHARS (string) * 2);
+
+ while (i_byte < size_byte)
+ {
+ unsigned char leading_code;
+
+ leading_code = str[i_byte];
+ c = STRING_CHAR_AND_LENGTH (str + i_byte, size_byte-i_byte, len);
+ i_byte += len;
+
+ if (handle_iso_classes && c == '['
+ && i_byte < size_byte
+ && STRING_CHAR (str + i_byte, size_byte - i_byte) == ':')
+ {
+ const unsigned char *class_beg = str + i_byte + 1;
+ const unsigned char *class_end = class_beg;
+ const unsigned char *class_limit = str + size_byte - 2;
+ /* Leave room for the null. */
+ unsigned char class_name[CHAR_CLASS_MAX_LENGTH + 1];
+ re_wctype_t cc;
+
+ if (class_limit - class_beg > CHAR_CLASS_MAX_LENGTH)
+ class_limit = class_beg + CHAR_CLASS_MAX_LENGTH;
+
+ while (class_end < class_limit
+ && *class_end >= 'a' && *class_end <= 'z')
+ class_end++;
+
+ if (class_end == class_beg
+ || *class_end != ':' || class_end[1] != ']')
+ goto not_a_class_name_multibyte;
+
+ bcopy (class_beg, class_name, class_end - class_beg);
+ class_name[class_end - class_beg] = 0;
+
+ cc = re_wctype (class_name);
+ if (cc == 0)
+ error ("Invalid ISO C character class");
+
+ iso_classes = Fcons (make_number (cc), iso_classes);
+
+ i_byte = class_end + 2 - str;
+ continue;
+ }
+
+ not_a_class_name_multibyte:
+ if (c == '\\')
+ {
+ if (i_byte == size_byte)
+ break;
+
+ leading_code = str[i_byte];
c = STRING_CHAR_AND_LENGTH (str + i_byte,
size_byte - i_byte, len);
i_byte += len;
&& str[i_byte] == '-')
{
unsigned int c2;
+ unsigned char leading_code2;
/* Skip over the dash. */
i_byte++;
/* Get the end of the range. */
+ leading_code2 = str[i_byte];
c2 = STRING_CHAR_AND_LENGTH (str + i_byte,
size_byte - i_byte, len);
i_byte += len;
- if (SINGLE_BYTE_CHAR_P (c))
+ if (c2 == '\\'
+ && i_byte < size_byte)
+ {
+ leading_code2 = str[i_byte];
+ c2 =STRING_CHAR_AND_LENGTH (str + i_byte, size_byte-i_byte, len);
+ i_byte += len;
+ }
+
+ if (c > c2)
+ continue;
+ if (ASCII_CHAR_P (c))
+ {
+ while (c <= c2 && c < 0x80)
+ fastmap[c++] = 1;
+ leading_code = CHAR_LEADING_CODE (c);
+ }
+ if (! ASCII_CHAR_P (c))
{
- if (! SINGLE_BYTE_CHAR_P (c2))
+ while (leading_code <= leading_code2)
+ fastmap[leading_code++] = 1;
+ if (c <= c2)
{
- /* Handle a range starting with a character of
- less than 256, and ending with a character of
- not less than 256. Split that into two
- ranges, the low one ending at 0377, and the
- high one starting at the smallest character
- in the charset of C2 and ending at C2. */
- int charset = CHAR_CHARSET (c2);
- int c1 = MAKE_CHAR (charset, 0, 0);
-
- char_ranges[n_char_ranges++] = c1;
+ char_ranges[n_char_ranges++] = c;
char_ranges[n_char_ranges++] = c2;
- c2 = 0377;
}
- while (c <= c2)
- {
- fastmap[c] = 1;
- c++;
- }
- }
- else if (c <= c2) /* Both C and C2 are multibyte char. */
- {
- char_ranges[n_char_ranges++] = c;
- char_ranges[n_char_ranges++] = c2;
}
}
else
{
- if (SINGLE_BYTE_CHAR_P (c))
+ if (ASCII_CHAR_P (c))
fastmap[c] = 1;
else
{
+ fastmap[leading_code] = 1;
char_ranges[n_char_ranges++] = c;
char_ranges[n_char_ranges++] = c;
}
}
}
+
+ /* If the current range is unibyte and STRING contains non-ASCII
+ chars, arrange fastmap for the corresponding unibyte
+ chars. */
+
+ if (! multibyte && n_char_ranges > 0)
+ {
+ bzero (fastmap + 0200, 0200);
+ for (i = 0; i < n_char_ranges; i += 2)
+ {
+ int c1 = char_ranges[i];
+ int c2 = char_ranges[i + 1];
+
+ for (; c1 <= c2; c1++)
+ fastmap[CHAR_TO_BYTE8 (c1)] = 1;
+ }
+ }
}
/* If ^ was the first character, complement the fastmap. */
if (negate)
- for (i = 0; i < sizeof fastmap; i++)
- fastmap[i] ^= 1;
+ {
+ if (! multibyte)
+ for (i = 0; i < sizeof fastmap; i++)
+ fastmap[i] ^= 1;
+ else
+ {
+ for (i = 0; i < 0200; i++)
+ fastmap[i] ^= 1;
+ /* All non-ASCII chars possibly match. */
+ for (; i < sizeof fastmap; i++)
+ fastmap[i] = 1;
+ }
+ }
{
int start_point = PT;
}
immediate_quit = 1;
- if (syntaxp)
+ if (forwardp)
{
- SETUP_SYNTAX_TABLE (pos, forwardp ? 1 : -1);
- if (forwardp)
- {
- if (multibyte)
- while (1)
- {
- int nbytes;
+ if (multibyte)
+ while (1)
+ {
+ int nbytes;
- if (p >= stop)
- {
- if (p >= endp)
- break;
- p = GAP_END_ADDR;
- stop = endp;
- }
- c = STRING_CHAR_AND_LENGTH (p, MAX_MULTIBYTE_LENGTH, nbytes);
- if (! fastmap[(int) SYNTAX (c)])
+ if (p >= stop)
+ {
+ if (p >= endp)
break;
- p += nbytes, pos++, pos_byte += nbytes;
- UPDATE_SYNTAX_TABLE_FORWARD (pos);
+ p = GAP_END_ADDR;
+ stop = endp;
}
- else
- while (1)
+ c = STRING_CHAR_AND_LENGTH (p, MAX_MULTIBYTE_LENGTH, nbytes);
+ if (! NILP (iso_classes) && in_classes (c, iso_classes))
{
- if (p >= stop)
- {
- if (p >= endp)
- break;
- p = GAP_END_ADDR;
- stop = endp;
- }
- if (! fastmap[(int) SYNTAX (*p)])
+ if (negate)
break;
- p++, pos++;
- UPDATE_SYNTAX_TABLE_FORWARD (pos);
+ else
+ goto fwd_ok;
}
- }
- else
- {
- if (multibyte)
- while (1)
- {
- unsigned char *prev_p;
- int nbytes;
- if (p <= stop)
- {
- if (p <= endp)
- break;
- p = GPT_ADDR;
- stop = endp;
- }
- prev_p = p;
- while (--p >= stop && ! CHAR_HEAD_P (*p));
- PARSE_MULTIBYTE_SEQ (p, MAX_MULTIBYTE_LENGTH, nbytes);
- if (prev_p - p > nbytes)
- p = prev_p - 1, c = *p, nbytes = 1;
- else
- c = STRING_CHAR (p, MAX_MULTIBYTE_LENGTH);
- pos--, pos_byte -= nbytes;
- UPDATE_SYNTAX_TABLE_BACKWARD (pos);
- if (! fastmap[(int) SYNTAX (c)])
- {
- pos++;
- pos_byte += nbytes;
+ if (! fastmap[*p])
+ break;
+ if (! ASCII_CHAR_P (c))
+ {
+ /* As we are looking at a multibyte character, we
+ must look up the character in the table
+ CHAR_RANGES. If there's no data in the table,
+ that character is not what we want to skip. */
+
+ /* The following code do the right thing even if
+ n_char_ranges is zero (i.e. no data in
+ CHAR_RANGES). */
+ for (i = 0; i < n_char_ranges; i += 2)
+ if (c >= char_ranges[i] && c <= char_ranges[i + 1])
break;
- }
+ if (!(negate ^ (i < n_char_ranges)))
+ break;
}
- else
- while (1)
+ fwd_ok:
+ p += nbytes, pos++, pos_byte += nbytes;
+ }
+ else
+ while (1)
+ {
+ if (p >= stop)
{
- if (p <= stop)
- {
- if (p <= endp)
- break;
- p = GPT_ADDR;
- stop = endp;
- }
- UPDATE_SYNTAX_TABLE_BACKWARD (pos - 1);
- if (! fastmap[(int) SYNTAX (p[-1])])
+ if (p >= endp)
break;
- p--, pos--;
+ p = GAP_END_ADDR;
+ stop = endp;
}
- }
+
+ if (!NILP (iso_classes) && in_classes (*p, iso_classes))
+ {
+ if (negate)
+ break;
+ else
+ goto fwd_unibyte_ok;
+ }
+
+ if (!fastmap[*p])
+ break;
+ fwd_unibyte_ok:
+ p++, pos++, pos_byte++;
+ }
}
else
{
- if (forwardp)
- {
- if (multibyte)
- while (1)
- {
- int nbytes;
-
- if (p >= stop)
- {
- if (p >= endp)
- break;
- p = GAP_END_ADDR;
- stop = endp;
- }
- c = STRING_CHAR_AND_LENGTH (p, MAX_MULTIBYTE_LENGTH, nbytes);
+ if (multibyte)
+ while (1)
+ {
+ unsigned char *prev_p;
- if (! NILP (iso_classes) && in_classes (c, iso_classes))
- {
- if (negate)
- break;
- else
- goto fwd_ok;
- }
+ if (p <= stop)
+ {
+ if (p <= endp)
+ break;
+ p = GPT_ADDR;
+ stop = endp;
+ }
+ prev_p = p;
+ while (--p >= stop && ! CHAR_HEAD_P (*p));
+ c = STRING_CHAR (p, MAX_MULTIBYTE_LENGTH);
- if (SINGLE_BYTE_CHAR_P (c))
- {
- if (!fastmap[c])
- break;
- }
+ if (! NILP (iso_classes) && in_classes (c, iso_classes))
+ {
+ if (negate)
+ break;
else
- {
- /* If we are looking at a multibyte character,
- we must look up the character in the table
- CHAR_RANGES. If there's no data in the
- table, that character is not what we want to
- skip. */
-
- /* The following code do the right thing even if
- n_char_ranges is zero (i.e. no data in
- CHAR_RANGES). */
- for (i = 0; i < n_char_ranges; i += 2)
- if (c >= char_ranges[i] && c <= char_ranges[i + 1])
- break;
- if (!(negate ^ (i < n_char_ranges)))
- break;
- }
- fwd_ok:
- p += nbytes, pos++, pos_byte += nbytes;
+ goto back_ok;
}
- else
- while (1)
- {
- if (p >= stop)
- {
- if (p >= endp)
- break;
- p = GAP_END_ADDR;
- stop = endp;
- }
-
- if (!NILP (iso_classes) && in_classes (*p, iso_classes))
- {
- if (negate)
- break;
- else
- goto fwd_unibyte_ok;
- }
- if (!fastmap[*p])
+ if (! fastmap[*p])
+ break;
+ if (! ASCII_CHAR_P (c))
+ {
+ /* See the comment in the previous similar code. */
+ for (i = 0; i < n_char_ranges; i += 2)
+ if (c >= char_ranges[i] && c <= char_ranges[i + 1])
+ break;
+ if (!(negate ^ (i < n_char_ranges)))
break;
- fwd_unibyte_ok:
- p++, pos++;
}
- }
+ back_ok:
+ pos--, pos_byte -= prev_p - p;
+ }
else
- {
- if (multibyte)
- while (1)
+ while (1)
+ {
+ if (p <= stop)
{
- unsigned char *prev_p;
- int nbytes;
+ if (p <= endp)
+ break;
+ p = GPT_ADDR;
+ stop = endp;
+ }
- if (p <= stop)
- {
- if (p <= endp)
- break;
- p = GPT_ADDR;
- stop = endp;
- }
- prev_p = p;
- while (--p >= stop && ! CHAR_HEAD_P (*p));
- PARSE_MULTIBYTE_SEQ (p, MAX_MULTIBYTE_LENGTH, nbytes);
- if (prev_p - p > nbytes)
- p = prev_p - 1, c = *p, nbytes = 1;
+ if (! NILP (iso_classes) && in_classes (p[-1], iso_classes))
+ {
+ if (negate)
+ break;
else
- c = STRING_CHAR (p, MAX_MULTIBYTE_LENGTH);
+ goto back_unibyte_ok;
+ }
- if (! NILP (iso_classes) && in_classes (c, iso_classes))
- {
- if (negate)
- break;
- else
- goto back_ok;
- }
+ if (!fastmap[p[-1]])
+ break;
+ back_unibyte_ok:
+ p--, pos--, pos_byte--;
+ }
+ }
- if (SINGLE_BYTE_CHAR_P (c))
- {
- if (!fastmap[c])
- break;
- }
- else
- {
- /* See the comment in the previous similar code. */
- for (i = 0; i < n_char_ranges; i += 2)
- if (c >= char_ranges[i] && c <= char_ranges[i + 1])
- break;
- if (!(negate ^ (i < n_char_ranges)))
- break;
- }
- back_ok:
- pos--, pos_byte -= nbytes;
- }
- else
- while (1)
- {
- if (p <= stop)
- {
- if (p <= endp)
- break;
- p = GPT_ADDR;
- stop = endp;
- }
+ SET_PT_BOTH (pos, pos_byte);
+ immediate_quit = 0;
- if (! NILP (iso_classes) && in_classes (p[-1], iso_classes))
- {
- if (negate)
- break;
- else
- goto back_unibyte_ok;
- }
+ return make_number (PT - start_point);
+ }
+}
- if (!fastmap[p[-1]])
- break;
- back_unibyte_ok:
- p--, pos--;
- }
- }
+
+static Lisp_Object
+skip_syntaxes (forwardp, string, lim)
+ int forwardp;
+ Lisp_Object string, lim;
+{
+ register unsigned int c;
+ unsigned char fastmap[0400];
+ int negate = 0;
+ register int i, i_byte;
+ int multibyte;
+ int size_byte;
+ unsigned char *str;
+
+ CHECK_STRING (string);
+
+ if (NILP (lim))
+ XSETINT (lim, forwardp ? ZV : BEGV);
+ else
+ CHECK_NUMBER_COERCE_MARKER (lim);
+
+ /* In any case, don't allow scan outside bounds of buffer. */
+ if (XINT (lim) > ZV)
+ XSETFASTINT (lim, ZV);
+ if (XINT (lim) < BEGV)
+ XSETFASTINT (lim, BEGV);
+
+ if (forwardp ? (PT >= XFASTINT (lim)) : (PT <= XFASTINT (lim)))
+ return make_number (0);
+
+ multibyte = (!NILP (current_buffer->enable_multibyte_characters)
+ && (XINT (lim) - PT != CHAR_TO_BYTE (XINT (lim)) - PT_BYTE));
+
+ bzero (fastmap, sizeof fastmap);
+
+ if (SBYTES (string) > SCHARS (string))
+ /* As this is very rare case (syntax spec is ASCII only), don't
+ consider efficiency. */
+ string = string_make_unibyte (string);
+
+ str = SDATA (string);
+ size_byte = SBYTES (string);
+
+ i_byte = 0;
+ if (i_byte < size_byte
+ && SREF (string, 0) == '^')
+ {
+ negate = 1; i_byte++;
+ }
+
+ /* Find the syntaxes specified and set their elements of fastmap. */
+
+ while (i_byte < size_byte)
+ {
+ c = str[i_byte++];
+ fastmap[syntax_spec_code[c]] = 1;
+ }
+
+ /* If ^ was the first character, complement the fastmap. */
+ if (negate)
+ for (i = 0; i < sizeof fastmap; i++)
+ fastmap[i] ^= 1;
+
+ {
+ int start_point = PT;
+ int pos = PT;
+ int pos_byte = PT_BYTE;
+ unsigned char *p = PT_ADDR, *endp, *stop;
+
+ if (forwardp)
+ {
+ endp = (XINT (lim) == GPT) ? GPT_ADDR : CHAR_POS_ADDR (XINT (lim));
+ stop = (pos < GPT && GPT < XINT (lim)) ? GPT_ADDR : endp;
+ }
+ else
+ {
+ endp = CHAR_POS_ADDR (XINT (lim));
+ stop = (pos >= GPT && GPT > XINT (lim)) ? GAP_END_ADDR : endp;
}
-#if 0 /* Not needed now that a position in mid-character
- cannot be specified in Lisp. */
- if (multibyte
- /* INC_POS or DEC_POS might have moved POS over LIM. */
- && (forwardp ? (pos > XINT (lim)) : (pos < XINT (lim))))
- pos = XINT (lim);
-#endif
+ immediate_quit = 1;
+ SETUP_SYNTAX_TABLE (pos, forwardp ? 1 : -1);
+ if (forwardp)
+ {
+ if (multibyte)
+ {
+ while (1)
+ {
+ int nbytes;
+
+ if (p >= stop)
+ {
+ if (p >= endp)
+ break;
+ p = GAP_END_ADDR;
+ stop = endp;
+ }
+ c = STRING_CHAR_AND_LENGTH (p, MAX_MULTIBYTE_LENGTH, nbytes);
+ if (! fastmap[(int) SYNTAX (c)])
+ break;
+ p += nbytes, pos++, pos_byte += nbytes;
+ UPDATE_SYNTAX_TABLE_FORWARD (pos);
+ }
+ }
+ else
+ {
+ while (1)
+ {
+ if (p >= stop)
+ {
+ if (p >= endp)
+ break;
+ p = GAP_END_ADDR;
+ stop = endp;
+ }
+ if (! fastmap[(int) SYNTAX (*p)])
+ break;
+ p++, pos++, pos_byte++;
+ UPDATE_SYNTAX_TABLE_FORWARD (pos);
+ }
+ }
+ }
+ else
+ {
+ if (multibyte)
+ {
+ while (1)
+ {
+ unsigned char *prev_p;
- if (! multibyte)
- pos_byte = pos;
+ if (p <= stop)
+ {
+ if (p <= endp)
+ break;
+ p = GPT_ADDR;
+ stop = endp;
+ }
+ UPDATE_SYNTAX_TABLE_BACKWARD (pos - 1);
+ prev_p = p;
+ while (--p >= stop && ! CHAR_HEAD_P (*p));
+ c = STRING_CHAR (p, MAX_MULTIBYTE_LENGTH);
+ if (! fastmap[(int) SYNTAX (c)])
+ break;
+ pos--, pos_byte -= prev_p - p;
+ }
+ }
+ else
+ {
+ while (1)
+ {
+ if (p <= stop)
+ {
+ if (p <= endp)
+ break;
+ p = GPT_ADDR;
+ stop = endp;
+ }
+ UPDATE_SYNTAX_TABLE_BACKWARD (pos - 1);
+ if (! fastmap[(int) SYNTAX (p[-1])])
+ break;
+ p--, pos--, pos_byte--;
+ }
+ }
+ }
SET_PT_BOTH (pos, pos_byte);
immediate_quit = 0;
*bytepos_ptr = from_byte;
return 0;
}
- c = FETCH_CHAR (from_byte);
+ c = FETCH_CHAR_AS_MULTIBYTE (from_byte);
syntax = SYNTAX_WITH_FLAGS (c);
code = syntax & 0xff;
if (code == Sendcomment
forw_incomment:
if (from < stop && SYNTAX_FLAGS_COMEND_FIRST (syntax)
&& SYNTAX_FLAGS_COMMENT_STYLE (syntax) == style
- && (c1 = FETCH_CHAR (from_byte),
+ && (c1 = FETCH_CHAR_AS_MULTIBYTE (from_byte),
SYNTAX_COMEND_SECOND (c1))
&& ((SYNTAX_FLAGS_COMMENT_NESTED (syntax) ||
SYNTAX_COMMENT_NESTED (c1)) ? nesting > 0 : nesting < 0))
if (nesting > 0
&& from < stop
&& SYNTAX_FLAGS_COMSTART_FIRST (syntax)
- && (c1 = FETCH_CHAR (from_byte),
+ && (c1 = FETCH_CHAR_AS_MULTIBYTE (from_byte),
SYNTAX_COMMENT_STYLE (c1) == style
&& SYNTAX_COMSTART_SECOND (c1))
&& (SYNTAX_FLAGS_COMMENT_NESTED (syntax) ||
immediate_quit = 0;
return Qnil;
}
- c = FETCH_CHAR (from_byte);
+ c = FETCH_CHAR_AS_MULTIBYTE (from_byte);
code = SYNTAX (c);
comstart_first = SYNTAX_COMSTART_FIRST (c);
comnested = SYNTAX_COMMENT_NESTED (c);
INC_BOTH (from, from_byte);
UPDATE_SYNTAX_TABLE_FORWARD (from);
if (from < stop && comstart_first
- && (c1 = FETCH_CHAR (from_byte),
+ && (c1 = FETCH_CHAR_AS_MULTIBYTE (from_byte),
SYNTAX_COMSTART_SECOND (c1)))
{
/* We have encountered a comment start sequence and we
DEC_BOTH (from, from_byte);
/* char_quoted does UPDATE_SYNTAX_TABLE_BACKWARD (from). */
quoted = char_quoted (from, from_byte);
- c = FETCH_CHAR (from_byte);
+ c = FETCH_CHAR_AS_MULTIBYTE (from_byte);
code = SYNTAX (c);
comstyle = 0;
comnested = SYNTAX_COMMENT_NESTED (c);
code = Sendcomment;
/* Calling char_quoted, above, set up global syntax position
at the new value of FROM. */
- c1 = FETCH_CHAR (from_byte);
+ c1 = FETCH_CHAR_AS_MULTIBYTE (from_byte);
comstyle = SYNTAX_COMMENT_STYLE (c1);
comnested = comnested || SYNTAX_COMMENT_NESTED (c1);
}
{
DEC_BOTH (from, from_byte);
UPDATE_SYNTAX_TABLE_BACKWARD (from);
- c = FETCH_CHAR (from_byte);
+ c = FETCH_CHAR_AS_MULTIBYTE (from_byte);
if (SYNTAX (c) == Scomment_fence
&& !char_quoted (from, from_byte))
{
return Qt;
}
\f
-/* Return syntax code of character C if C is a single byte character
+/* Return syntax code of character C if C is an ASCII character
or `multibyte_symbol_p' is zero. Otherwise, return Ssymbol. */
-#define SYNTAX_WITH_MULTIBYTE_CHECK(c) \
- ((SINGLE_BYTE_CHAR_P (c) || !multibyte_symbol_p) \
+#define SYNTAX_WITH_MULTIBYTE_CHECK(c) \
+ ((ASCII_CHAR_P (c) || !multibyte_symbol_p) \
? SYNTAX (c) : Ssymbol)
static Lisp_Object
{
int comstart_first, prefix;
UPDATE_SYNTAX_TABLE_FORWARD (from);
- c = FETCH_CHAR (from_byte);
+ c = FETCH_CHAR_AS_MULTIBYTE (from_byte);
code = SYNTAX_WITH_MULTIBYTE_CHECK (c);
comstart_first = SYNTAX_COMSTART_FIRST (c);
comnested = SYNTAX_COMMENT_NESTED (c);
INC_BOTH (from, from_byte);
UPDATE_SYNTAX_TABLE_FORWARD (from);
if (from < stop && comstart_first
- && (c = FETCH_CHAR (from_byte), SYNTAX_COMSTART_SECOND (c))
+ && (c = FETCH_CHAR_AS_MULTIBYTE (from_byte),
+ SYNTAX_COMSTART_SECOND (c))
&& parse_sexp_ignore_comments)
{
/* we have encountered a comment start sequence and we
only a comment end of the same style actually ends
the comment section */
code = Scomment;
- c1 = FETCH_CHAR (from_byte);
+ c1 = FETCH_CHAR_AS_MULTIBYTE (from_byte);
comstyle = SYNTAX_COMMENT_STYLE (c1);
comnested = comnested || SYNTAX_COMMENT_NESTED (c1);
INC_BOTH (from, from_byte);
UPDATE_SYNTAX_TABLE_FORWARD (from);
/* Some compilers can't handle this inside the switch. */
- c = FETCH_CHAR (from_byte);
+ c = FETCH_CHAR_AS_MULTIBYTE (from_byte);
temp = SYNTAX_WITH_MULTIBYTE_CHECK (c);
switch (temp)
{
case Smath:
if (!sexpflag)
break;
- if (from != stop && c == FETCH_CHAR (from_byte))
+ if (from != stop && c == FETCH_CHAR_AS_MULTIBYTE (from_byte))
{
INC_BOTH (from, from_byte);
}
case Sstring:
case Sstring_fence:
temp_pos = dec_bytepos (from_byte);
- stringterm = FETCH_CHAR (temp_pos);
+ stringterm = FETCH_CHAR_AS_MULTIBYTE (temp_pos);
while (1)
{
if (from >= stop) goto lose;
UPDATE_SYNTAX_TABLE_FORWARD (from);
- c = FETCH_CHAR (from_byte);
+ c = FETCH_CHAR_AS_MULTIBYTE (from_byte);
if (code == Sstring
? (c == stringterm
&& SYNTAX_WITH_MULTIBYTE_CHECK (c) == Sstring)
{
DEC_BOTH (from, from_byte);
UPDATE_SYNTAX_TABLE_BACKWARD (from);
- c = FETCH_CHAR (from_byte);
+ c = FETCH_CHAR_AS_MULTIBYTE (from_byte);
code = SYNTAX_WITH_MULTIBYTE_CHECK (c);
if (depth == min_depth)
last_good = from;
DEC_BOTH (from, from_byte);
UPDATE_SYNTAX_TABLE_BACKWARD (from);
code = Sendcomment;
- c1 = FETCH_CHAR (from_byte);
+ c1 = FETCH_CHAR_AS_MULTIBYTE (from_byte);
comstyle = SYNTAX_COMMENT_STYLE (c1);
comnested = comnested || SYNTAX_COMMENT_NESTED (c1);
}
else
temp_pos--;
UPDATE_SYNTAX_TABLE_BACKWARD (from - 1);
- c1 = FETCH_CHAR (temp_pos);
+ c1 = FETCH_CHAR_AS_MULTIBYTE (temp_pos);
temp_code = SYNTAX_WITH_MULTIBYTE_CHECK (c1);
/* Don't allow comment-end to be quoted. */
if (temp_code == Sendcomment)
temp_pos = dec_bytepos (temp_pos);
UPDATE_SYNTAX_TABLE_BACKWARD (from - 1);
}
- c1 = FETCH_CHAR (temp_pos);
+ c1 = FETCH_CHAR_AS_MULTIBYTE (temp_pos);
temp_code = SYNTAX_WITH_MULTIBYTE_CHECK (c1);
if (! (quoted || temp_code == Sword
|| temp_code == Ssymbol
break;
temp_pos = dec_bytepos (from_byte);
UPDATE_SYNTAX_TABLE_BACKWARD (from - 1);
- if (from != stop && c == FETCH_CHAR (temp_pos))
+ if (from != stop && c == FETCH_CHAR_AS_MULTIBYTE (temp_pos))
DEC_BOTH (from, from_byte);
if (mathexit)
{
DEC_BOTH (from, from_byte);
UPDATE_SYNTAX_TABLE_BACKWARD (from);
if (!char_quoted (from, from_byte)
- && (c = FETCH_CHAR (from_byte),
+ && (c = FETCH_CHAR_AS_MULTIBYTE (from_byte),
SYNTAX_WITH_MULTIBYTE_CHECK (c) == code))
break;
}
break;
case Sstring:
- stringterm = FETCH_CHAR (from_byte);
+ stringterm = FETCH_CHAR_AS_MULTIBYTE (from_byte);
while (1)
{
if (from == stop) goto lose;
DEC_BOTH (from, from_byte);
UPDATE_SYNTAX_TABLE_BACKWARD (from);
if (!char_quoted (from, from_byte)
- && stringterm == (c = FETCH_CHAR (from_byte))
+ && (stringterm
+ == (c = FETCH_CHAR_AS_MULTIBYTE (from_byte)))
&& SYNTAX_WITH_MULTIBYTE_CHECK (c) == Sstring)
break;
}
while (!char_quoted (pos, pos_byte)
/* Previous statement updates syntax table. */
- && ((c = FETCH_CHAR (pos_byte), SYNTAX (c) == Squote)
+ && ((c = FETCH_CHAR_AS_MULTIBYTE (pos_byte), SYNTAX (c) == Squote)
|| SYNTAX_PREFIX (c)))
{
opoint = pos;
stopbefore, oldstate, commentstop)
struct lisp_parse_state *stateptr;
register int from;
- int end, targetdepth, stopbefore, from_byte;
+ int from_byte;
+ int end, targetdepth, stopbefore;
Lisp_Object oldstate;
int commentstop;
{
#define INC_FROM \
do { prev_from = from; \
prev_from_byte = from_byte; \
- temp = FETCH_CHAR (prev_from_byte); \
+ temp = FETCH_CHAR_AS_MULTIBYTE (prev_from_byte); \
prev_from_syntax = SYNTAX_WITH_FLAGS (temp); \
INC_BOTH (from, from_byte); \
if (from < end) \
while (from < end)
{
/* Some compilers can't handle this inside the switch. */
- temp = FETCH_CHAR (from_byte);
+ temp = FETCH_CHAR_AS_MULTIBYTE (from_byte);
temp = SYNTAX (temp);
switch (temp)
{
if (stopbefore) goto stop; /* this arg means stop at sexp start */
curlevel->last = prev_from;
state.instring = (code == Sstring
- ? (FETCH_CHAR (prev_from_byte))
+ ? (FETCH_CHAR_AS_MULTIBYTE (prev_from_byte))
: ST_STRING_STYLE);
if (boundary_stop) goto done;
startinstring:
int c;
if (from >= end) goto done;
- c = FETCH_CHAR (from_byte);
+ c = FETCH_CHAR_AS_MULTIBYTE (from_byte);
/* Some compilers can't handle this inside the switch. */
temp = SYNTAX (c);
/* All multibyte characters have syntax `word' by default. */
temp = XVECTOR (Vsyntax_code_object)->contents[(int) Sword];
- for (i = CHAR_TABLE_SINGLE_BYTE_SLOTS; i < CHAR_TABLE_ORDINARY_SLOTS; i++)
- XCHAR_TABLE (Vstandard_syntax_table)->contents[i] = temp;
+ char_table_set_range (Vstandard_syntax_table, 0x80, MAX_CHAR, temp);
}
void
doc: /* *Non-nil means an open paren in column 0 denotes the start of a defun. */);
open_paren_in_column_0_is_defun_start = 1;
+
+ DEFVAR_LISP ("find-word-boundary-function-table",
+ &Vfind_word_boundary_function_table,
+ doc: /*
+Char table of functions to search for the word boundary.
+Each function is called with two arguments; POS and LIMIT.
+POS and LIMIT are character positions in the current buffer.
+
+If POS is less than LIMIT, POS is at the first character of a word,
+and the return value of a function is a position after the last
+character of that word.
+
+If POS is not less than LIMIT, POS is at the last character of a word,
+and the return value of a function is a position at the first
+character of that word.
+
+In both cases, LIMIT bounds the search. */);
+ Vfind_word_boundary_function_table = Fmake_char_table (Qnil, Qnil);
+
defsubr (&Ssyntax_table_p);
defsubr (&Ssyntax_table);
defsubr (&Sstandard_syntax_table);
/* Declarations having to do with GNU Emacs syntax tables.
Copyright (C) 1985, 1993, 1994, 1997, 1998, 2001, 2002, 2003, 2004,
- 2005, 2006, 2007 Free Software Foundation, Inc.
+ 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
This file is part of GNU Emacs.
/* Set the syntax entry VAL for char C in table TABLE. */
-#define SET_RAW_SYNTAX_ENTRY(table, c, val) \
- ((((c) & 0xFF) == (c)) \
- ? (XCHAR_TABLE (table)->contents[(unsigned char) (c)] = (val)) \
- : Faset ((table), make_number (c), (val)))
+#define SET_RAW_SYNTAX_ENTRY(table, c, val) \
+ CHAR_TABLE_SET ((table), c, (val))
-/* Fetch the syntax entry for char C in syntax table TABLE.
- This macro is called only when C is less than CHAR_TABLE_ORDINARY_SLOTS.
- Do inheritance. */
+/* Set the syntax entry VAL for char-range RANGE in table TABLE.
+ RANGE is a cons (FROM . TO) specifying the range of characters. */
-#ifdef __GNUC__
-#define SYNTAX_ENTRY_FOLLOW_PARENT(table, c) \
- ({ Lisp_Object _syntax_tbl = (table); \
- Lisp_Object _syntax_temp = XCHAR_TABLE (_syntax_tbl)->contents[(c)]; \
- while (NILP (_syntax_temp)) \
- { \
- _syntax_tbl = XCHAR_TABLE (_syntax_tbl)->parent; \
- if (NILP (_syntax_tbl)) \
- break; \
- _syntax_temp = XCHAR_TABLE (_syntax_tbl)->contents[(c)]; \
- } \
- _syntax_temp; })
-#else
-extern Lisp_Object syntax_temp;
-extern Lisp_Object syntax_parent_lookup P_ ((Lisp_Object, int));
-
-#define SYNTAX_ENTRY_FOLLOW_PARENT(table, c) \
- (syntax_temp = XCHAR_TABLE (table)->contents[(c)], \
- (NILP (syntax_temp) \
- ? syntax_parent_lookup (table, (c)) \
- : syntax_temp))
-#endif
+#define SET_RAW_SYNTAX_ENTRY_RANGE(table, range, val) \
+ Fset_char_table_range ((table), (range), (val))
/* SYNTAX_ENTRY fetches the information from the entry for character C
in syntax table TABLE, or from globally kept data (gl_state).
# define CURRENT_SYNTAX_TABLE current_buffer->syntax_table
#endif
-#define SYNTAX_ENTRY_INT(c) \
- ((((c) & 0xFF) == (c)) \
- ? SYNTAX_ENTRY_FOLLOW_PARENT (CURRENT_SYNTAX_TABLE, \
- (unsigned char) (c)) \
- : Faref (CURRENT_SYNTAX_TABLE, \
- make_number (c)))
+#define SYNTAX_ENTRY_INT(c) CHAR_TABLE_REF (CURRENT_SYNTAX_TABLE, (c))
/* Extract the information from the entry for character C
in the current syntax table. */
? XCDR (_syntax_temp) \
: Qnil); })
#else
+extern Lisp_Object syntax_temp;
#define SYNTAX(c) \
(syntax_temp = SYNTAX_ENTRY ((c)), \
(CONSP (syntax_temp) \
/* Terminal control module for terminals described by TERMCAP
Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1998, 2000, 2001,
- 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ 2002, 2003, 2004, 2005, 2006, 2007, 2008
+ Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include "lisp.h"
#include "termchar.h"
#include "termopts.h"
+#include "buffer.h"
+#include "character.h"
#include "charset.h"
#include "coding.h"
+#include "composite.h"
#include "keyboard.h"
#include "frame.h"
#include "disptab.h"
#ifdef HAVE_GPM
#include <sys/fcntl.h>
-#include "buffer.h"
static void term_clear_mouse_face ();
static void term_mouse_highlight (struct frame *f, int x, int y);
}
}
\f
-/* Buffer to store the source and result of code conversion for terminal. */
-static unsigned char *encode_terminal_buf;
-/* Allocated size of the above buffer. */
-static int encode_terminal_bufsize;
+/* Buffers to store the source and result of code conversion for terminal. */
+static unsigned char *encode_terminal_src;
+static unsigned char *encode_terminal_dst;
+/* Allocated sizes of the above buffers. */
+static int encode_terminal_src_size;
+static int encode_terminal_dst_size;
/* Encode SRC_LEN glyphs starting at SRC to terminal output codes.
Set CODING->produced to the byte-length of the resulting byte
int nchars, nbytes, required;
register int tlen = GLYPH_TABLE_LENGTH;
register Lisp_Object *tbase = GLYPH_TABLE_BASE;
+ Lisp_Object charset_list;
/* Allocate sufficient size of buffer to store all characters in
multibyte-form. But, it may be enlarged on demand if
- Vglyph_table contains a string. */
+ Vglyph_table contains a string or a composite glyph is
+ encountered. */
required = MAX_MULTIBYTE_LENGTH * src_len;
- if (encode_terminal_bufsize < required)
+ if (encode_terminal_src_size < required)
{
- if (encode_terminal_bufsize == 0)
- encode_terminal_buf = xmalloc (required);
+ if (encode_terminal_src_size == 0)
+ encode_terminal_src = xmalloc (required);
else
- encode_terminal_buf = xrealloc (encode_terminal_buf, required);
- encode_terminal_bufsize = required;
+ encode_terminal_src = xrealloc (encode_terminal_src, required);
+ encode_terminal_src_size = required;
}
- buf = encode_terminal_buf;
+ charset_list = coding_charset_list (coding);
+
+ buf = encode_terminal_src;
nchars = 0;
while (src < src_end)
{
+ if (src->type == COMPOSITE_GLYPH)
+ {
+ struct composition *cmp = composition_table[src->u.cmp_id];
+ int i;
+
+ nbytes = buf - encode_terminal_src;
+ required = MAX_MULTIBYTE_LENGTH * cmp->glyph_len;
+
+ if (encode_terminal_src_size < nbytes + required)
+ {
+ encode_terminal_src_size = nbytes + required;
+ encode_terminal_src = xrealloc (encode_terminal_src,
+ encode_terminal_src_size);
+ buf = encode_terminal_src + nbytes;
+ }
+
+ for (i = 0; i < cmp->glyph_len; i++)
+ {
+ int c = COMPOSITION_GLYPH (cmp, i);
+
+ if (! char_charset (c, charset_list, NULL))
+ break;
+ buf += CHAR_STRING (c, buf);
+ nchars++;
+ }
+ if (i == 0)
+ {
+ /* The first character of the composition is not encodable. */
+ *buf++ = '?';
+ nchars++;
+ }
+ }
/* We must skip glyphs to be padded for a wide character. */
- if (! CHAR_GLYPH_PADDING_P (*src))
+ else if (! CHAR_GLYPH_PADDING_P (*src))
{
+ int c;
+ Lisp_Object string;
+
+ string = Qnil;
g = GLYPH_FROM_CHAR_GLYPH (src[0]);
if (g < 0 || g >= tlen)
{
/* This glyph doesn't has an entry in Vglyph_table. */
- if (CHAR_VALID_P (src->u.ch, 0))
- buf += CHAR_STRING (src->u.ch, buf);
- else
- *buf++ = SPACEGLYPH;
- nchars++;
+ c = src->u.ch;
}
else
{
GLYPH_FOLLOW_ALIASES (tbase, tlen, g);
if (GLYPH_SIMPLE_P (tbase, tlen, g))
- {
- int c = FAST_GLYPH_CHAR (g);
+ /* We set the multi-byte form of a character in G
+ (that should be an ASCII character) at WORKBUF. */
+ c = FAST_GLYPH_CHAR (g);
+ else
+ /* We have a string in Vglyph_table. */
+ string = tbase[g];
+ }
- if (CHAR_VALID_P (c, 0))
- buf += CHAR_STRING (c, buf);
- else
- *buf++ = SPACEGLYPH;
+ if (NILP (string))
+ {
+ nbytes = buf - encode_terminal_src;
+ if (encode_terminal_src_size < nbytes + MAX_MULTIBYTE_LENGTH)
+ {
+ encode_terminal_src_size = nbytes + MAX_MULTIBYTE_LENGTH;
+ encode_terminal_src = xrealloc (encode_terminal_src,
+ encode_terminal_src_size);
+ buf = encode_terminal_src + nbytes;
+ }
+ if (char_charset (c, charset_list, NULL))
+ {
+ /* Store the multibyte form of C at BUF. */
+ buf += CHAR_STRING (c, buf);
nchars++;
}
else
{
- /* We have a string in Vglyph_table. */
- Lisp_Object string;
-
- string = tbase[g];
- if (! STRING_MULTIBYTE (string))
- string = string_to_multibyte (string);
- nbytes = buf - encode_terminal_buf;
- if (encode_terminal_bufsize < nbytes + SBYTES (string))
+ /* C is not encodable. */
+ *buf++ = '?';
+ nchars++;
+ while (src + 1 < src_end && CHAR_GLYPH_PADDING_P (src[1]))
{
- encode_terminal_bufsize = nbytes + SBYTES (string);
- encode_terminal_buf = xrealloc (encode_terminal_buf,
- encode_terminal_bufsize);
- buf = encode_terminal_buf + nbytes;
+ *buf++ = '?';
+ nchars++;
+ src++;
}
- bcopy (SDATA (string), buf, SBYTES (string));
- buf += SBYTES (string);
- nchars += SCHARS (string);
}
}
+ else
+ {
+ unsigned char *p = SDATA (string), *pend = p + SBYTES (string);
+
+ if (! STRING_MULTIBYTE (string))
+ string = string_to_multibyte (string);
+ nbytes = buf - encode_terminal_src;
+ if (encode_terminal_src_size < nbytes + SBYTES (string))
+ {
+ encode_terminal_src_size = nbytes + SBYTES (string);
+ encode_terminal_src = xrealloc (encode_terminal_src,
+ encode_terminal_src_size);
+ buf = encode_terminal_src + nbytes;
+ }
+ bcopy (SDATA (string), buf, SBYTES (string));
+ buf += SBYTES (string);
+ nchars += SCHARS (string);
+ }
}
src++;
}
- nbytes = buf - encode_terminal_buf;
- coding->src_multibyte = 1;
- coding->dst_multibyte = 0;
- if (SYMBOLP (coding->pre_write_conversion)
- && ! NILP (Ffboundp (coding->pre_write_conversion)))
+ if (nchars == 0)
{
- run_pre_write_conversin_on_c_str (&encode_terminal_buf,
- &encode_terminal_bufsize,
- nchars, nbytes, coding);
- nchars = coding->produced_char;
- nbytes = coding->produced;
+ coding->produced = 0;
+ return NULL;
}
- required = nbytes + encoding_buffer_size (coding, nbytes);
- if (encode_terminal_bufsize < required)
+
+ nbytes = buf - encode_terminal_src;
+ coding->source = encode_terminal_src;
+ if (encode_terminal_dst_size == 0)
{
- encode_terminal_bufsize = required;
- encode_terminal_buf = xrealloc (encode_terminal_buf, required);
+ encode_terminal_dst_size = encode_terminal_src_size;
+ encode_terminal_dst = xmalloc (encode_terminal_dst_size);
}
+ coding->destination = encode_terminal_dst;
+ coding->dst_bytes = encode_terminal_dst_size;
+ encode_coding_object (coding, Qnil, 0, 0, nchars, nbytes, Qnil);
+ /* coding->destination may have been reallocated. */
+ encode_terminal_dst = coding->destination;
+ encode_terminal_dst_size = coding->dst_bytes;
- encode_coding (coding, encode_terminal_buf, encode_terminal_buf + nbytes,
- nbytes, encode_terminal_bufsize - nbytes);
- return encode_terminal_buf + nbytes;
+ return (encode_terminal_dst);
}
+
/* An implementation of write_glyphs for termcap frames. */
static void
#ifdef static
#define append_glyph append_glyph_term
#define produce_stretch_glyph produce_stretch_glyph_term
+#define append_composite_glyph append_composite_glyph_term
+#define produce_composite_glyph produce_composite_glyph_term
#endif
static void append_glyph P_ ((struct it *));
static void produce_stretch_glyph P_ ((struct it *));
-
+static void append_composite_glyph P_ ((struct it *));
+static void produce_composite_glyph P_ ((struct it *));
/* Append glyphs to IT's glyph_row. Called from produce_glyphs for
terminal frames if IT->glyph_row != NULL. IT->char_to_display is
struct it *it;
{
/* If a hook is installed, let it do the work. */
+
+ /* Nothing but characters are supported on terminal frames. */
xassert (it->what == IT_CHARACTER
|| it->what == IT_COMPOSITION
|| it->what == IT_STRETCH);
goto done;
}
- /* Nothing but characters are supported on terminal frames. For a
- composition sequence, it->c is the first character of the
- sequence. */
- xassert (it->what == IT_CHARACTER
- || it->what == IT_COMPOSITION);
+ if (it->what == IT_COMPOSITION)
+ {
+ produce_composite_glyph (it);
+ goto done;
+ }
/* Maybe translate single-byte characters to multibyte. */
it->char_to_display = it->c;
it->pixel_width = nspaces;
it->nglyphs = nspaces;
}
- else if (SINGLE_BYTE_CHAR_P (it->c))
+ else if (CHAR_BYTE8_P (it->c))
{
if (unibyte_display_via_language_environment
- && (it->c >= 0240
- || !NILP (Vnonascii_translation_table)))
+ && (it->c >= 0240))
{
- int charset;
-
it->char_to_display = unibyte_char_to_multibyte (it->c);
- charset = CHAR_CHARSET (it->char_to_display);
- it->pixel_width = CHARSET_WIDTH (charset);
+ it->pixel_width = CHAR_WIDTH (it->char_to_display);
it->nglyphs = it->pixel_width;
if (it->glyph_row)
append_glyph (it);
}
else
{
- /* Coming here means that it->c is from display table, thus we
- must send the code as is to the terminal. Although there's
- no way to know how many columns it occupies on a screen, it
- is a good assumption that a single byte code has 1-column
- width. */
+ /* Coming here means that it->c is from display table, thus
+ we must send the raw 8-bit byte as is to the terminal.
+ Although there's no way to know how many columns it
+ occupies on a screen, it is a good assumption that a
+ single byte code has 1-column width. */
it->pixel_width = it->nglyphs = 1;
if (it->glyph_row)
append_glyph (it);
}
else
{
- /* A multi-byte character. The display width is fixed for all
- characters of the set. Some of the glyphs may have to be
- ignored because they are already displayed in a continued
- line. */
- int charset = CHAR_CHARSET (it->c);
-
- it->pixel_width = CHARSET_WIDTH (charset);
+ it->pixel_width = CHAR_WIDTH (it->c);
it->nglyphs = it->pixel_width;
if (it->glyph_row)
}
+/* Append glyphs to IT's glyph_row for the composition IT->cmp_id.
+ Called from produce_composite_glyph for terminal frames if
+ IT->glyph_row != NULL. IT->face_id contains the character's
+ face. */
+
+static void
+append_composite_glyph (it)
+ struct it *it;
+{
+ struct glyph *glyph;
+
+ xassert (it->glyph_row);
+ glyph = it->glyph_row->glyphs[it->area] + it->glyph_row->used[it->area];
+ if (glyph < it->glyph_row->glyphs[1 + it->area])
+ {
+ glyph->type = COMPOSITE_GLYPH;
+ glyph->pixel_width = it->pixel_width;
+ glyph->u.cmp_id = it->cmp_id;
+ glyph->face_id = it->face_id;
+ glyph->padding_p = 0;
+ glyph->charpos = CHARPOS (it->position);
+ glyph->object = it->object;
+
+ ++it->glyph_row->used[it->area];
+ ++glyph;
+ }
+}
+
+
+/* Produce a composite glyph for iterator IT. IT->cmp_id is the ID of
+ the composition. We simply produces components of the composition
+ assuming that that the terminal has a capability to layout/render
+ it correctly. */
+
+static void
+produce_composite_glyph (it)
+ struct it *it;
+{
+ struct composition *cmp = composition_table[it->cmp_id];
+ int c;
+
+ xassert (cmp->glyph_len > 0);
+ c = COMPOSITION_GLYPH (cmp, 0);
+ it->pixel_width = CHAR_WIDTH (it->c);
+ it->nglyphs = 1;
+
+ if (it->glyph_row)
+ append_composite_glyph (it);
+}
+
+
/* Get information about special display element WHAT in an
environment described by IT. WHAT is one of IT_TRUNCATION or
IT_CONTINUATION. Maybe produce glyphs for WHAT if IT has a
#endif
- encode_terminal_bufsize = 0;
+ encode_terminal_src_size = 0;
+ encode_terminal_dst_size = 0;
#ifdef HAVE_GPM
terminal->mouse_position_hook = term_mouse_position;
/* 16-bit Windows Selection processing for emacs on MS-Windows
Copyright (C) 1996, 1997, 2001, 2002, 2003, 2004,
- 2005, 2006, 2007 Free Software Foundation, Inc.
+ 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include "frame.h" /* Need this to get the X window of selected_frame */
#include "blockinput.h"
#include "buffer.h"
-#include "charset.h"
+#include "character.h"
#include "coding.h"
#include "composite.h"
/* Implementation of BDF font handling on the Microsoft W32 API.
Copyright (C) 1999, 2001, 2002, 2003, 2004, 2005,
- 2006, 2007 Free Software Foundation, Inc.
+ 2006, 2007, 2008 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#endif
#include "lisp.h"
-#include "charset.h"
+#include "character.h"
#include "keyboard.h"
#include "frame.h"
#include "dispextern.h"
return 1;
}
-char*
+static char*
get_quoted_string(char *start, char *end)
{
char *p, *q, *result;
else if (search_file_line("CHARSET_ENCODING", start, len,
(char **)&p, (char **)&q) == 1)
{
- fontp->encoding = get_quoted_string(p, q);
+ fontp->encoding = get_quoted_string(p, q);
}
else if (search_file_line("SLANT", start, len,
(char **)&p, (char **)&q) == 1)
uses this font. So, we set informatoin in fontp->encoding[1]
which is never used by any charset. If mapping can't be
decided, set FONT_ENCODING_NOT_DECIDED. */
- fontp->encoding[1] = FONT_ENCODING_NOT_DECIDED;
+ fontp->encoding_type = FONT_ENCODING_NOT_DECIDED;
fontp->baseline_offset = bdf_font->yoffset;
fontp->relative_compose = bdf_font->relative_compose;
fontp->default_ascent = bdf_font->default_ascent;
/* Terminal hooks for GNU Emacs on the Microsoft W32 API.
Copyright (C) 1992, 1999, 2001, 2002, 2003, 2004,
- 2005, 2006, 2007 Free Software Foundation, Inc.
+ 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include <string.h>
#include "lisp.h"
-#include "charset.h"
+#include "character.h"
#include "coding.h"
#include "disptab.h"
#include "frame.h"
/* Graphical user interface functions for the Microsoft W32 API.
Copyright (C) 1989, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
- 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
+ Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include <math.h>
#include "lisp.h"
-#include "charset.h"
-#include "dispextern.h"
#include "w32term.h"
-#include "keyboard.h"
#include "frame.h"
#include "window.h"
#include "buffer.h"
-#include "fontset.h"
#include "intervals.h"
+#include "dispextern.h"
+#include "keyboard.h"
#include "blockinput.h"
#include "epaths.h"
-#include "w32heap.h"
-#include "termhooks.h"
+#include "character.h"
+#include "charset.h"
#include "coding.h"
#include "ccl.h"
+#include "fontset.h"
#include "systime.h"
+#include "termhooks.h"
+#include "w32heap.h"
#include "bitmaps/gray.xbm"
#include <objbase.h>
#include <dlgs.h>
+#include <imm.h>
#define FILE_NAME_TEXT_FIELD edt1
+#ifdef USE_FONT_BACKEND
+#include "font.h"
+#endif
+
void syms_of_w32fns ();
void globals_of_w32fns ();
typedef BOOL (WINAPI * TrackMouseEvent_Proc)
(IN OUT LPTRACKMOUSEEVENT lpEventTrack);
+typedef LONG (WINAPI * ImmGetCompositionString_Proc)
+ (IN HIMC context, IN DWORD index, OUT LPVOID buffer, IN DWORD bufLen);
+typedef HIMC (WINAPI * ImmGetContext_Proc) (IN HWND window);
TrackMouseEvent_Proc track_mouse_event_fn = NULL;
ClipboardSequence_Proc clipboard_sequence_fn = NULL;
+ImmGetCompositionString_Proc get_composition_string_fn = NULL;
+ImmGetContext_Proc get_ime_context_fn = NULL;
+
extern AppendMenuW_Proc unicode_append_menu;
+/* Flag to selectively ignore WM_IME_CHAR messages. */
+static int ignore_ime_char = 0;
+
/* W95 mousewheel handler */
unsigned int msh_mousewheel = 0;
Lisp_Object tail, frame;
struct frame *f;
- for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
+ for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
{
frame = XCAR (tail);
- if (!GC_FRAMEP (frame))
+ if (!FRAMEP (frame))
continue;
f = XFRAME (frame);
if (!FRAME_W32_P (f) || FRAME_W32_DISPLAY_INFO (f) != dpyinfo)
{
Lisp_Object keylist;
- /* Use GC_CONSP, since we are called asynchronously. */
- for (keylist = w32_grabbed_keys; GC_CONSP (keylist); keylist = XCDR (keylist))
+ /* Use CONSP, since we are called asynchronously. */
+ for (keylist = w32_grabbed_keys; CONSP (keylist); keylist = XCDR (keylist))
{
Lisp_Object key = XCAR (keylist);
{
Lisp_Object keylist;
- /* Use GC_CONSP, since we are called asynchronously. */
- for (keylist = w32_grabbed_keys; GC_CONSP (keylist); keylist = XCDR (keylist))
+ for (keylist = w32_grabbed_keys; CONSP (keylist); keylist = XCDR (keylist))
{
Lisp_Object key = XCAR (keylist);
if (windows_translate)
{
MSG windows_msg = { hwnd, msg, wParam, lParam, 0, {0,0} };
-
windows_msg.time = GetMessageTime ();
TranslateMessage (&windows_msg);
goto dflt;
w32_get_key_modifiers (wParam, lParam));
break;
+ case WM_UNICHAR:
+ /* WM_UNICHAR looks promising from the docs, but the exact
+ circumstances in which TranslateMessage sends it is one of those
+ Microsoft secret API things that EU and US courts are supposed
+ to have put a stop to already. Spy++ shows it being sent to Notepad
+ and other MS apps, but never to Emacs.
+
+ Some third party IMEs send it in accordance with the official
+ documentation though, so handle it here.
+
+ UNICODE_NOCHAR is used to test for support for this message.
+ TRUE indicates that the message is supported. */
+ if (wParam == UNICODE_NOCHAR)
+ return TRUE;
+
+ {
+ W32Msg wmsg;
+ wmsg.dwModifiers = w32_get_key_modifiers (wParam, lParam);
+ signal_user_input ();
+ my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
+ }
+ break;
+
+ case WM_IME_CHAR:
+ /* If we can't get the IME result as unicode, use default processing,
+ which will at least allow characters decodable in the system locale
+ get through. */
+ if (!get_composition_string_fn)
+ goto dflt;
+
+ else if (!ignore_ime_char)
+ {
+ wchar_t * buffer;
+ int size, i;
+ W32Msg wmsg;
+ HIMC context = get_ime_context_fn (hwnd);
+ wmsg.dwModifiers = w32_get_key_modifiers (wParam, lParam);
+ /* Get buffer size. */
+ size = get_composition_string_fn (context, GCS_RESULTSTR, buffer, 0);
+ buffer = alloca(size);
+ size = get_composition_string_fn (context, GCS_RESULTSTR,
+ buffer, size);
+ signal_user_input ();
+ for (i = 0; i < size / sizeof (wchar_t); i++)
+ {
+ my_post_msg (&wmsg, hwnd, WM_UNICHAR, (WPARAM) buffer[i],
+ lParam);
+ }
+ /* We output the whole string above, so ignore following ones
+ until we are notified of the end of composition. */
+ ignore_ime_char = 1;
+ }
+ break;
+
+ case WM_IME_ENDCOMPOSITION:
+ ignore_ime_char = 0;
+ goto dflt;
+
/* Simulate middle mouse button events when left and right buttons
are used together, but only if user has two button mouse. */
case WM_LBUTTONDOWN:
return Qnil;
}
+#ifdef USE_FONT_BACKEND
+static void
+x_default_font_parameter (f, parms)
+ struct frame *f;
+ Lisp_Object parms;
+{
+ struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f);
+ Lisp_Object font = x_get_arg (dpyinfo, parms, Qfont, "font", "Font",
+ RES_TYPE_STRING);
+
+ if (!STRINGP (font))
+ {
+ int i;
+ static char *names[]
+ = { "Courier New-10",
+ "-*-Courier-normal-r-*-*-13-*-*-*-c-*-iso8859-1",
+ "-*-Fixedsys-normal-r-*-*-12-*-*-*-c-*-iso8859-1",
+ "Fixedsys",
+ NULL };
+
+ for (i = 0; names[i]; i++)
+ {
+ font = font_open_by_name (f, names[i]);
+ if (! NILP (font))
+ break;
+ }
+ if (NILP (font))
+ error ("No suitable font was found");
+ }
+ x_default_parameter (f, parms, Qfont, font, "font", "Font", RES_TYPE_STRING);
+}
+#endif
DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
1, 1, 0,
specbind (Qx_resource_name, name);
}
+ f->resx = dpyinfo->resx;
+ f->resy = dpyinfo->resy;
+
+#ifdef USE_FONT_BACKEND
+ if (enable_font_backend)
+ {
+ /* Perhaps, we must allow frame parameter, say `font-backend',
+ to specify which font backends to use. */
+ register_font_driver (&w32font_driver, f);
+
+ x_default_parameter (f, parameters, Qfont_backend, Qnil,
+ "fontBackend", "FontBackend", RES_TYPE_STRING);
+ }
+#endif /* USE_FONT_BACKEND */
+
/* Extract the window parameters from the supplied values
that are needed to determine window geometry. */
+#ifdef USE_FONT_BACKEND
+ if (enable_font_backend)
+ x_default_font_parameter (f, parameters);
+ else
+#endif
{
Lisp_Object font;
{
tem = Fquery_fontset (font, Qnil);
if (STRINGP (tem))
- font = x_new_fontset (f, SDATA (tem));
+ font = x_new_fontset (f, tem);
else
font = x_new_font (f, SDATA (font));
}
fontp->name = (char *) xmalloc (strlen (fontname) + 1);
bcopy (fontname, fontp->name, strlen (fontname) + 1);
- if (lf.lfPitchAndFamily == FIXED_PITCH)
+ if ((lf.lfPitchAndFamily & 0x03) == FIXED_PITCH)
{
/* Fixed width font. */
- fontp->average_width = fontp->space_width = FONT_WIDTH (font);
+ fontp->average_width = fontp->space_width = FONT_AVG_WIDTH (font);
}
else
{
if (pcm)
fontp->space_width = pcm->width;
else
- fontp->space_width = FONT_WIDTH (font);
+ fontp->space_width = FONT_AVG_WIDTH (font);
fontp->average_width = font->tm.tmAveCharWidth;
}
+ fontp->charset = -1;
charset = xlfd_charset_of_font (fontname);
/* Cache the W32 codepage for a font. This makes w32_encode_char
(0:0x20..0x7F, 1:0xA0..0xFF,
(0:0x2020..0x7F7F, 1:0xA0A0..0xFFFF, 3:0x20A0..0x7FFF,
2:0xA020..0xFF7F). For the moment, we don't know which charset
- uses this font. So, we set information in fontp->encoding[1]
+ uses this font. So, we set information in fontp->encoding_type
which is never used by any charset. If mapping can't be
decided, set FONT_ENCODING_NOT_DECIDED. */
type FONT_ENCODING_NOT_DECIDED. */
encoding = strrchr (fontp->name, '-');
if (encoding && strnicmp (encoding+1, "sjis", 4) == 0)
- fontp->encoding[1] = 4;
+ fontp->encoding_type = 4;
else
- fontp->encoding[1] = FONT_ENCODING_NOT_DECIDED;
+ fontp->encoding_type = FONT_ENCODING_NOT_DECIDED;
/* The following three values are set to 0 under W32, which is
what they get set to if XGetFontProperty fails under X. */
return "*";
}
-static LONG
+LONG
x_to_w32_charset (lpcs)
char * lpcs;
{
if (strncmp (lpcs, "*-#", 3) == 0)
return atoi (lpcs + 3);
+ /* All Windows fonts qualify as unicode. */
+ if (!strncmp (lpcs, "iso10646", 8))
+ return DEFAULT_CHARSET;
+
/* Handle wildcards by ignoring them; eg. treat "big5*-*" as "big5". */
charset = alloca (len + 1);
strcpy (charset, lpcs);
lpcs = strchr (charset, '*');
if (lpcs)
- *lpcs = 0;
+ *lpcs = '\0';
/* Look through w32-charset-info-alist for the character set.
Format of each entry is
}
-static char *
-w32_to_x_charset (fncharset)
+char *
+w32_to_x_charset (fncharset, matching)
int fncharset;
+ char *matching;
{
static char buf[32];
Lisp_Object charset_type;
+ int match_len = 0;
+
+ if (matching)
+ {
+ /* If fully specified, accept it as it is. Otherwise use a
+ substring match. */
+ char *wildcard = strchr (matching, '*');
+ if (wildcard)
+ *wildcard = '\0';
+ else if (strchr (matching, '-'))
+ return matching;
+
+ match_len = strlen (matching);
+ }
switch (fncharset)
{
{
Lisp_Object rest;
char * best_match = NULL;
+ int matching_found = 0;
/* Look through w32-charset-info-alist for the character set.
Prefer ISO codepages, and prefer lower numbers in the ISO
/* If we don't have a match already, then this is the
best. */
if (!best_match)
- best_match = x_charset;
- /* If this is an ISO codepage, and the best so far isn't,
- then this is better. */
- else if (strnicmp (best_match, "iso", 3) != 0
- && strnicmp (x_charset, "iso", 3) == 0)
- best_match = x_charset;
+ {
+ best_match = x_charset;
+ if (matching && !strnicmp (x_charset, matching, match_len))
+ matching_found = 1;
+ }
+ /* If we already found a match for MATCHING, then
+ only consider other matches. */
+ else if (matching_found
+ && strnicmp (x_charset, matching, match_len))
+ continue;
+ /* If this matches what we want, and the best so far doesn't,
+ then this is better. */
+ else if (!matching_found && matching
+ && !strnicmp (x_charset, matching, match_len))
+ {
+ best_match = x_charset;
+ matching_found = 1;
+ }
+ /* If this is fully specified, and the best so far isn't,
+ then this is better. */
+ else if ((!strchr (best_match, '-') && strchr (x_charset, '-'))
+ /* If this is an ISO codepage, and the best so far isn't,
+ then this is better, but only if it fully specifies the
+ encoding. */
+ || (strnicmp (best_match, "iso", 3) != 0
+ && strnicmp (x_charset, "iso", 3) == 0
+ && strchr (x_charset, '-')))
+ best_match = x_charset;
/* If both are ISO8859 codepages, choose the one with the
lowest number in the encoding field. */
else if (strnicmp (best_match, "iso8859-", 8) == 0
}
strncpy (buf, best_match, 31);
+ /* If the charset is not fully specified, put -0 on the end. */
+ if (!strchr (best_match, '-'))
+ {
+ int pos = strlen (best_match);
+ /* Charset specifiers shouldn't be very long. If it is a made
+ up one, truncating it should not do any harm since it isn't
+ recognized anyway. */
+ if (pos > 29)
+ pos = 29;
+ strcpy (buf + pos, "-0");
+ }
buf[31] = '\0';
return buf;
}
{
Lisp_Object rest;
/* Look through w32-charset-info-alist for the character set.
- Only return charsets for codepages which are installed.
+ Only return fully specified charsets for codepages which are
+ installed.
Format of each entry in Vw32_charset_info_alist is
(CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
w32_charset = XCAR (XCDR (this_entry));
codepage = XCDR (XCDR (this_entry));
+ if (!strchr (SDATA (x_charset), '-'))
+ continue;
+
/* Look for Same charset and a valid codepage (or non-int
which means ignore). */
if (EQ (w32_charset, charset_type)
Lisp_Object codepage, entry;
char *charset_str, *charset, *end;
- if (NILP (Vw32_charset_info_alist))
- return CP_DEFAULT;
-
/* Extract charset part of font string. */
charset = xlfd_charset_of_font (fontname);
*end = '\0';
}
- entry = Fassoc (build_string (charset), Vw32_charset_info_alist);
+ if (!strcmp (charset, "iso10646"))
+ return CP_UNICODE;
+
+ if (NILP (Vw32_charset_info_alist))
+ return CP_DEFAULT;
+
+ entry = Fassoc (build_string(charset), Vw32_charset_info_alist);
if (NILP (entry))
return CP_UNKNOWN;
char *fontname_dash;
int display_resy = (int) one_w32_display_info.resy;
int display_resx = (int) one_w32_display_info.resx;
- int bufsz;
struct coding_system coding;
if (!lpxstr) abort ();
coding.mode |= CODING_MODE_LAST_BLOCK;
/* We explicitely disable composition handling because selection
data should not contain any composition sequence. */
- coding.composing = COMPOSITION_DISABLED;
- bufsz = decoding_buffer_size (&coding, LF_FACESIZE);
+ coding.common_flags &= ~CODING_ANNOTATION_MASK;
+
+ coding.dst_bytes = LF_FACESIZE * 2;
+ coding.destination = (unsigned char *) xmalloc (coding.dst_bytes + 1);
+ decode_coding_c_string (&coding, lplogfont->lfFaceName,
+ strlen(lplogfont->lfFaceName), Qnil);
+ fontname = coding.destination;
- fontname = alloca (sizeof (*fontname) * bufsz);
- decode_coding (&coding, lplogfont->lfFaceName, fontname,
- strlen (lplogfont->lfFaceName), bufsz - 1);
*(fontname + coding.produced) = '\0';
/* Replace dashes with underscores so the dashes are not
((lplogfont->lfPitchAndFamily & 0x3) == VARIABLE_PITCH)
? 'p' : 'c', /* spacing */
width_pixels, /* avg width */
- specific_charset ? specific_charset
- : w32_to_x_charset (lplogfont->lfCharSet)
+ w32_to_x_charset (lplogfont->lfCharSet, specific_charset)
/* charset registry and encoding */
);
if (fields > 0 && name[0] != '*')
{
- int bufsize;
- unsigned char *buf;
-
+ Lisp_Object string = build_string (name);
setup_coding_system
(Fcheck_coding_system (Vlocale_coding_system), &coding);
- coding.src_multibyte = 1;
- coding.dst_multibyte = 0;
- /* Need to set COMPOSITION_DISABLED, otherwise Emacs crashes in
- encode_coding_iso2022 trying to dereference a null pointer. */
- coding.composing = COMPOSITION_DISABLED;
- if (coding.type == coding_type_iso2022)
- coding.flags |= CODING_FLAG_ISO_SAFE;
- bufsize = encoding_buffer_size (&coding, strlen (name));
- buf = (unsigned char *) alloca (bufsize);
- coding.mode |= CODING_MODE_LAST_BLOCK;
- encode_coding (&coding, name, buf, strlen (name), bufsize);
+ coding.mode |= (CODING_MODE_SAFE_ENCODING | CODING_MODE_LAST_BLOCK);
+ /* Disable composition/charset annotation. */
+ coding.common_flags &= ~CODING_ANNOTATION_MASK;
+ coding.dst_bytes = SCHARS (string) * 2;
+
+ coding.destination = (unsigned char *) xmalloc (coding.dst_bytes);
+ encode_coding_object (&coding, string, 0, 0,
+ SCHARS (string), SBYTES (string), Qnil);
if (coding.produced >= LF_FACESIZE)
coding.produced = LF_FACESIZE - 1;
- buf[coding.produced] = 0;
- strcpy (lplogfont->lfFaceName, buf);
+
+ coding.destination[coding.produced] = '\0';
+
+ strcpy (lplogfont->lfFaceName, coding.destination);
+ xfree (coding.destination);
}
else
{
lplogfont->lfHeight = atoi (height) * dpi / 720;
if (fields > 0)
- lplogfont->lfPitchAndFamily =
- (fields > 0 && pitch == 'p') ? VARIABLE_PITCH : FIXED_PITCH;
+ {
+ if (pitch == 'p')
+ lplogfont->lfPitchAndFamily = VARIABLE_PITCH | FF_DONTCARE;
+ else if (pitch == 'c')
+ lplogfont->lfPitchAndFamily = FIXED_PITCH | FF_DONTCARE;
+ }
fields--;
if (charset
&& strncmp (charset, "*-*", 3) != 0
&& lpef->logfont.lfCharSet == DEFAULT_CHARSET
- && strcmp (charset, w32_to_x_charset (DEFAULT_CHARSET)) != 0)
+ && strcmp (charset, w32_to_x_charset (DEFAULT_CHARSET, NULL)) != 0)
return 1;
}
if (charset)
charset_list = Fcons (build_string (charset), Qnil);
else
- charset_list = w32_to_all_x_charsets (lplf->elfLogFont.lfCharSet);
+ /* Always prefer unicode. */
+ charset_list
+ = Fcons (build_string ("iso10646-1"),
+ w32_to_all_x_charsets (lplf->elfLogFont.lfCharSet));
/* Loop through the charsets. */
for ( ; CONSP (charset_list); charset_list = Fcdr (charset_list))
Lisp_Object this_charset = Fcar (charset_list);
charset = SDATA (this_charset);
+ enum_font_maybe_add_to_list (lpef, &(lplf->elfLogFont),
+ charset, width);
+
/* List bold and italic variations if w32-enable-synthesized-fonts
is non-nil and this is a plain font. */
if (w32_enable_synthesized_fonts
&& lplf->elfLogFont.lfWeight == FW_NORMAL
&& lplf->elfLogFont.lfItalic == FALSE)
{
- enum_font_maybe_add_to_list (lpef, &(lplf->elfLogFont),
- charset, width);
/* bold. */
lplf->elfLogFont.lfWeight = FW_BOLD;
enum_font_maybe_add_to_list (lpef, &(lplf->elfLogFont),
enum_font_maybe_add_to_list (lpef, &(lplf->elfLogFont),
charset, width);
}
- else
- enum_font_maybe_add_to_list (lpef, &(lplf->elfLogFont),
- charset, width);
}
}
hdc = GetDC (dpyinfo->root_window);
oldobj = SelectObject (hdc, thisinfo.hfont);
if (GetTextMetrics (hdc, &thisinfo.tm))
- XSETCDR (tem, make_number (FONT_WIDTH (&thisinfo)));
+ XSETCDR (tem, make_number (FONT_AVG_WIDTH (&thisinfo)));
else
XSETCDR (tem, make_number (0));
SelectObject (hdc, oldobj);
specbind (Qx_resource_name, name);
}
+ f->resx = dpyinfo->resx;
+ f->resy = dpyinfo->resy;
+
+#ifdef USE_FONT_BACKEND
+ if (enable_font_backend)
+ {
+ /* Perhaps, we must allow frame parameter, say `font-backend',
+ to specify which font backends to use. */
+ register_font_driver (&w32font_driver, f);
+
+ x_default_parameter (f, parms, Qfont_backend, Qnil,
+ "fontBackend", "FontBackend", RES_TYPE_STRING);
+ }
+#endif /* USE_FONT_BACKEND */
+
/* Extract the window parameters from the supplied values
that are needed to determine window geometry. */
+#ifdef USE_FONT_BACKEND
+ if (enable_font_backend)
+ x_default_font_parameter (f, parms);
+ else
+#endif /* USE_FONT_BACKEND */
{
Lisp_Object font;
{
tem = Fquery_fontset (font, Qnil);
if (STRINGP (tem))
- font = x_new_fontset (f, SDATA (tem));
+ font = x_new_fontset (f, tem);
else
font = x_new_font (f, SDATA (font));
}
x_set_fringe_width,
0, /* x_set_wait_for_wm, */
x_set_fullscreen,
+#ifdef USE_FONT_BACKEND
+ x_set_font_backend
+#endif
};
void
w32_visible_system_caret_hwnd = NULL;
- Qnone = intern ("none");
- staticpro (&Qnone);
- Qsuppress_icon = intern ("suppress-icon");
- staticpro (&Qsuppress_icon);
- Qundefined_color = intern ("undefined-color");
- staticpro (&Qundefined_color);
- Qcancel_timer = intern ("cancel-timer");
- staticpro (&Qcancel_timer);
-
- Qhyper = intern ("hyper");
- staticpro (&Qhyper);
- Qsuper = intern ("super");
- staticpro (&Qsuper);
- Qmeta = intern ("meta");
- staticpro (&Qmeta);
- Qalt = intern ("alt");
- staticpro (&Qalt);
- Qctrl = intern ("ctrl");
- staticpro (&Qctrl);
- Qcontrol = intern ("control");
- staticpro (&Qcontrol);
- Qshift = intern ("shift");
- staticpro (&Qshift);
+ DEFSYM (Qnone, "none");
+ DEFSYM (Qsuppress_icon, "suppress-icon");
+ DEFSYM (Qundefined_color, "undefined-color");
+ DEFSYM (Qcancel_timer, "cancel-timer");
+ DEFSYM (Qhyper, "hyper");
+ DEFSYM (Qsuper, "super");
+ DEFSYM (Qmeta, "meta");
+ DEFSYM (Qalt, "alt");
+ DEFSYM (Qctrl, "ctrl");
+ DEFSYM (Qcontrol, "control");
+ DEFSYM (Qshift, "shift");
/* This is the end of symbol initialization. */
/* Text property `display' should be nonsticky by default. */
to display the character set, t to do no translation and output as Unicode,
or nil to do no translation and output as 8 bit (or multibyte on far-east
versions of Windows) characters. */);
- Vw32_charset_info_alist = Qnil;
-
- staticpro (&Qw32_charset_ansi);
- Qw32_charset_ansi = intern ("w32-charset-ansi");
- staticpro (&Qw32_charset_symbol);
- Qw32_charset_default = intern ("w32-charset-default");
- staticpro (&Qw32_charset_default);
- Qw32_charset_symbol = intern ("w32-charset-symbol");
- staticpro (&Qw32_charset_shiftjis);
- Qw32_charset_shiftjis = intern ("w32-charset-shiftjis");
- staticpro (&Qw32_charset_hangeul);
- Qw32_charset_hangeul = intern ("w32-charset-hangeul");
- staticpro (&Qw32_charset_chinesebig5);
- Qw32_charset_chinesebig5 = intern ("w32-charset-chinesebig5");
- staticpro (&Qw32_charset_gb2312);
- Qw32_charset_gb2312 = intern ("w32-charset-gb2312");
- staticpro (&Qw32_charset_oem);
- Qw32_charset_oem = intern ("w32-charset-oem");
+ Vw32_charset_info_alist = Qnil;
+
+ DEFSYM (Qw32_charset_ansi, "w32-charset-ansi");
+ DEFSYM (Qw32_charset_symbol, "w32-charset-symbol");
+ DEFSYM (Qw32_charset_default, "w32-charset-default");
+ DEFSYM (Qw32_charset_shiftjis, "w32-charset-shiftjis");
+ DEFSYM (Qw32_charset_hangeul, "w32-charset-hangeul");
+ DEFSYM (Qw32_charset_chinesebig5, "w32-charset-chinesebig5");
+ DEFSYM (Qw32_charset_gb2312, "w32-charset-gb2312");
+ DEFSYM (Qw32_charset_oem, "w32-charset-oem");
#ifdef JOHAB_CHARSET
{
DEFVAR_BOOL ("w32-extra-charsets-defined", &w32_extra_charsets_defined,
doc: /* Internal variable. */);
- staticpro (&Qw32_charset_johab);
- Qw32_charset_johab = intern ("w32-charset-johab");
- staticpro (&Qw32_charset_easteurope);
- Qw32_charset_easteurope = intern ("w32-charset-easteurope");
- staticpro (&Qw32_charset_turkish);
- Qw32_charset_turkish = intern ("w32-charset-turkish");
- staticpro (&Qw32_charset_baltic);
- Qw32_charset_baltic = intern ("w32-charset-baltic");
- staticpro (&Qw32_charset_russian);
- Qw32_charset_russian = intern ("w32-charset-russian");
- staticpro (&Qw32_charset_arabic);
- Qw32_charset_arabic = intern ("w32-charset-arabic");
- staticpro (&Qw32_charset_greek);
- Qw32_charset_greek = intern ("w32-charset-greek");
- staticpro (&Qw32_charset_hebrew);
- Qw32_charset_hebrew = intern ("w32-charset-hebrew");
- staticpro (&Qw32_charset_vietnamese);
- Qw32_charset_vietnamese = intern ("w32-charset-vietnamese");
- staticpro (&Qw32_charset_thai);
- Qw32_charset_thai = intern ("w32-charset-thai");
- staticpro (&Qw32_charset_mac);
- Qw32_charset_mac = intern ("w32-charset-mac");
+ DEFSYM (Qw32_charset_johab, "w32-charset-johab");
+ DEFSYM (Qw32_charset_easteurope, "w32-charset-easteurope");
+ DEFSYM (Qw32_charset_turkish, "w32-charset-turkish");
+ DEFSYM (Qw32_charset_baltic, "w32-charset-baltic");
+ DEFSYM (Qw32_charset_russian, "w32-charset-russian");
+ DEFSYM (Qw32_charset_arabic, "w32-charset-arabic");
+ DEFSYM (Qw32_charset_greek, "w32-charset-greek");
+ DEFSYM (Qw32_charset_hebrew, "w32-charset-hebrew");
+ DEFSYM (Qw32_charset_vietnamese, "w32-charset-vietnamese");
+ DEFSYM (Qw32_charset_thai, "w32-charset-thai");
+ DEFSYM (Qw32_charset_mac, "w32-charset-mac");
}
#endif
DEFVAR_BOOL ("w32-unicode-charset-defined",
&w32_unicode_charset_defined,
doc: /* Internal variable. */);
-
- staticpro (&Qw32_charset_unicode);
- Qw32_charset_unicode = intern ("w32-charset-unicode");
+ DEFSYM (Qw32_charset_unicode, "w32-charset-unicode");
}
#endif
find_ccl_program_func = w32_find_ccl_program;
query_font_func = w32_query_font;
set_frame_fontset_func = x_set_font;
+ get_font_repertory_func = x_get_font_repertory;
check_window_system_func = check_w32;
/* ditto for GetClipboardSequenceNumber. */
clipboard_sequence_fn = (ClipboardSequence_Proc)
GetProcAddress (user32_lib, "GetClipboardSequenceNumber");
-
+ {
+ HMODULE imm32_lib = GetModuleHandle ("imm32.dll");
+ get_composition_string_fn = (ImmGetCompositionString_Proc)
+ GetProcAddress (imm32_lib, "ImmGetCompositionStringW");
+ get_ime_context_fn = (ImmGetContext_Proc)
+ GetProcAddress (imm32_lib, "ImmGetContext");
+ }
DEFVAR_INT ("w32-ansi-code-page",
&w32_ansi_code_page,
doc: /* The ANSI code page used by the system. */);
/* Menu support for GNU Emacs on the Microsoft W32 API.
Copyright (C) 1986, 1988, 1993, 1994, 1996, 1998, 1999, 2001, 2002,
- 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ 2003, 2004, 2005, 2006, 2007, 2008
+ Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include "blockinput.h"
#include "buffer.h"
#include "charset.h"
+#include "character.h"
#include "coding.h"
/* This may include sys/types.h, and that somehow loses
Lisp_Object tail, frame;
FRAME_PTR f;
- for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
+ for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
{
frame = XCAR (tail);
- if (!GC_FRAMEP (frame))
+ if (!FRAMEP (frame))
continue;
f = XFRAME (frame);
if (!FRAME_WINDOW_P (f))
void syms_of_w32menu ()
{
- globals_of_w32menu ();
+ globals_of_w32menu ();
staticpro (&menu_items);
menu_items = Qnil;
current_popup_menu = NULL;
- Qdebug_on_next_call = intern ("debug-on-next-call");
- staticpro (&Qdebug_on_next_call);
+ DEFSYM (Qdebug_on_next_call, "debug-on-next-call");
defsubr (&Sx_popup_menu);
defsubr (&Smenu_or_popup_active_p);
/* Process support for GNU Emacs on the Microsoft W32 API.
Copyright (C) 1992, 1995, 1999, 2000, 2001, 2002, 2003, 2004,
- 2005, 2006, 2007 Free Software Foundation, Inc.
+ 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#endif
#include "lisp.h"
+#include "character.h"
#include "w32.h"
#include "w32heap.h"
#include "systime.h"
\f
syms_of_ntproc ()
{
- Qhigh = intern ("high");
- Qlow = intern ("low");
- staticpro (&Qhigh);
- staticpro (&Qlow);
+ DEFSYM (Qhigh, "high");
+ DEFSYM (Qlow, "low");
#ifdef HAVE_SOCKETS
defsubr (&Sw32_has_winsock);
/* Selection processing for Emacs on the Microsoft W32 API.
Copyright (C) 1993, 1994, 2001, 2002, 2003, 2004,
- 2005, 2006, 2007 Free Software Foundation, Inc.
+ 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include "keyboard.h" /* cmd_error_internal() */
#include "charset.h"
#include "coding.h"
+#include "character.h"
#include "composite.h"
static BOOL WINAPI enum_locale_callback (/*const*/ char* loc_string);
static UINT cp_from_locale (LCID lcid, UINT format);
static Lisp_Object coding_from_cp (UINT codepage);
+static Lisp_Object validate_coding_system (Lisp_Object coding_system);
+static void setup_windows_coding_system (Lisp_Object coding_system,
+ struct coding_system * coding);
/* A remnant from X11: Symbol for the CLIPBORD selection type. Other
static HGLOBAL
convert_to_handle_as_coded (Lisp_Object coding_system)
{
- HGLOBAL htext = NULL, htext2;
- int nbytes;
- unsigned char *src;
+ HGLOBAL htext;
unsigned char *dst = NULL;
- int bufsize;
struct coding_system coding;
- Lisp_Object string = Qnil;
ONTRACE (fprintf (stderr, "convert_to_handle_as_coded: %s\n",
SDATA (SYMBOL_NAME (coding_system))));
- setup_coding_system (Fcheck_coding_system (coding_system), &coding);
- coding.src_multibyte = 1;
- coding.dst_multibyte = 0;
- /* Need to set COMPOSITION_DISABLED, otherwise Emacs crashes in
- encode_coding_iso2022 trying to dereference a null pointer. */
- coding.composing = COMPOSITION_DISABLED;
- if (coding.type == coding_type_iso2022)
- coding.flags |= CODING_FLAG_ISO_SAFE;
- coding.mode |= CODING_MODE_LAST_BLOCK;
- /* Force DOS line-ends. */
- coding.eol_type = CODING_EOL_CRLF;
-
- if (SYMBOLP (coding.pre_write_conversion)
- && !NILP (Ffboundp (coding.pre_write_conversion)))
- string = run_pre_post_conversion_on_str (current_text, &coding, 1);
- else
- string = current_text;
-
- nbytes = SBYTES (string);
- src = SDATA (string);
+ setup_windows_coding_system (coding_system, &coding);
+ coding.dst_bytes = SBYTES(current_text) * 2;
+ coding.destination = (unsigned char *) xmalloc (coding.dst_bytes);
+ encode_coding_object (&coding, current_text, 0, 0,
+ SCHARS (current_text), SBYTES (current_text), Qnil);
- bufsize = encoding_buffer_size (&coding, nbytes) +2;
- htext = GlobalAlloc (GMEM_MOVEABLE | GMEM_DDESHARE, bufsize);
+ htext = GlobalAlloc (GMEM_MOVEABLE | GMEM_DDESHARE, coding.produced +2);
if (htext != NULL)
dst = (unsigned char *) GlobalLock (htext);
if (dst != NULL)
{
- encode_coding (&coding, src, dst, nbytes, bufsize-2);
+ memcpy (dst, coding.destination, coding.produced);
/* Add the string terminator. Add two NULs in case we are
producing Unicode here. */
dst[coding.produced] = dst[coding.produced+1] = '\0';
- }
-
- if (dst != NULL)
- GlobalUnlock (htext);
- if (htext != NULL)
- {
- /* Shrink data block to actual size. */
- htext2 = GlobalReAlloc (htext, coding.produced+2,
- GMEM_MOVEABLE | GMEM_DDESHARE);
- if (htext2 != NULL) htext = htext2;
+ GlobalUnlock (htext);
}
+ xfree (coding.destination);
+
return htext;
}
const char *cp;
char *end;
int slen;
- Lisp_Object new_coding_system;
+ Lisp_Object coding_system;
+ Lisp_Object dos_coding_system;
CHECK_SYMBOL (Vselection_coding_system);
- /* Check if we have it cached */
- new_coding_system = NILP (Vnext_selection_coding_system) ?
+ coding_system = NILP (Vnext_selection_coding_system) ?
Vselection_coding_system : Vnext_selection_coding_system;
+
+ dos_coding_system = validate_coding_system (coding_system);
+ if (NILP (dos_coding_system))
+ Fsignal (Qerror,
+ list2 (build_string ("Coding system is invalid or doesn't have "
+ "an eol variant for dos line ends"),
+ coding_system));
+
+ /* Check if we have it cached */
if (!NILP (cfg_coding_system)
- && EQ (cfg_coding_system, new_coding_system))
+ && EQ (cfg_coding_system, dos_coding_system))
return;
- cfg_coding_system = new_coding_system;
+ cfg_coding_system = dos_coding_system;
/* Set some sensible fallbacks */
cfg_codepage = ANSICP;
char buffer[30];
sprintf (buffer, "cp%d-dos", (int) codepage);
return intern (buffer);
- /* We don't need to check that this coding system exists right here,
- because that is done when the coding system is actually
- instantiated, i.e. it is passed through Fcheck_coding_system()
- there. */
+ /* We don't need to check that this coding system actually exists
+ right here, because that is done later for all coding systems
+ used, regardless of where they originate. */
}
+static Lisp_Object
+validate_coding_system (Lisp_Object coding_system)
+{
+ Lisp_Object eol_type;
+
+ /* Make sure the input is valid. */
+ if (NILP (Fcoding_system_p (coding_system)))
+ return Qnil;
+
+ /* Make sure we use a DOS coding system as mandated by the system
+ specs. */
+ eol_type = Fcoding_system_eol_type (coding_system);
+
+ /* Already a DOS coding system? */
+ if (EQ (eol_type, make_number (1)))
+ return coding_system;
+
+ /* Get EOL_TYPE vector of the base of CODING_SYSTEM. */
+ if (!VECTORP (eol_type))
+ {
+ eol_type = Fcoding_system_eol_type (Fcoding_system_base (coding_system));
+ if (!VECTORP (eol_type))
+ return Qnil;
+ }
+
+ return AREF (eol_type, 1);
+}
+
+static void
+setup_windows_coding_system (Lisp_Object coding_system,
+ struct coding_system * coding)
+{
+ memset (coding, 0, sizeof (*coding));
+ setup_coding_system (coding_system, coding);
+
+ /* Unset CODING_ANNOTATE_COMPOSITION_MASK. Previous code had
+ comments about crashes in encode_coding_iso2022 trying to
+ dereference a null pointer when composition was on. Selection
+ data should not contain any composition sequence on Windows.
+
+ CODING_ANNOTATION_MASK also includes
+ CODING_ANNOTATE_DIRECTION_MASK and CODING_ANNOTATE_CHARSET_MASK,
+ which both apply to ISO6429 only. We don't know if these really
+ need to be unset on Windows, but it probably doesn't hurt
+ either. */
+ coding->mode &= ~CODING_ANNOTATION_MASK;
+ coding->mode |= CODING_MODE_LAST_BLOCK | CODING_MODE_SAFE_ENCODING;
+}
+
+
DEFUN ("w32-set-clipboard-data", Fw32_set_clipboard_data,
Sw32_set_clipboard_data, 1, 2, 0,
if (require_decoding)
{
- int bufsize;
- unsigned char *buf;
struct coding_system coding;
Lisp_Object coding_system = Qnil;
+ Lisp_Object dos_coding_system;
/* `next-selection-coding-system' should override everything,
even when the locale passed by the system disagrees. The
coding_system = Vselection_coding_system;
Vnext_selection_coding_system = Qnil;
- setup_coding_system (Fcheck_coding_system (coding_system), &coding);
- coding.src_multibyte = 0;
- coding.dst_multibyte = 1;
- coding.mode |= CODING_MODE_LAST_BLOCK;
- /* We explicitely disable composition handling because
- selection data should not contain any composition
- sequence. */
- coding.composing = COMPOSITION_DISABLED;
- /* Force DOS line-ends. */
- coding.eol_type = CODING_EOL_CRLF;
-
- bufsize = decoding_buffer_size (&coding, nbytes);
- buf = (unsigned char *) xmalloc (bufsize);
- decode_coding (&coding, src, buf, nbytes, bufsize);
- Vlast_coding_system_used = coding.symbol;
- ret = make_string_from_bytes ((char *) buf,
- coding.produced_char, coding.produced);
- xfree (buf);
- if (SYMBOLP (coding.post_read_conversion)
- && !NILP (Ffboundp (coding.post_read_conversion)))
- ret = run_pre_post_conversion_on_str (ret, &coding, 0);
+ dos_coding_system = validate_coding_system (coding_system);
+ if (!NILP (dos_coding_system))
+ {
+ setup_windows_coding_system (dos_coding_system, &coding);
+ coding.source = src;
+ decode_coding_object (&coding, Qnil, 0, 0, nbytes, nbytes, Qt);
+ ret = coding.dst_object;
+
+ Vlast_coding_system_used = CODING_ID_NAME (coding.id);
+ }
}
else
{
{
Lisp_Object val = Qnil;
+ setup_config ();
+
if (OpenClipboard (NULL))
{
UINT format = 0;
- setup_config ();
while ((format = EnumClipboardFormats (format)))
/* Check CF_TEXT in addition to cfg_clipboard_type,
because we can fall back on that if CF_UNICODETEXT is
set to nil. */);
Vnext_selection_coding_system = Qnil;
- QCLIPBOARD = intern ("CLIPBOARD"); staticpro (&QCLIPBOARD);
+ DEFSYM (QCLIPBOARD, "CLIPBOARD");
cfg_coding_system = Qnil; staticpro (&cfg_coding_system);
current_text = Qnil; staticpro (¤t_text);
current_coding_system = Qnil; staticpro (¤t_coding_system);
- QUNICODE = intern ("utf-16le-dos"); staticpro (&QUNICODE);
+ DEFSYM (QUNICODE, "utf-16le-dos");
QANSICP = Qnil; staticpro (&QANSICP);
QOEMCP = Qnil; staticpro (&QOEMCP);
}
/* Implementation of GUI terminal on the Microsoft W32 API.
Copyright (C) 1989, 1993, 1994, 1995, 1996, 1997, 1998,
1999, 2000, 2001, 2002, 2003, 2004, 2005,
- 2006, 2007 Free Software Foundation, Inc.
+ 2006, 2007, 2008 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include <stdio.h>
#include <stdlib.h>
#include "lisp.h"
-#include "charset.h"
#include "blockinput.h"
-
-#include "w32heap.h"
#include "w32term.h"
-#include "w32bdf.h"
-#include <shellapi.h>
#include "systty.h"
#include "systime.h"
-#include "atimer.h"
-#include "keymap.h"
#include <ctype.h>
#include <errno.h>
#include <setjmp.h>
#include <sys/stat.h>
-#include "keyboard.h"
+#include "charset.h"
+#include "character.h"
+#include "coding.h"
+#include "ccl.h"
#include "frame.h"
#include "dispextern.h"
#include "fontset.h"
#include "disptab.h"
#include "buffer.h"
#include "window.h"
+#include "keyboard.h"
#include "intervals.h"
-#include "composite.h"
-#include "coding.h"
+#include "process.h"
+#include "atimer.h"
+#include "keymap.h"
+
+#include "w32heap.h"
+#include "w32bdf.h"
+#include <shellapi.h>
+
+#ifdef USE_FONT_BACKEND
+#include "font.h"
+#endif /* USE_FONT_BACKEND */
\f
/* Fringe bitmaps. */
FONT-LIST-CACHE records previous values returned by x-list-fonts. */
Lisp_Object w32_display_name_list;
+
+#ifndef GLYPHSET
+/* Pre Windows 2000, this was not available, but define it here so
+ that Emacs compiled on such a platform will run on newer versions. */
+
+typedef struct tagWCRANGE
+{
+ WCHAR wcLow;
+ USHORT cGlyphs;
+} WCRANGE;
+
+typedef struct tagGLYPHSET
+{
+ DWORD cbThis;
+ DWORD flAccel;
+ DWORD cGlyphsSupported;
+ DWORD cRanges;
+ WCRANGE ranges[1];
+} GLYPHSET;
+
+#endif
+
+/* Dynamic linking to GetFontUnicodeRanges (not available on 95, 98, ME). */
+DWORD (PASCAL *pfnGetFontUnicodeRanges) (HDC device, GLYPHSET *ranges);
+
/* Frame being updated by update_frame. This is declared in term.c.
This is set by update_begin and looked at by all the
w32 functions. It is zero while not inside an update.
/* Function prototypes of this page. */
XCharStruct *w32_per_char_metric P_ ((XFontStruct *, wchar_t *, int));
-static int w32_encode_char P_ ((int, wchar_t *, struct font_info *, int *));
+static int w32_encode_char P_ ((int, wchar_t *, struct font_info *,
+ struct charset *, int *));
/* Get metrics of character CHAR2B in FONT. Value is always non-null.
if (retval)
{
- pcm->width = sz.cx - font->tm.tmOverhang;
- pcm->rbearing = sz.cx;
+ pcm->width = sz.cx;
+ pcm->rbearing = sz.cx + font->tm.tmOverhang;
pcm->lbearing = 0;
pcm->ascent = FONT_BASE (font);
pcm->descent = FONT_DESCENT (font);
{
/* Use the font width and height as max bounds, as not all BDF
fonts contain the letter 'x'. */
- font->max_bounds.width = FONT_MAX_WIDTH (font);
+ font->max_bounds.width = FONT_WIDTH (font);
font->max_bounds.lbearing = -font->bdf->llx;
- font->max_bounds.rbearing = FONT_MAX_WIDTH (font) - font->bdf->urx;
+ font->max_bounds.rbearing = FONT_WIDTH (font) - font->bdf->urx;
font->max_bounds.ascent = FONT_BASE (font);
font->max_bounds.descent = FONT_DESCENT (font);
}
the two-byte form of C. Encoding is returned in *CHAR2B. */
static int /* enum w32_char_font_type */
-w32_encode_char (c, char2b, font_info, two_byte_p)
+w32_encode_char (c, char2b, font_info, charset, two_byte_p)
int c;
wchar_t *char2b;
struct font_info *font_info;
+ struct charset *charset;
int * two_byte_p;
{
- int charset = CHAR_CHARSET (c);
int codepage;
int unicode_p = 0;
int internal_two_byte_p = 0;
XFontStruct *font = font_info->font;
internal_two_byte_p = w32_font_is_double_byte (font);
+ codepage = font_info->codepage;
+
+ /* If font can output unicode, use the original unicode character. */
+ if ( font && !font->bdf && w32_use_unicode_for_codepage (codepage)
+ && c >= 0x100)
+ {
+ *char2b = c;
+ unicode_p = 1;
+ internal_two_byte_p = 1;
+ }
/* FONT_INFO may define a scheme by which to encode byte1 and byte2.
This may be either a program in a special encoder language or a
fixed encoding. */
- if (font_info->font_encoder)
+ else if (font_info->font_encoder)
{
/* It's a program. */
struct ccl_program *ccl = font_info->font_encoder;
if (CHARSET_DIMENSION (charset) == 1)
{
- ccl->reg[0] = charset;
+ ccl->reg[0] = CHARSET_ID (charset);
ccl->reg[1] = XCHAR2B_BYTE2 (char2b);
ccl->reg[2] = -1;
}
else
{
- ccl->reg[0] = charset;
+ ccl->reg[0] = CHARSET_ID (charset);
ccl->reg[1] = XCHAR2B_BYTE1 (char2b);
ccl->reg[2] = XCHAR2B_BYTE2 (char2b);
}
- ccl_driver (ccl, NULL, NULL, 0, 0, NULL);
+ ccl_driver (ccl, NULL, NULL, 0, 0, Qnil);
/* We assume that MSBs are appropriately set/reset by CCL
program. */
else
STORE_XCHAR2B (char2b, ccl->reg[1], ccl->reg[2]);
}
- else if (font_info->encoding[charset])
+ else if (font_info->encoding_type)
{
/* Fixed encoding scheme. See fontset.h for the meaning of the
encoding numbers. */
- int enc = font_info->encoding[charset];
+ unsigned char enc = font_info->encoding_type;
if ((enc == 1 || enc == 2)
&& CHARSET_DIMENSION (charset) == 2)
STORE_XCHAR2B (char2b, XCHAR2B_BYTE1 (char2b) | 0x80, XCHAR2B_BYTE2 (char2b));
- if (enc == 1 || enc == 3
- || (enc == 4 && CHARSET_DIMENSION (charset) == 1))
+ if (enc == 1 || enc == 3 || (enc == 4 && CHARSET_DIMENSION (charset) == 1))
STORE_XCHAR2B (char2b, XCHAR2B_BYTE1 (char2b), XCHAR2B_BYTE2 (char2b) | 0x80);
else if (enc == 4)
{
- int sjis1, sjis2;
+ int code = (int) (*char2b);
- ENCODE_SJIS (XCHAR2B_BYTE1 (char2b), XCHAR2B_BYTE2 (char2b),
- sjis1, sjis2);
- STORE_XCHAR2B (char2b, sjis1, sjis2);
+ JIS_TO_SJIS (code);
+ STORE_XCHAR2B (char2b, (code >> 8), (code & 0xFF));
}
}
- codepage = font_info->codepage;
-
- /* If charset is not ASCII or Latin-1, may need to move it into
- Unicode space. */
- if ( font && !font->bdf && w32_use_unicode_for_codepage (codepage)
- && charset != CHARSET_ASCII && charset != charset_latin_iso8859_1
- && charset != CHARSET_8_BIT_CONTROL && charset != CHARSET_8_BIT_GRAPHIC)
- {
- char temp[3];
- temp[0] = XCHAR2B_BYTE1 (char2b);
- temp[1] = XCHAR2B_BYTE2 (char2b);
- temp[2] = '\0';
- if (codepage != CP_UNICODE)
- {
- if (temp[0])
- MultiByteToWideChar (codepage, 0, temp, 2, char2b, 1);
- else
- MultiByteToWideChar (codepage, 0, temp+1, 1, char2b, 1);
- }
- unicode_p = 1;
- internal_two_byte_p = 1;
- }
if (two_byte_p)
*two_byte_p = internal_two_byte_p;
}
+/* Return a char-table whose elements are t if the font FONT_INFO
+ contains a glyph for the corresponding character, and nil if not.
+
+ Fixme: For the moment, this function works only for fonts whose
+ glyph encoding is the same as Unicode (e.g. ISO10646-1 fonts). */
+
+Lisp_Object
+x_get_font_repertory (f, font_info)
+ FRAME_PTR f;
+ struct font_info *font_info;
+{
+ XFontStruct *font = (XFontStruct *) font_info->font;
+ Lisp_Object table;
+ int min_byte1, max_byte1, min_byte2, max_byte2;
+ int c;
+ struct charset *charset = CHARSET_FROM_ID (font_info->charset);
+ int offset = CHARSET_OFFSET (charset);
+
+ table = Fmake_char_table (Qnil, Qnil);
+
+ if (!font->bdf && pfnGetFontUnicodeRanges)
+ {
+ GLYPHSET *glyphset;
+ DWORD glyphset_size;
+ HDC display = get_frame_dc (f);
+ HFONT prev_font;
+ int i;
+
+ prev_font = SelectObject (display, font->hfont);
+
+ /* First call GetFontUnicodeRanges to find out how big a structure
+ we need. */
+ glyphset_size = pfnGetFontUnicodeRanges (display, NULL);
+ if (glyphset_size)
+ {
+ glyphset = (GLYPHSET *) alloca (glyphset_size);
+ glyphset->cbThis = glyphset_size;
+
+ /* Now call it again to get the ranges. */
+ glyphset_size = pfnGetFontUnicodeRanges (display, glyphset);
+
+ if (glyphset_size)
+ {
+ /* Store the ranges in TABLE. */
+ for (i = 0; i < glyphset->cRanges; i++)
+ {
+ int from = glyphset->ranges[i].wcLow;
+ int to = from + glyphset->ranges[i].cGlyphs - 1;
+ char_table_set_range (table, from, to, Qt);
+ }
+ }
+ }
+
+ SelectObject (display, prev_font);
+ release_frame_dc (f, display);
+
+ /* If we got the information we wanted above, then return it. */
+ if (glyphset_size)
+ return table;
+ }
+
+#if 0 /* TODO: Convert to work on Windows so BDF and older platforms work. */
+ /* When GetFontUnicodeRanges is not available or does not work,
+ work it out manually. */
+ min_byte1 = font->min_byte1;
+ max_byte1 = font->max_byte1;
+ min_byte2 = font->min_char_or_byte2;
+ max_byte2 = font->max_char_or_byte2;
+ if (min_byte1 == 0 && max_byte1 == 0)
+ {
+ if (! font->per_char || font->all_chars_exist == True)
+ {
+ if (offset >= 0)
+ char_table_set_range (table, offset + min_byte2,
+ offset + max_byte2, Qt);
+ else
+ for (; min_byte2 <= max_byte2; min_byte2++)
+ {
+ c = DECODE_CHAR (charset, min_byte2);
+ CHAR_TABLE_SET (table, c, Qt);
+ }
+ }
+ else
+ {
+ XCharStruct *pcm = font->per_char;
+ int from = -1;
+ int i;
+
+ for (i = min_byte2; i <= max_byte2; i++, pcm++)
+ {
+ if (pcm->width == 0 && pcm->rbearing == pcm->lbearing)
+ {
+ if (from >= 0)
+ {
+ if (offset >= 0)
+ char_table_set_range (table, offset + from,
+ offset + i - 1, Qt);
+ else
+ for (; from < i; from++)
+ {
+ c = DECODE_CHAR (charset, from);
+ CHAR_TABLE_SET (table, c, Qt);
+ }
+ from = -1;
+ }
+ }
+ else if (from < 0)
+ from = i;
+ }
+ if (from >= 0)
+ {
+ if (offset >= 0)
+ char_table_set_range (table, offset + from, offset + i - 1,
+ Qt);
+ else
+ for (; from < i; from++)
+ {
+ c = DECODE_CHAR (charset, from);
+ CHAR_TABLE_SET (table, c, Qt);
+ }
+ }
+ }
+ }
+ else
+ {
+ if (! font->per_char || font->all_chars_exist == True)
+ {
+ int i, j;
+
+ if (offset >= 0)
+ for (i = min_byte1; i <= max_byte1; i++)
+ char_table_set_range
+ (table, offset + ((i << 8) | min_byte2),
+ offset + ((i << 8) | max_byte2), Qt);
+ else
+ for (i = min_byte1; i <= max_byte1; i++)
+ for (j = min_byte2; j <= max_byte2; j++)
+ {
+ unsiged code = (i << 8) | j;
+ c = DECODE_CHAR (charset, code);
+ CHAR_TABLE_SET (table, c, Qt);
+ }
+ }
+ else
+ {
+ XCharStruct *pcm = font->per_char;
+ int i;
+
+ for (i = min_byte1; i <= max_byte1; i++)
+ {
+ int from = -1;
+ int j;
+
+ for (j = min_byte2; j <= max_byte2; j++, pcm++)
+ {
+ if (pcm->width == 0 && pcm->rbearing == pcm->lbearing)
+ {
+ if (from >= 0)
+ {
+ if (offset >= 0)
+ char_table_set_range
+ (table, offset + ((i << 8) | from),
+ offset + ((i << 8) | (j - 1)), Qt);
+ else
+ {
+ for (; from < j; from++)
+ {
+ unsigned code = (i << 8) | from;
+ c = ENCODE_CHAR (charset, code);
+ CHAR_TABLE_SET (table, c, Qt);
+ }
+ }
+ from = -1;
+ }
+ }
+ else if (from < 0)
+ from = j;
+ }
+ if (from >= 0)
+ {
+ if (offset >= 0)
+ char_table_set_range
+ (table, offset + ((i << 8) | from),
+ offset + ((i << 8) | (j - 1)), Qt);
+ else
+ {
+ for (; from < j; from++)
+ {
+ unsigned code = (i << 8) | from;
+ c = DECODE_CHAR (charset, code);
+ CHAR_TABLE_SET (table, c, Qt);
+ }
+ }
+ }
+ }
+ }
+ }
+#endif
+ return table;
+}
+
\f
/***********************************************************************
Glyph display
face = FACE_FROM_ID (s->f, MOUSE_FACE_ID);
if (s->first_glyph->type == CHAR_GLYPH)
- face_id = FACE_FOR_CHAR (s->f, face, s->first_glyph->u.ch);
+ face_id = FACE_FOR_CHAR (s->f, face, s->first_glyph->u.ch, -1, Qnil);
else
- face_id = FACE_FOR_CHAR (s->f, face, 0);
+ face_id = FACE_FOR_CHAR (s->f, face, 0, -1, Qnil);
s->face = FACE_FROM_ID (s->f, face_id);
PREPARE_FACE_FOR_DISPLAY (s->f, s->face);
/* If font in this face is same as S->font, use it. */
if (s->font == s->face->font)
s->gc = s->face->gc;
+#ifdef USE_FONT_BACKEND
+ else if (enable_font_backend)
+ /* No need of setting a font for s->gc. */
+ s->gc = s->face->gc;
+#endif /* USE_FONT_BACKEND */
else
{
/* Otherwise construct scratch_cursor_gc with values from FACE
x_set_glyph_string_clipping (s)
struct glyph_string *s;
{
- RECT r;
- get_glyph_string_clip_rect (s, &r);
- w32_set_clip_rectangle (s->hdc, &r);
+#ifdef USE_FONT_BACKEND
+ RECT *r = s->clip;
+#else
+ RECT r[2];
+#endif
+ int n = get_glyph_string_clip_rects (s, r, 2);
+
+ if (n == 1)
+ w32_set_clip_rectangle (s->hdc, r);
+ else if (n > 1)
+ {
+ HRGN full_clip, clip1, clip2;
+ clip1 = CreateRectRgnIndirect (r);
+ clip2 = CreateRectRgnIndirect (r + 1);
+ if (CombineRgn (full_clip, clip1, clip2, RGN_OR) != ERROR)
+ {
+ SelectClipRgn (s->hdc, full_clip);
+ }
+ DeleteObject (clip1);
+ DeleteObject (clip2);
+ DeleteObject (full_clip);
+ }
+#ifdef USE_FONT_BACKEND
+ s->num_clips = n;
+#endif /* USE_FONT_BACKEND */
}
+/* Set SRC's clipping for output of glyph string DST. This is called
+ when we are drawing DST's left_overhang or right_overhang only in
+ the area of SRC. */
+
+static void
+x_set_glyph_string_clipping_exactly (src, dst)
+ struct glyph_string *src, *dst;
+{
+ RECT r;
+
+#ifdef USE_FONT_BACKEND
+ if (enable_font_backend)
+ {
+ r.left = src->x;
+ r.right = r.left + src->width;
+ r.top = src->y;
+ r.bottom = r.top + src->height;
+ dst->clip[0] = r;
+ dst->num_clips = 1;
+ }
+ else
+ {
+#endif /* USE_FONT_BACKEND */
+ struct glyph_string *clip_head = src->clip_head;
+ struct glyph_string *clip_tail = src->clip_tail;
+
+ /* This foces clipping just this glyph string. */
+ src->clip_head = src->clip_tail = src;
+ get_glyph_string_clip_rect (src, &r);
+ src->clip_head = clip_head, src->clip_tail = clip_tail;
+#ifdef USE_FONT_BACKEND
+ }
+#endif /* USE_FONT_BACKEND */
+ w32_set_clip_rectangle (dst->hdc, &r);
+}
/* RIF:
Compute left and right overhang of glyph string S. If S is a glyph
x += g->pixel_width;
}
}
+#ifdef USE_FONT_BACKEND
+ else if (enable_font_backend)
+ {
+ int boff = s->font_info->baseline_offset;
+ struct font *font = (struct font *) s->font_info;
+ int y;
+
+ if (s->font_info->vertical_centering)
+ boff = VCENTER_BASELINE_OFFSET (s->font, s->f) - boff;
+
+ y = s->ybase - boff;
+ if (s->for_overlaps
+ || (s->background_filled_p && s->hl != DRAW_CURSOR))
+ font->driver->draw (s, 0, s->nchars, x, y, 0);
+ else
+ font->driver->draw (s, 0, s->nchars, x, y, 1);
+ if (s->face->overstrike)
+ font->driver->draw (s, 0, s->nchars, x + 1, y, 0);
+ }
+#endif /* USE_FONT_BACKEND */
else
{
char *char1b = (char *) s->char2b;
x_draw_composite_glyph_string_foreground (s)
struct glyph_string *s;
{
- int i, x;
+ int i, j, x;
HFONT old_font;
/* If first glyph of S has a left box line, start drawing the text
of S to the right of that box line. */
- if (s->face->box != FACE_NO_BOX
+ if (s->face && s->face->box != FACE_NO_BOX
&& s->first_glyph->left_box_line_p)
x = s->x + eabs (s->face->box_line_width);
else
w32_draw_rectangle (s->hdc, s->gc, x, s->y, s->width - 1,
s->height - 1);
}
- else
+#ifdef USE_FONT_BACKEND
+ else if (enable_font_backend)
{
- for (i = 0; i < s->nchars; i++, ++s->gidx)
+ struct font *font = (struct font *) s->font_info;
+ int y = s->ybase;
+ int width = 0;
+
+ if (s->cmp->method == COMPOSITION_WITH_GLYPH_STRING)
{
- w32_text_out (s, x + s->cmp->offsets[s->gidx * 2],
- s->ybase - s->cmp->offsets[s->gidx * 2 + 1],
- s->char2b + i, 1);
- if (s->face->overstrike)
- w32_text_out (s, x + s->cmp->offsets[s->gidx * 2] + 1,
- s->ybase - s->cmp->offsets[s->gidx * 2 + 1],
- s->char2b + i, 1);
+ Lisp_Object gstring = AREF (XHASH_TABLE (composition_hash_table)
+ ->key_and_value,
+ s->cmp->hash_index * 2);
+ int from;
+
+ for (i = from = 0; i < s->nchars; i++)
+ {
+ Lisp_Object g = LGSTRING_GLYPH (gstring, i);
+ Lisp_Object adjustment = LGLYPH_ADJUSTMENT (g);
+ int xoff, yoff, wadjust;
+
+ if (! VECTORP (adjustment))
+ {
+ width += LGLYPH_WIDTH (g);
+ continue;
+ }
+ if (from < i)
+ {
+ font->driver->draw (s, from, i, x, y, 0);
+ x += width;
+ }
+ xoff = XINT (AREF (adjustment, 0));
+ yoff = XINT (AREF (adjustment, 1));
+ wadjust = XINT (AREF (adjustment, 2));
+
+ font->driver->draw (s, i, i + 1, x + xoff, y + yoff, 0);
+ x += wadjust;
+ from = i + 1;
+ width = 0;
+ }
+ if (from < i)
+ font->driver->draw (s, from, i, x, y, 0);
}
+ else
+ {
+ for (i = 0, j = s->gidx; i < s->nchars; i++, j++)
+ if (COMPOSITION_GLYPH (s->cmp, j) != '\t')
+ {
+ int xx = x + s->cmp->offsets[j * 2];
+ int yy = y - s->cmp->offsets[j * 2 + 1];
+
+ font->driver->draw (s, j, j + 1, xx, yy, 0);
+ if (s->face->overstrike)
+ font->driver->draw (s, j, j + 1, xx + 1, yy, 0);
+ }
+ }
+ }
+#endif /* USE_FONT_BACKEND */
+ else
+ {
+ for (i = 0, j = s->gidx; i < s->nchars; i++, j++)
+ if (s->face)
+ {
+ w32_text_out (s, x + s->cmp->offsets[j * 2],
+ s->ybase - s->cmp->offsets[j * 2 + 1],
+ s->char2b + j, 1);
+ if (s->face->overstrike)
+ w32_text_out (s, x + s->cmp->offsets[j * 2] + 1,
+ s->ybase - s->cmp->offsets[j + 1],
+ s->char2b + j, 1);
+ }
}
if (s->font && s->font->hfont)
This makes S->next use XDrawString instead of XDrawImageString. */
if (s->next && s->right_overhang && !s->for_overlaps)
{
- xassert (s->next->img == NULL);
- x_set_glyph_string_gc (s->next);
- x_set_glyph_string_clipping (s->next);
- x_draw_glyph_string_background (s->next, 1);
+ int width;
+ struct glyph_string *next;
+ for (width = 0, next = s->next; next;
+ width += next->width, next = next->next)
+ if (next->first_glyph->type != IMAGE_GLYPH)
+ {
+ x_set_glyph_string_gc (next);
+ x_set_glyph_string_clipping (next);
+ x_draw_glyph_string_background (next, 1);
+#ifdef USE_FONT_BACKEND
+ next->num_clips = 0;
+#endif /* USE_FONT_BACKEND */
+ }
}
/* Set up S->gc, set clipping and draw S. */
x_set_glyph_string_clipping (s);
relief_drawn_p = 1;
}
+ else if ((s->prev && s->prev->hl != s->hl && s->left_overhang)
+ || (s->next && s->next->hl != s->hl && s->right_overhang))
+ /* We must clip just this glyph. left_overhang part has already
+ drawn when s->prev was drawn, and right_overhang part will be
+ drawn later when s->next is drawn. */
+ x_set_glyph_string_clipping_exactly (s, s);
else
x_set_glyph_string_clipping (s);
if (s->face->underline_p
&& (s->font->bdf || !s->font->tm.tmUnderlined))
{
- unsigned long h = 1;
- unsigned long dy = 0;
+ unsigned long h;
+ int y;
+ /* Get the underline thickness. Default is 1 pixel. */
+#ifdef USE_FONT_BACKEND
+ if (enable_font_backend)
+ /* In the future, we must use information of font. */
+ h = 1;
+ else
+#endif /* USE_FONT_BACKEND */
+ h = 1;
- if (x_underline_at_descent_line)
- dy = s->height - h;
- else
+#ifdef USE_FONT_BACKEND
+ if (enable_font_backend)
+ {
+ if (s->face->font)
+ /* In the future, we must use information of font. */
+ y = s->ybase + (s->face->font->max_bounds.descent + 1) / 2;
+ else
+ y = s->y + s->height - h;
+ }
+ else
+#endif
{
- /* TODO: Use font information for positioning and thickness of
- underline. See OUTLINETEXTMETRIC, and xterm.c. Note: If
- you make this work, don't forget to change the doc string of
- x-use-underline-position-properties below. */
- dy = s->height - h;
+ y = s->y + s->height - h;
+ /* TODO: Use font information for positioning and
+ thickness of underline. See OUTLINETEXTMETRIC,
+ and xterm.c. Note: If you make this work,
+ don't forget to change the doc string of
+ x-use-underline_color-position-properties
+ below. */
+#if 0
+ if (!x_underline_at_descent_line)
+ {
+ ...
+ }
+#endif
}
if (s->face->underline_defaulted_p)
{
w32_fill_area (s->f, s->hdc, s->gc->foreground, s->x,
- s->y + dy, s->background_width, 1);
+ y, s->background_width, 1);
}
else
{
w32_fill_area (s->f, s->hdc, s->face->underline_color, s->x,
- s->y + dy, s->background_width, 1);
+ y, s->background_width, 1);
}
}
-
/* Draw overline. */
if (s->face->overline_p)
{
unsigned long dy = 0, h = 1;
if (s->face->overline_color_defaulted_p)
- {
- w32_fill_area (s->f, s->hdc, s->gc->foreground, s->x,
- s->y + dy, s->background_width, h);
- }
+ {
+ w32_fill_area (s->f, s->hdc, s->gc->foreground, s->x,
+ s->y + dy, s->background_width, h);
+ }
else
{
w32_fill_area (s->f, s->hdc, s->face->overline_color, s->x,
}
}
- /* Draw relief. */
+ /* Draw relief if not yet drawn. */
if (!relief_drawn_p && s->face->box != FACE_NO_BOX)
x_draw_glyph_string_box (s);
+
+ if (s->prev)
+ {
+ struct glyph_string *prev;
+
+ for (prev = s->prev; prev; prev = prev->prev)
+ if (prev->hl != s->hl
+ && prev->x + prev->width + prev->right_overhang > s->x)
+ {
+ /* As prev was drawn while clipped to its own area, we
+ must draw the right_overhang part using s->hl now. */
+ enum draw_glyphs_face save = prev->hl;
+
+ prev->hl = s->hl;
+ x_set_glyph_string_gc (prev);
+ x_set_glyph_string_clipping_exactly (s, prev);
+ if (prev->first_glyph->type == CHAR_GLYPH)
+ x_draw_glyph_string_foreground (prev);
+ else
+ x_draw_composite_glyph_string_foreground (prev);
+ w32_set_clip_rectangle (prev->hdc, NULL);
+ prev->hl = save;
+#ifdef USE_FONT_BACKEND
+ prev->num_clips = 0;
+#endif /* USE_FONT_BACKEND */
+ }
+ }
+
+ if (s->next)
+ {
+ struct glyph_string *next;
+
+ for (next = s->next; next; next = next->next)
+ if (next->hl != s->hl
+ && next->x - next->left_overhang < s->x + s->width)
+ {
+ /* As next will be drawn while clipped to its own area,
+ we must draw the left_overhang part using s->hl now. */
+ enum draw_glyphs_face save = next->hl;
+
+ next->hl = s->hl;
+ x_set_glyph_string_gc (next);
+ x_set_glyph_string_clipping_exactly (s, next);
+ if (next->first_glyph->type == CHAR_GLYPH)
+ x_draw_glyph_string_foreground (next);
+ else
+ x_draw_composite_glyph_string_foreground (next);
+ w32_set_clip_rectangle (next->hdc, NULL);
+ next->hl = save;
+#ifdef USE_FONT_BACKEND
+ next->num_clips = 0;
+#endif /* USE_FONT_BACKEND */
+ }
+ }
}
/* Reset clipping. */
w32_set_clip_rectangle (s->hdc, NULL);
+#ifdef USE_FONT_BACKEND
+ s->num_clips = 0;
+#endif /* USE_FONT_BACKEND */
}
/* Don't stop displaying the initial startup message
for a switch-frame event we don't need. */
- if (GC_NILP (Vterminal_frame)
- && GC_CONSP (Vframe_list)
- && !GC_NILP (XCDR (Vframe_list)))
+ if (NILP (Vterminal_frame)
+ && CONSP (Vframe_list)
+ && !NILP (XCDR (Vframe_list)))
{
bufp->kind = FOCUS_IN_EVENT;
XSETFRAME (bufp->frame_or_window, frame);
if (dpyinfo->w32_focus_frame)
{
dpyinfo->x_highlight_frame
- = ((GC_FRAMEP (FRAME_FOCUS_FRAME (dpyinfo->w32_focus_frame)))
+ = ((FRAMEP (FRAME_FOCUS_FRAME (dpyinfo->w32_focus_frame)))
? XFRAME (FRAME_FOCUS_FRAME (dpyinfo->w32_focus_frame))
: dpyinfo->w32_focus_frame);
if (! FRAME_LIVE_P (dpyinfo->x_highlight_frame))
memcpy (&last_mouse_motion_event, msg, sizeof (last_mouse_motion_event));
XSETFRAME (last_mouse_motion_frame, frame);
+ if (!FRAME_X_OUTPUT (frame))
+ return 0;
+
if (msg->hwnd != FRAME_W32_WINDOW (frame))
{
frame->mouse_moved = 1;
{
Lisp_Object tail;
- for (tail = Vframe_list;
- XGCTYPE (tail) == Lisp_Cons;
- tail = XCDR (tail))
+ for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
{
Lisp_Object frame, bar, condemned;
frame = XCAR (tail);
/* All elements of Vframe_list should be frames. */
- if (! GC_FRAMEP (frame))
+ if (! FRAMEP (frame))
abort ();
/* Scan this frame's scroll bar list for a scroll bar with the
for (bar = FRAME_SCROLL_BARS (XFRAME (frame));
/* This trick allows us to search both the ordinary and
condemned scroll bar lists with one loop. */
- ! GC_NILP (bar) || (bar = condemned,
+ ! NILP (bar) || (bar = condemned,
condemned = Qnil,
- ! GC_NILP (bar));
+ ! NILP (bar));
bar = XSCROLL_BAR (bar)->next)
if (SCROLL_BAR_W32_WINDOW (XSCROLL_BAR (bar)) == window_id)
return XSCROLL_BAR (bar);
W32Msg *msg;
struct input_event *emacs_event;
{
- if (! GC_WINDOWP (bar->window))
+ if (! WINDOWP (bar->window))
abort ();
emacs_event->kind = SCROLL_BAR_CLICK_EVENT;
}
break;
+ case WM_UNICHAR:
case WM_SYSCHAR:
case WM_CHAR:
f = x_window_to_frame (dpyinfo, msg.msg.hwnd);
if (temp_index == sizeof temp_buffer / sizeof (short))
temp_index = 0;
temp_buffer[temp_index++] = msg.msg.wParam;
-
- if (msg.msg.wParam < 128 && !dbcs_lead)
- {
- inev.kind = ASCII_KEYSTROKE_EVENT;
- inev.code = msg.msg.wParam;
- }
- else if (msg.msg.wParam < 256)
+ if (msg.msg.message == WM_UNICHAR)
{
- wchar_t code;
-
inev.kind = MULTIBYTE_CHAR_KEYSTROKE_EVENT;
-
- if (IsDBCSLeadByteEx(CP_ACP, (BYTE) msg.msg.wParam))
- {
- dbcs_lead = (char) msg.msg.wParam;
- inev.kind = NO_EVENT;
- break;
- }
- else if (dbcs_lead)
- {
- char dbcs[2];
- dbcs[0] = dbcs_lead;
- dbcs[1] = (char) msg.msg.wParam;
- dbcs_lead = 0;
- if (!MultiByteToWideChar(CP_ACP, 0, dbcs, 2, &code, 1))
- {
- /* Garbage */
- DebPrint (("Invalid DBCS sequence: %d %d\n",
- dbcs[0], dbcs[1]));
- inev.kind = NO_EVENT;
- break;
- }
- }
- else
- {
- char single_byte = (char) msg.msg.wParam;
- if (!MultiByteToWideChar(CP_ACP, 0, &single_byte, 1,
- &code, 1))
- {
- /* What to do with garbage? */
- DebPrint (("Invalid character: %d\n", single_byte));
- inev.kind = NO_EVENT;
- break;
- }
- }
-
- /* Now process unicode input as per xterm.c */
- if (code < 0x80)
- {
- inev.kind = ASCII_KEYSTROKE_EVENT;
- inev.code = code;
- }
- else if (code < 0xA0)
- inev.code = MAKE_CHAR (CHARSET_8_BIT_CONTROL, code, 0);
- else if (code < 0x100)
- inev.code = MAKE_CHAR (charset_latin_iso8859_1, code, 0);
- else
- {
- int c1, c2;
- int charset_id;
-
- if (code < 0x2500)
- {
- charset_id = charset_mule_unicode_0100_24ff;
- code -= 0x100;
- }
- else if (code < 0xE000)
- {
- charset_id = charset_mule_unicode_2500_33ff;
- code -= 0x2500;
- }
- else
- {
- charset_id = charset_mule_unicode_e000_ffff;
- code -= 0xE000;
- }
-
- c1 = (code / 96) + 32;
- c2 = (code % 96) + 32;
- inev.code = MAKE_CHAR (charset_id, c1, c2);
- }
+ inev.code = msg.msg.wParam;
}
else
{
- /* Windows shouldn't generate WM_CHAR events above 0xFF
- in non-Unicode message handlers. */
- DebPrint (("Non-byte WM_CHAR: %d\n", msg.msg.wParam));
- inev.kind = NO_EVENT;
- break;
+ inev.kind = ASCII_KEYSTROKE_EVENT;
+ inev.code = msg.msg.wParam;
}
inev.modifiers = msg.dwModifiers;
XSETFRAME (inev.frame_or_window, f);
register char *fontname;
{
struct font_info *fontp
- = FS_LOAD_FONT (f, 0, fontname, -1);
+ = FS_LOAD_FONT (f, fontname);
if (!fontp)
return Qnil;
+ if (FRAME_FONT (f) == (XFontStruct *) (fontp->font))
+ /* This font is already set in frame F. There's nothing more to
+ do. */
+ return build_string (fontp->full_name);
+
FRAME_FONT (f) = (XFontStruct *) (fontp->font);
FRAME_BASELINE_OFFSET (f) = fontp->baseline_offset;
FRAME_FONTSET (f) = -1;
return build_string (fontp->full_name);
}
\f
-/* Give frame F the fontset named FONTSETNAME as its default font, and
- return the full name of that fontset. FONTSETNAME may be a wildcard
- pattern; in that case, we choose some fontset that fits the pattern.
- The return value shows which fontset we chose. */
+/* Give frame F the fontset named FONTSETNAME as its default fontset,
+ and return the full name of that fontset. FONTSETNAME may be a
+ wildcard pattern; in that case, we choose some fontset that fits
+ the pattern. FONTSETNAME may be a font name for ASCII characters;
+ in that case, we create a fontset from that font name.
+
+ The return value shows which fontset we chose.
+ If FONTSETNAME specifies the default fontset, return Qt.
+ If an ASCII font in the specified fontset can't be loaded, return
+ Qnil. */
Lisp_Object
x_new_fontset (f, fontsetname)
struct frame *f;
- char *fontsetname;
+ Lisp_Object fontsetname;
{
- int fontset = fs_query_fontset (build_string (fontsetname), 0);
+ int fontset = fs_query_fontset (fontsetname, 0);
Lisp_Object result;
- if (fontset < 0)
- return Qnil;
-
- if (FRAME_FONTSET (f) == fontset)
+ if (fontset > 0 && FRAME_FONTSET(f) == fontset)
/* This fontset is already set in frame F. There's nothing more
to do. */
return fontset_name (fontset);
+ else if (fontset == 0)
+ /* The default fontset can't be the default font. */
+ return Qt;
- result = x_new_font (f, (SDATA (fontset_ascii (fontset))));
+ if (fontset > 0)
+ result = x_new_font (f, (SDATA (fontset_ascii (fontset))));
+ else
+ result = x_new_font (f, SDATA (fontsetname));
if (!STRINGP (result))
/* Can't load ASCII font. */
return Qnil;
+ if (fontset < 0)
+ fontset = new_fontset_from_font_name (result);
+
/* Since x_new_font doesn't update any fontset information, do it now. */
FRAME_FONTSET(f) = fontset;
- return build_string (fontsetname);
+ return fontset_name (fontset);
}
+#ifdef USE_FONT_BACKEND
+Lisp_Object
+x_new_fontset2 (f, fontset, font_object)
+ struct frame *f;
+ int fontset;
+ Lisp_Object font_object;
+{
+ struct font *font = XSAVE_VALUE (font_object)->pointer;
+
+ if (FRAME_FONT_OBJECT (f) == font)
+ /* This font is already set in frame F. There's nothing more to
+ do. */
+ return fontset_name (fontset);
+
+ BLOCK_INPUT;
+
+ FRAME_FONT_OBJECT (f) = font;
+ FRAME_FONT (f) = font->font.font;
+ FRAME_BASELINE_OFFSET (f) = font->font.baseline_offset;
+ FRAME_FONTSET (f) = fontset;
+
+ FRAME_COLUMN_WIDTH (f) = font->font.average_width;
+ FRAME_SPACE_WIDTH (f) = font->font.space_width;
+ FRAME_LINE_HEIGHT (f) = font->font.height;
+
+ compute_fringe_widths (f, 1);
+
+ /* Compute the scroll bar width in character columns. */
+ if (FRAME_CONFIG_SCROLL_BAR_WIDTH (f) > 0)
+ {
+ int wid = FRAME_COLUMN_WIDTH (f);
+ FRAME_CONFIG_SCROLL_BAR_COLS (f)
+ = (FRAME_CONFIG_SCROLL_BAR_WIDTH (f) + wid - 1) / wid;
+ }
+ else
+ {
+ int wid = FRAME_COLUMN_WIDTH (f);
+ FRAME_CONFIG_SCROLL_BAR_COLS (f) = (14 + wid - 1) / wid;
+ }
+
+ /* Now make the frame display the given font. */
+ if (FRAME_X_WINDOW (f) != 0)
+ {
+ /* Don't change the size of a tip frame; there's no point in
+ doing it because it's done in Fx_show_tip, and it leads to
+ problems because the tip frame has no widget. */
+ if (NILP (tip_frame) || XFRAME (tip_frame) != f)
+ x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
+ }
+
+#ifdef HAVE_X_I18N
+ if (FRAME_XIC (f)
+ && (FRAME_XIC_STYLE (f) & (XIMPreeditPosition | XIMStatusArea)))
+ xic_set_xfontset (f, SDATA (fontset_ascii (fontset)));
+#endif
+
+ UNBLOCK_INPUT;
+
+ return fontset_name (fontset);
+}
+#endif /* USE_FONT_BACKEND */
+
\f
/***********************************************************************
TODO: W32 Input Methods
BLOCK_INPUT;
+#ifdef USE_FONT_BACKEND
+ /* We must free faces before destroying windows because some
+ font-driver (e.g. xft) access a window while finishing a
+ face. */
+ if (enable_font_backend
+ && FRAME_FACE_CACHE (f))
+ free_frame_faces (f);
+#endif /* USE_FONT_BACKEND */
+
if (FRAME_W32_WINDOW (f))
my_destroy_window (f, FRAME_W32_WINDOW (f));
* average and maximum width, and maximum height.
*/
*h = FONT_HEIGHT (font);
- *w = FONT_WIDTH (font);
+ *w = FONT_AVG_WIDTH (font);
}
AttachThreadInput (dwMainThreadId, dwWindowsThreadId, TRUE);
#endif
- /* Load system settings. */
+ /* Dynamically link to optional system components. */
{
UINT smoothing_type;
BOOL smoothing_enabled;
- /* If using proportional scroll bars, ensure handle is at least 5 pixels;
- otherwise use the fixed height. */
+ HANDLE gdi_lib = LoadLibrary ("gdi32.dll");
+
+#define LOAD_PROC(lib, fn) pfn##fn = (void *) GetProcAddress (lib, #fn)
+
+ LOAD_PROC (gdi_lib, GetFontUnicodeRanges);
+
+#undef LOAD_PROC
+
+ FreeLibrary (gdi_lib);
+
+ /* Ensure scrollbar handle is at least 5 pixels. */
vertical_scroll_bar_min_handle = 5;
/* For either kind of scroll bar, take account of the arrows; these
staticpro (&last_mouse_scroll_bar);
last_mouse_scroll_bar = Qnil;
- staticpro (&Qvendor_specific_keysyms);
- Qvendor_specific_keysyms = intern ("vendor-specific-keysyms");
+ DEFSYM (Qvendor_specific_keysyms, "vendor-specific-keysyms");
DEFVAR_INT ("w32-num-mouse-buttons",
&w32_num_mouse_buttons,
/* Definitions and headers for communication on the Microsoft W32 API.
Copyright (C) 1995, 2001, 2002, 2003, 2004,
- 2005, 2006, 2007 Free Software Foundation, Inc.
+ 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#define WHITE_PIX_DEFAULT(f) PALETTERGB(255,255,255)
#define FONT_WIDTH(f) \
- ((f)->bdf ? (f)->bdf->width : (f)->tm.tmAveCharWidth)
+ ((f)->bdf ? (f)->bdf->width : (f)->tm.tmMaxCharWidth)
#define FONT_HEIGHT(f) \
((f)->bdf ? (f)->bdf->height : (f)->tm.tmHeight)
#define FONT_BASE(f) \
((f)->bdf ? (f)->bdf->ury : (f)->tm.tmAscent)
#define FONT_DESCENT(f) \
((f)->bdf ? -((f)->bdf->lly) : (f)->tm.tmDescent)
-#define FONT_MAX_WIDTH(f) \
- ((f)->bdf ? (f)->bdf->width : (f)->tm.tmMaxCharWidth)
+#define FONT_AVG_WIDTH(f) \
+ ((f)->bdf ? (f)->bdf->width : (f)->tm.tmAveCharWidth)
#define CP_DEFAULT 1004
/* Special pseudo-codepages. */
extern struct font_info *w32_get_font_info (), *w32_query_font ();
extern void w32_cache_char_metrics (XFontStruct *font);
extern void w32_find_ccl_program();
+extern Lisp_Object x_get_font_repertory P_ ((struct frame *,
+ struct font_info *));
\f
#define PIX_TYPE COLORREF
/* Default ASCII font of this frame. */
XFontStruct *font;
+#ifdef USE_FONT_BACKEND
+ struct font *fontp;
+#endif /* USE_FONT_BACKEND */
+
/* The baseline offset of the default ASCII font. */
int baseline_offset;
#define FRAME_FONTSET(f) ((f)->output_data.w32->fontset)
#define FRAME_BASELINE_OFFSET(f) ((f)->output_data.w32->baseline_offset)
+#ifdef USE_FONT_BACKEND
+#define FRAME_FONT_OBJECT(f) ((f)->output_data.w32->fontp)
+#endif /* USE_FONT_BACKEND */
+
/* This gives the w32_display_info structure for the display F is on. */
#define FRAME_W32_DISPLAY_INFO(f) (&one_w32_display_info)
#define FRAME_X_DISPLAY_INFO(f) (&one_w32_display_info)
#define WM_APPCOMMAND 0x319
#define GET_APPCOMMAND_LPARAM(lParam) (HIWORD(lParam) & 0x7fff)
#endif
+#ifndef WM_UNICHAR
+#define WM_UNICHAR 0x109
+#endif
+#ifndef UNICODE_NOCHAR
+#define UNICODE_NOCHAR 0xFFFF
+#endif
#define WM_EMACS_START (WM_USER + 1)
#define WM_EMACS_KILL (WM_EMACS_START + 0)
/* Functions taken directly from X sources for use with the Microsoft W32 API.
Copyright (C) 1989, 1992, 1993, 1994, 1995, 1999, 2001, 2002, 2003,
- 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
This file is part of GNU Emacs.
}
nQueue--;
+ /* Consolidate WM_PAINT messages to optimise redrawing. */
+ if (lpmsg->msg.message == WM_PAINT && nQueue)
+ {
+ int_msg * lpCur = lpHead;
+ int_msg * lpPrev = NULL;
+ int_msg * lpNext = NULL;
+
+ while (lpCur && nQueue)
+ {
+ lpNext = lpCur->lpNext;
+ if (lpCur->w32msg.msg.message == WM_PAINT)
+ {
+ /* Remove this message from the queue. */
+ if (lpPrev)
+ lpPrev->lpNext = lpNext;
+ else
+ lpHead = lpNext;
+
+ if (lpCur == lpTail)
+ lpTail = lpPrev;
+
+ /* Adjust clip rectangle to cover both. */
+ if (!UnionRect (&(lpmsg->rect), &(lpmsg->rect),
+ &(lpCur->w32msg.rect)))
+ {
+ SetRectEmpty(&(lpmsg->rect));
+ }
+
+ myfree (lpCur);
+
+ nQueue--;
+
+ lpCur = lpNext;
+ }
+ else
+ {
+ lpPrev = lpCur;
+ lpCur = lpNext;
+ }
+ }
+ }
bRet = TRUE;
}
/* Window creation, deletion and examination for GNU Emacs.
Does not include redisplay.
Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1996, 1997, 1998, 2000,
- 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
+ Free Software Foundation, Inc.
This file is part of GNU Emacs.
window = call1 (Vsplit_window_preferred_function, window);
else
{
- Lisp_Object upper, lower, other;
+ Lisp_Object upper, other;
window = Fget_lru_window (frames, Qt);
/* If the LRU window is tall enough, and either eligible for
window = Fframe_selected_window (call0 (Vpop_up_frame_function));
/* If window appears above or below another,
even out their heights. */
- other = upper = lower = Qnil;
+ other = upper = Qnil;
if (!NILP (XWINDOW (window)->prev))
- other = upper = XWINDOW (window)->prev, lower = window;
+ other = upper = XWINDOW (window)->prev;
if (!NILP (XWINDOW (window)->next))
- other = lower = XWINDOW (window)->next, upper = window;
+ other = XWINDOW (window)->next, upper = window;
if (!NILP (other)
&& !NILP (Veven_window_heights)
/* Check that OTHER and WINDOW are vertically arrayed. */
/* Display generation from window structure and buffer text.
Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995,
1997, 1998, 1999, 2000, 2001, 2002, 2003,
- 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include "termchar.h"
#include "dispextern.h"
#include "buffer.h"
+#include "character.h"
#include "charset.h"
#include "indent.h"
#include "commands.h"
#include "macterm.h"
#endif
+#ifdef HAVE_WINDOW_SYSTEM
+#ifdef USE_FONT_BACKEND
+#include "font.h"
+#endif /* USE_FONT_BACKEND */
+#endif /* HAVE_WINDOW_SYSTEM */
+
#ifndef FRAME_X_OUTPUT
#define FRAME_X_OUTPUT(f) ((f)->output_data.x)
#endif
static enum prop_handled handle_composition_prop P_ ((struct it *));
static enum prop_handled handle_overlay_change P_ ((struct it *));
static enum prop_handled handle_fontified_prop P_ ((struct it *));
+static enum prop_handled handle_auto_composed_prop P_ ((struct it *));
/* Properties handled by iterators. */
{&Qface, FACE_PROP_IDX, handle_face_prop},
{&Qdisplay, DISPLAY_PROP_IDX, handle_display_prop},
{&Qinvisible, INVISIBLE_PROP_IDX, handle_invisible_prop},
+ {&Qauto_composed, AUTO_COMPOSED_PROP_IDX, handle_auto_composed_prop},
{&Qcomposition, COMPOSITION_PROP_IDX, handle_composition_prop},
{NULL, 0, NULL}
};
}
}
+ if (s->row->clip)
+ {
+ XRectangle r_save = r;
+
+ if (! x_intersect_rectangles (&r_save, s->row->clip, &r))
+ r.width = 0;
+ }
+
if ((s->for_overlaps & OVERLAPS_BOTH) == 0
|| ((s->for_overlaps & OVERLAPS_BOTH) == OVERLAPS_BOTH && n == 1))
{
struct face *face = FACE_FROM_ID (it->f, face_id);
c = string_char_and_length (p, rest, &len);
- face_id = FACE_FOR_CHAR (it->f, face, c);
+ face_id = FACE_FOR_CHAR (it->f, face, c, CHARPOS (pos), it->string);
}
}
else
{
int c = FETCH_MULTIBYTE_CHAR (BYTEPOS (pos));
struct face *face = FACE_FROM_ID (it->f, face_id);
- face_id = FACE_FOR_CHAR (it->f, face, c);
+ face_id = FACE_FOR_CHAR (it->f, face, c, CHARPOS (pos), Qnil);
}
}
{
Lisp_Object face_name = XCAR (XCDR (XCDR (spec)));
int face_id2 = lookup_derived_face (it->f, face_name,
- 'A', FRINGE_FACE_ID, 0);
+ FRINGE_FACE_ID, 0);
if (face_id2 >= 0)
face_id = face_id2;
}
`composition' property
***********************************************************************/
+static enum prop_handled
+handle_auto_composed_prop (it)
+ struct it *it;
+{
+ enum prop_handled handled = HANDLED_NORMALLY;
+
+ if (FUNCTIONP (Vauto_composition_function))
+ {
+ Lisp_Object val = Qnil;
+ EMACS_INT pos, limit = -1;
+
+ if (STRINGP (it->string))
+ pos = IT_STRING_CHARPOS (*it);
+ else
+ pos = IT_CHARPOS (*it);
+
+ val = Fget_text_property (make_number (pos), Qauto_composed, it->string);
+ if (! NILP (val))
+ {
+ Lisp_Object cmp_prop;
+ EMACS_INT cmp_start, cmp_end;
+
+#ifdef USE_FONT_BACKEND
+ if (enable_font_backend
+ && get_property_and_range (pos, Qcomposition, &cmp_prop,
+ &cmp_start, &cmp_end, it->string)
+ && cmp_start == pos
+ && COMPOSITION_METHOD (cmp_prop) == COMPOSITION_WITH_GLYPH_STRING)
+ {
+ Lisp_Object gstring = COMPOSITION_COMPONENTS (cmp_prop);
+ Lisp_Object font_object = LGSTRING_FONT (gstring);
+
+ if (! EQ (font_object,
+ font_at (-1, pos, FACE_FROM_ID (it->f, it->face_id),
+ it->w, it->string)))
+ /* We must re-compute the composition for the
+ different font. */
+ val = Qnil;
+ }
+#endif
+ if (! NILP (val))
+ {
+ Lisp_Object end;
+
+ /* As Fnext_single_char_property_change is very slow, we
+ limit the search to the current line. */
+ if (STRINGP (it->string))
+ limit = SCHARS (it->string);
+ else
+ limit = find_next_newline_no_quit (pos, 1);
+ end = Fnext_single_char_property_change (make_number (pos),
+ Qauto_composed,
+ it->string,
+ make_number (limit));
+
+ if (XINT (end) < limit)
+ /* The current point is auto-composed, but there exist
+ characters not yet composed beyond the
+ auto-composed region. There's a possiblity that
+ the last characters in the region may be newly
+ composed. */
+ val = Qnil;
+ }
+ }
+ if (NILP (val))
+ {
+ if (limit < 0)
+ limit = (STRINGP (it->string) ? SCHARS (it->string)
+ : find_next_newline_no_quit (pos, 1));
+ if (pos < limit)
+ {
+ int count = SPECPDL_INDEX ();
+ Lisp_Object args[5];
+
+ args[0] = Vauto_composition_function;
+ specbind (Qauto_composition_function, Qnil);
+ args[1] = make_number (pos);
+ args[2] = make_number (limit);
+#ifdef USE_FONT_BACKEND
+ if (enable_font_backend)
+ args[3] = it->window;
+ else
+#endif /* USE_FONT_BACKEND */
+ args[3] = Qnil;
+ args[4] = it->string;
+ safe_call (5, args);
+ unbind_to (count, Qnil);
+ }
+ }
+ }
+
+ return handled;
+}
+
/* Set up iterator IT from `composition' property at its current
position. Called from handle_stop. */
struct it *it;
{
Lisp_Object prop, string;
- int pos, pos_byte, end;
+ EMACS_INT pos, pos_byte, start, end;
enum prop_handled handled = HANDLED_NORMALLY;
if (STRINGP (it->string))
/* If there's a valid composition and point is not inside of the
composition (in the case that the composition is from the current
buffer), draw a glyph composed from the composition components. */
- if (find_composition (pos, -1, &pos, &end, &prop, string)
- && COMPOSITION_VALID_P (pos, end, prop)
- && (STRINGP (it->string) || (PT <= pos || PT >= end)))
+ if (find_composition (pos, -1, &start, &end, &prop, string)
+ && COMPOSITION_VALID_P (start, end, prop)
+ && (STRINGP (it->string) || (PT <= start || PT >= end)))
{
- int id = get_composition_id (pos, pos_byte, end - pos, prop, string);
+ int id;
+
+ if (start != pos)
+ {
+ if (STRINGP (it->string))
+ pos_byte = string_char_to_byte (it->string, start);
+ else
+ pos_byte = CHAR_TO_BYTE (start);
+ }
+ id = get_composition_id (start, pos_byte, end - start, prop, string);
if (id >= 0)
{
it->method = GET_FROM_COMPOSITION;
it->cmp_id = id;
it->cmp_len = COMPOSITION_LENGTH (prop);
- /* For a terminal, draw only the first character of the
- components. */
- it->c = COMPOSITION_GLYPH (composition_table[id], 0);
+ /* For a terminal, draw only the first (non-TAB) character
+ of the components. */
+#ifdef USE_FONT_BACKEND
+ if (composition_table[id]->method == COMPOSITION_WITH_GLYPH_STRING)
+ {
+ Lisp_Object lgstring = AREF (XHASH_TABLE (composition_hash_table)
+ ->key_and_value,
+ cmp->hash_index * 2);
+
+ it->c = LGLYPH_CHAR (LGSTRING_GLYPH (lgstring, 0));
+ }
+ else
+#endif /* USE_FONT_BACKEND */
+ {
+ int i;
+
+ for (i = 0; i < cmp->glyph_len; i++)
+ if ((it->c = COMPOSITION_GLYPH (composition_table[id], i))
+ != '\t')
+ break;
+ }
+ if (it->c == '\t')
+ it->c = ' ';
it->len = (STRINGP (it->string)
? string_char_to_byte (it->string, end)
: CHAR_TO_BYTE (end)) - pos_byte;
{
struct it it2;
int pos;
- int beg, end;
+ EMACS_INT beg, end;
Lisp_Object val, overlay;
/* If newline is part of a composition, continue from start of composition */
the translation. This could easily be changed but I
don't believe that it is worth doing.
- If it->multibyte_p is nonzero, eight-bit characters and
- non-printable multibyte characters are also translated to
- octal form.
+ If it->multibyte_p is nonzero, non-printable non-ASCII
+ characters are also translated to octal form.
If it->multibyte_p is zero, eight-bit characters that
don't have corresponding multibyte char code are also
translated to octal form. */
else if ((it->c < ' '
- && (it->area != TEXT_AREA
- /* In mode line, treat \n like other crl chars. */
- || (it->c != '\t'
- && it->glyph_row && it->glyph_row->mode_line_p)
- || (it->c != '\n' && it->c != '\t')))
- || (it->multibyte_p
- ? ((it->c >= 127
- && it->len == 1)
- || !CHAR_PRINTABLE_P (it->c)
+ ? (it->area != TEXT_AREA
+ /* In mode line, treat \n, \t like other crl chars. */
+ || (it->c != '\t'
+ && it->glyph_row && it->glyph_row->mode_line_p)
+ || (it->c != '\n' && it->c != '\t'))
+ : (it->multibyte_p
+ ? (!CHAR_PRINTABLE_P (it->c)
|| (!NILP (Vnobreak_char_display)
- && (it->c == 0x8a0 || it->c == 0x8ad
- || it->c == 0x920 || it->c == 0x92d
- || it->c == 0xe20 || it->c == 0xe2d
- || it->c == 0xf20 || it->c == 0xf2d)))
+ && (it->c == 0xA0 /* NO-BREAK SPACE */
+ || it->c == 0xAD /* SOFT HYPHEN */)))
: (it->c >= 127
- && (!unibyte_display_via_language_environment
- || it->c == unibyte_char_to_multibyte (it->c)))))
+ && (! unibyte_display_via_language_environment
+ || (UNIBYTE_CHAR_HAS_MULTIBYTE_P (it->c)))))))
{
/* IT->c is a control character which must be displayed
either as '\003' or as `^C' where the '\\' and '^'
highlighting. */
if (EQ (Vnobreak_char_display, Qt)
- && (it->c == 0x8a0 || it->c == 0x920
- || it->c == 0xe20 || it->c == 0xf20))
+ && it->c == 0xA0)
{
/* Merge the no-break-space face into the current face. */
face_id = merge_faces (it->f, Qnobreak_space, 0,
highlighting. */
if (EQ (Vnobreak_char_display, Qt)
- && (it->c == 0x8ad || it->c == 0x92d
- || it->c == 0xe2d || it->c == 0xf2d))
+ && it->c == 0xAD)
{
g = it->c = '-';
XSETINT (it->ctl_chars[0], g);
/* Handle non-break space and soft hyphen
with the escape glyph. */
- if (it->c == 0x8a0 || it->c == 0x8ad
- || it->c == 0x920 || it->c == 0x92d
- || it->c == 0xe20 || it->c == 0xe2d
- || it->c == 0xf20 || it->c == 0xf2d)
+ if (it->c == 0xA0 || it->c == 0xAD)
{
XSETINT (it->ctl_chars[0], escape_glyph);
- g = it->c = ((it->c & 0xf) == 0 ? ' ' : '-');
+ g = it->c = (it->c == 0xA0 ? ' ' : '-');
XSETINT (it->ctl_chars[1], g);
ctl_len = 2;
goto display_control;
int i;
/* Set IT->ctl_chars[0] to the glyph for `\\'. */
- if (SINGLE_BYTE_CHAR_P (it->c))
- str[0] = it->c, len = 1;
+ if (CHAR_BYTE8_P (it->c))
+ {
+ str[0] = CHAR_TO_BYTE8 (it->c);
+ len = 1;
+ }
+ else if (it->c < 256)
+ {
+ str[0] = it->c;
+ len = 1;
+ }
else
{
- len = CHAR_STRING_NO_SIGNAL (it->c, str);
- if (len < 0)
- {
- /* It's an invalid character, which shouldn't
- happen actually, but due to bugs it may
- happen. Let's print the char as is, there's
- not much meaningful we can do with it. */
- str[0] = it->c;
- str[1] = it->c >> 8;
- str[2] = it->c >> 16;
- str[3] = it->c >> 24;
- len = 4;
- }
+ /* It's an invalid character, which shouldn't
+ happen actually, but due to bugs it may
+ happen. Let's print the char as is, there's
+ not much meaningful we can do with it. */
+ str[0] = it->c;
+ str[1] = it->c >> 8;
+ str[2] = it->c >> 16;
+ str[3] = it->c >> 24;
+ len = 4;
}
for (i = 0; i < len; i++)
goto get_next;
}
}
+ }
- /* Adjust face id for a multibyte character. There are no
- multibyte character in unibyte text. */
- if (it->multibyte_p
- && success_p
- && FRAME_WINDOW_P (it->f))
- {
- struct face *face = FACE_FROM_ID (it->f, it->face_id);
- it->face_id = FACE_FOR_CHAR (it->f, face, it->c);
- }
+ /* Adjust face id for a multibyte character. There are no multibyte
+ character in unibyte text. */
+ if ((it->what == IT_CHARACTER || it->what == IT_COMPOSITION)
+ && it->multibyte_p
+ && success_p
+ && FRAME_WINDOW_P (it->f))
+ {
+ struct face *face = FACE_FROM_ID (it->f, it->face_id);
+ int pos = (it->s ? -1
+ : STRINGP (it->string) ? IT_STRING_CHARPOS (*it)
+ : IT_CHARPOS (*it));
+
+ it->face_id = FACE_FOR_CHAR (it->f, face, it->c, pos, it->string);
}
/* Is this character the last one of a run of characters with
the line. */
if (skip == MOVE_X_REACHED)
{
+ /* Wait! We can conclude that TO_Y is in the line if
+ the already scanned glyphs make the line tall enough
+ because further scanning doesn't make it shorter. */
+ line_height = it->max_ascent + it->max_descent;
+ if (to_y >= it->current_y
+ && to_y < it->current_y + line_height)
+ {
+ reached = 6;
+ break;
+ }
it_backup = *it;
TRACE_MOVE ((stderr, "move_it: from %d\n", IT_CHARPOS (*it)));
skip2 = move_it_in_display_line_to (it, to_charpos, -1,
for (i = 0; i < nbytes; i += char_bytes)
{
c = string_char_and_length (m + i, nbytes - i, &char_bytes);
- work[0] = (SINGLE_BYTE_CHAR_P (c)
+ work[0] = (ASCII_CHAR_P (c)
? c
: multibyte_char_to_unibyte (c, Qnil));
insert_1_both (work, 1, 1, 1, 0, 0);
for the *Message* buffer. */
for (i = 0; i < nbytes; i++)
{
- c = unibyte_char_to_multibyte (msg[i]);
+ c = msg[i];
+ c = unibyte_char_to_multibyte (c);
char_bytes = CHAR_STRING (c, str);
insert_1_both (str, 1, char_bytes, 1, 0, 0);
}
for (i = 0; i < nbytes; i += n)
{
c = string_char_and_length (s + i, nbytes - i, &n);
- work[0] = (SINGLE_BYTE_CHAR_P (c)
+ work[0] = (ASCII_CHAR_P (c)
? c
: multibyte_char_to_unibyte (c, Qnil));
insert_1_both (work, 1, 1, 1, 0, 0);
/* Convert a single-byte string to multibyte. */
for (i = 0; i < nbytes; i++)
{
- c = unibyte_char_to_multibyte (msg[i]);
+ c = msg[i];
+ c = unibyte_char_to_multibyte (c);
n = CHAR_STRING (c, str);
insert_1_both (str, 1, n, 1, 0, 0);
}
struct buffer *prev_buf, *buf;
int prev_pt, pt;
{
- int start, end;
+ EMACS_INT start, end;
Lisp_Object prop;
Lisp_Object buffer;
struct Lisp_Char_Table *dp;
int c;
{
- int code[4], i;
Lisp_Object val;
- if (SINGLE_BYTE_CHAR_P (c))
- return (dp->contents[c]);
-
- SPLIT_CHAR (c, code[0], code[1], code[2]);
- if (code[1] < 32)
- code[1] = -1;
- else if (code[2] < 32)
- code[2] = -1;
-
- /* Here, the possible range of code[0] (== charset ID) is
- 128..max_charset. Since the top level char table contains data
- for multibyte characters after 256th element, we must increment
- code[0] by 128 to get a correct index. */
- code[0] += 128;
- code[3] = -1; /* anchor */
-
- for (i = 0; code[i] >= 0; i++, dp = XCHAR_TABLE (val))
+ if (ASCII_CHAR_P (c))
{
- val = dp->contents[code[i]];
- if (!SUB_CHAR_TABLE_P (val))
- return (NILP (val) ? dp->defalt : val);
+ val = dp->ascii;
+ if (SUB_CHAR_TABLE_P (val))
+ val = XSUB_CHAR_TABLE (val)->contents[c];
}
+ else
+ {
+ Lisp_Object table;
- /* Here, val is a sub char table. We return the default value of
- it. */
- return (dp->defalt);
+ XSETCHAR_TABLE (table, dp);
+ val = char_table_ref (table, c);
+ }
+ if (NILP (val))
+ val = dp->defalt;
+ return val;
}
else if (it->face_before_selective_p)
it->face_id = it->saved_face_id;
face = FACE_FROM_ID (it->f, it->face_id);
- it->face_id = FACE_FOR_CHAR (it->f, face, 0);
+ it->face_id = FACE_FOR_CHAR (it->f, face, 0, -1, Qnil);
PRODUCE_GLYPHS (it);
ASCII face. This will be automatically undone the next time
get_next_display_element returns a multibyte character. Note
that the character will always be single byte in unibyte text. */
- if (!SINGLE_BYTE_CHAR_P (it->c))
+ if (!ASCII_CHAR_P (it->c))
{
- it->face_id = FACE_FOR_CHAR (f, face, 0);
+ it->face_id = FACE_FOR_CHAR (f, face, 0, -1, Qnil);
}
if (FRAME_WINDOW_P (f))
&& glyph->u.ch == ' '))
&& trailing_whitespace_p (glyph->charpos))
{
- int face_id = lookup_named_face (f, Qtrailing_whitespace, 0, 0);
+ int face_id = lookup_named_face (f, Qtrailing_whitespace, 0);
if (face_id < 0)
return;
{
if (EQ (face, Qt))
face = (EQ (window, selected_window) ? Qmode_line : Qmode_line_inactive);
- face_id = lookup_named_face (XFRAME (WINDOW_FRAME (w)), face, 0, 0);
+ face_id = lookup_named_face (XFRAME (WINDOW_FRAME (w)), face, 0);
}
if (face_id < 0)
/* The EOL conversion we are using. */
Lisp_Object eoltype;
- val = Fget (coding_system, Qcoding_system);
+ val = CODING_SYSTEM_SPEC (coding_system);
eoltype = Qnil;
if (!VECTORP (val)) /* Not yet decided. */
}
else
{
+ Lisp_Object attrs;
Lisp_Object eolvalue;
- eolvalue = Fget (coding_system, Qeol_type);
+ attrs = AREF (val, 0);
+ eolvalue = AREF (val, 2);
if (multibyte)
- *buf++ = XFASTINT (AREF (val, 1));
+ *buf++ = XFASTINT (CODING_ATTR_MNEMONIC (attrs));
if (eol_flag)
{
eoltype = eol_mnemonic_undecided;
else if (VECTORP (eolvalue)) /* Not yet decided. */
eoltype = eol_mnemonic_undecided;
- else /* INTEGERP (eolvalue) -- 0:LF, 1:CRLF, 2:CR */
- eoltype = (XFASTINT (eolvalue) == 0
+ else /* eolvalue is Qunix, Qdos, or Qmac. */
+ eoltype = (EQ (eolvalue, Qunix)
? eol_mnemonic_unix
- : (XFASTINT (eolvalue) == 1
+ : (EQ (eolvalue, Qdos) == 1
? eol_mnemonic_dos : eol_mnemonic_mac));
}
}
eol_str = SDATA (eoltype);
eol_str_len = SBYTES (eoltype);
}
- else if (INTEGERP (eoltype)
- && CHAR_VALID_P (XINT (eoltype), 0))
+ else if (CHARACTERP (eoltype))
{
unsigned char *tmp = (unsigned char *) alloca (MAX_MULTIBYTE_LENGTH);
eol_str_len = CHAR_STRING (XINT (eoltype), tmp);
{
/* No need to mention EOL here--the terminal never needs
to do EOL conversion. */
- p = decode_mode_spec_coding (FRAME_KEYBOARD_CODING (f)->symbol, p, 0);
- p = decode_mode_spec_coding (FRAME_TERMINAL_CODING (f)->symbol, p, 0);
+ p = decode_mode_spec_coding (CODING_ID_NAME
+ (FRAME_KEYBOARD_CODING (f)->id),
+ p, 0);
+ p = decode_mode_spec_coding (CODING_ID_NAME
+ (FRAME_TERMINAL_CODING (f)->id),
+ p, 0);
}
p = decode_mode_spec_coding (b->buffer_file_coding_system,
p, eol_flag);
}
break;
}
- else if (x + glyph->pixel_width > it->first_visible_x)
+ else if (x + glyph->pixel_width >= it->first_visible_x)
{
/* Glyph is at least partially visible. */
++it->hpos;
}
+/* Get face and two-byte form of character C in face FACE_ID on frame
+ F. The encoding of C is returned in *CHAR2B. MULTIBYTE_P non-zero
+ means we want to display multibyte text. DISPLAY_P non-zero means
+ make sure that X resources for the face returned are allocated.
+ Value is a pointer to a realized face that is ready for display if
+ DISPLAY_P is non-zero. */
+
+static INLINE struct face *
+get_char_face_and_encoding (f, c, face_id, char2b, multibyte_p, display_p)
+ struct frame *f;
+ int c, face_id;
+ XChar2b *char2b;
+ int multibyte_p, display_p;
+{
+ struct face *face = FACE_FROM_ID (f, face_id);
+
+#ifdef USE_FONT_BACKEND
+ if (enable_font_backend)
+ {
+ struct font *font = (struct font *) face->font_info;
+
+ if (font)
+ {
+ unsigned code = font->driver->encode_char (font, c);
+
+ if (code != FONT_INVALID_CODE)
+ STORE_XCHAR2B (char2b, (code >> 8), (code & 0xFF));
+ else
+ STORE_XCHAR2B (char2b, 0, 0);
+ }
+ }
+ else
+#endif /* USE_FONT_BACKEND */
+ if (!multibyte_p)
+ {
+ /* Unibyte case. We don't have to encode, but we have to make
+ sure to use a face suitable for unibyte. */
+ STORE_XCHAR2B (char2b, 0, c);
+ face_id = FACE_FOR_CHAR (f, face, c, -1, Qnil);
+ face = FACE_FROM_ID (f, face_id);
+ }
+ else if (c < 128)
+ {
+ /* Case of ASCII in a face known to fit ASCII. */
+ STORE_XCHAR2B (char2b, 0, c);
+ }
+ else if (face->font != NULL)
+ {
+ struct font_info *font_info
+ = FONT_INFO_FROM_ID (f, face->font_info_id);
+ struct charset *charset = CHARSET_FROM_ID (font_info->charset);
+ unsigned code = ENCODE_CHAR (charset, c);
+
+ if (CHARSET_DIMENSION (charset) == 1)
+ STORE_XCHAR2B (char2b, 0, code);
+ else
+ STORE_XCHAR2B (char2b, (code >> 8), (code & 0xFF));
+ /* Maybe encode the character in *CHAR2B. */
+ FRAME_RIF (f)->encode_char (c, char2b, font_info, charset, NULL);
+ }
+
+ /* Make sure X resources of the face are allocated. */
+#ifdef HAVE_X_WINDOWS
+ if (display_p)
+#endif
+ {
+ xassert (face != NULL);
+ PREPARE_FACE_FOR_DISPLAY (f, face);
+ }
+
+ return face;
+}
+
+
/* Get face and two-byte form of character glyph GLYPH on frame F.
The encoding of GLYPH->u.ch is returned in *CHAR2B. Value is
a pointer to a realized face that is ready for display. */
if (two_byte_p)
*two_byte_p = 0;
+#ifdef USE_FONT_BACKEND
+ if (enable_font_backend)
+ {
+ struct font *font = (struct font *) face->font_info;
+
+ if (font)
+ {
+ unsigned code = font->driver->encode_char (font, glyph->u.ch);
+
+ if (code != FONT_INVALID_CODE)
+ STORE_XCHAR2B (char2b, (code >> 8), (code & 0xFF));
+ else
+ STORE_XCHAR2B (char2b, 0, code);
+ }
+ }
+ else
+#endif /* USE_FONT_BACKEND */
if (!glyph->multibyte_p)
{
/* Unibyte case. We don't have to encode, but we have to make
}
else
{
- int c1, c2, charset;
+ struct font_info *font_info
+ = FONT_INFO_FROM_ID (f, face->font_info_id);
+ if (font_info)
+ {
+ struct charset *charset = CHARSET_FROM_ID (font_info->charset);
+ unsigned code = ENCODE_CHAR (charset, glyph->u.ch);
- /* Split characters into bytes. If c2 is -1 afterwards, C is
- really a one-byte character so that byte1 is zero. */
- SPLIT_CHAR (glyph->u.ch, charset, c1, c2);
- if (c2 > 0)
- STORE_XCHAR2B (char2b, c1, c2);
- else
- STORE_XCHAR2B (char2b, 0, c1);
+ if (CHARSET_DIMENSION (charset) == 1)
+ STORE_XCHAR2B (char2b, 0, code);
+ else
+ STORE_XCHAR2B (char2b, (code >> 8), (code & 0xFF));
- /* Maybe encode the character in *CHAR2B. */
- if (charset != CHARSET_ASCII)
- {
- struct font_info *font_info
- = FONT_INFO_FROM_ID (f, face->font_info_id);
- if (font_info)
- glyph->font_type
- = FRAME_RIF (f)->encode_char (glyph->u.ch, char2b, font_info, two_byte_p);
+ /* Maybe encode the character in *CHAR2B. */
+ if (CHARSET_ID (charset) != charset_ascii)
+ {
+ glyph->font_type
+ = FRAME_RIF (f)->encode_char (glyph->u.ch, char2b, font_info,
+ charset, two_byte_p);
+ }
}
}
/* Fill glyph string S with composition components specified by S->cmp.
- FACES is an array of faces for all components of this composition.
+ BASE_FACE is the base face of the composition.
S->gidx is the index of the first component for S.
OVERLAPS non-zero means S should draw the foreground only, and use
Value is the index of a component not in S. */
static int
-fill_composite_glyph_string (s, faces, overlaps)
+fill_composite_glyph_string (s, base_face, overlaps)
struct glyph_string *s;
- struct face **faces;
+ struct face *base_face;
int overlaps;
{
int i;
s->for_overlaps = overlaps;
- s->face = faces[s->gidx];
- s->font = s->face->font;
- s->font_info = FONT_INFO_FROM_ID (s->f, s->face->font_info_id);
+#ifdef USE_FONT_BACKEND
+ if (enable_font_backend && s->cmp->method == COMPOSITION_WITH_GLYPH_STRING)
+ {
+ Lisp_Object gstring
+ = AREF (XHASH_TABLE (composition_hash_table)->key_and_value,
+ s->cmp->hash_index * 2);
- /* For all glyphs of this composition, starting at the offset
- S->gidx, until we reach the end of the definition or encounter a
- glyph that requires the different face, add it to S. */
- ++s->nchars;
- for (i = s->gidx + 1; i < s->cmp->glyph_len && faces[i] == s->face; ++i)
- ++s->nchars;
+ s->face = base_face;
+ s->font_info = s->cmp->font;
+ s->font = s->font_info->font;
+ for (i = 0, s->nchars = 0; i < s->cmp->glyph_len; i++, s->nchars++)
+ {
+ Lisp_Object g = LGSTRING_GLYPH (gstring, i);
+ unsigned code;
+ XChar2b * store_pos;
+ if (NILP (g))
+ break;
+ code = LGLYPH_CODE (g);
+ store_pos = s->char2b + i;
+ STORE_XCHAR2B (store_pos, code >> 8, code & 0xFF);
+ }
+ s->width = s->cmp->pixel_width;
+ }
+ else
+#endif /* USE_FONT_BACKEND */
+ {
+ /* For all glyphs of this composition, starting at the offset
+ S->gidx, until we reach the end of the definition or encounter a
+ glyph that requires the different face, add it to S. */
+ struct face *face;
- /* All glyph strings for the same composition has the same width,
- i.e. the width set for the first component of the composition. */
+ s->face = NULL;
+ s->font = NULL;
+ s->font_info = NULL;
+ for (i = s->gidx; i < s->cmp->glyph_len; i++)
+ {
+ int c = COMPOSITION_GLYPH (s->cmp, i);
- s->width = s->first_glyph->pixel_width;
+ if (c != '\t')
+ {
+ int face_id = FACE_FOR_CHAR (s->f, base_face, c, -1, Qnil);
+
+ face = get_char_face_and_encoding (s->f, c, face_id,
+ s->char2b + i, 1, 1);
+ if (face)
+ {
+ if (! s->face)
+ {
+ s->face = face;
+ s->font = s->face->font;
+ s->font_info = FONT_INFO_FROM_FACE (s->f, s->face);
+ }
+ else if (s->face != face)
+ break;
+ }
+ }
+ ++s->nchars;
+ }
+
+ /* All glyph strings for the same composition has the same width,
+ i.e. the width set for the first component of the composition. */
+ s->width = s->first_glyph->pixel_width;
+ }
/* If the specified font could not be loaded, use the frame's
default font, but record the fact that we couldn't load it in
/* Adjust base line for subscript/superscript text. */
s->ybase += s->first_glyph->voffset;
- xassert (s->face && s->face->gc);
-
/* This glyph string must always be drawn with 16-bit functions. */
s->two_byte_p = 1;
}
s->font = s->face->font;
- s->font_info = FONT_INFO_FROM_ID (s->f, s->face->font_info_id);
+ s->font_info = FONT_INFO_FROM_FACE (s->f, s->face);
/* If the specified font could not be loaded, use the frame's font,
but record the fact that we couldn't load it in
face_id = glyph->face_id;
s->face = FACE_FROM_ID (s->f, face_id);
s->font = s->face->font;
- s->font_info = FONT_INFO_FROM_ID (s->f, s->face->font_info_id);
+ s->font_info = FONT_INFO_FROM_FACE (s->f, s->face);
s->width = glyph->pixel_width;
s->nchars = 1;
voffset = glyph->voffset;
return glyph - s->row->glyphs[s->area];
}
+static XCharStruct *
+get_per_char_metric (f, font, font_info, char2b, font_type)
+ struct frame *f;
+ XFontStruct *font;
+ struct font_info *font_info;
+ XChar2b *char2b;
+ int font_type;
+{
+#ifdef USE_FONT_BACKEND
+ if (enable_font_backend)
+ {
+ static XCharStruct pcm_value;
+ unsigned code = (XCHAR2B_BYTE1 (char2b) << 8) | XCHAR2B_BYTE2 (char2b);
+ struct font *fontp;
+ struct font_metrics metrics;
+
+ if (! font_info || code == FONT_INVALID_CODE)
+ return NULL;
+ fontp = (struct font *) font_info;
+ fontp->driver->text_extents (fontp, &code, 1, &metrics);
+ pcm_value.lbearing = metrics.lbearing;
+ pcm_value.rbearing = metrics.rbearing;
+ pcm_value.ascent = metrics.ascent;
+ pcm_value.descent = metrics.descent;
+ pcm_value.width = metrics.width;
+ return &pcm_value;
+ }
+#endif /* USE_FONT_BACKEND */
+ return FRAME_RIF (f)->per_char_metric (font, char2b, font_type);
+}
/* EXPORT for RIF:
Set *LEFT and *RIGHT to the left and right overhang of GLYPH on
face = get_glyph_face_and_encoding (f, glyph, &char2b, NULL);
font = face->font;
- font_info = FONT_INFO_FROM_ID (f, face->font_info_id);
+ font_info = FONT_INFO_FROM_FACE (f, face);
if (font /* ++KFS: Should this be font_info ? */
- && (pcm = FRAME_RIF (f)->per_char_metric (font, &char2b, glyph->font_type)))
+ && (pcm = get_per_char_metric (f, font, font_info, &char2b, glyph->font_type)))
{
if (pcm->rbearing > pcm->width)
*right = pcm->rbearing - pcm->width;
*left = -pcm->lbearing;
}
}
+ else if (glyph->type == COMPOSITE_GLYPH)
+ {
+ struct composition *cmp = composition_table[glyph->u.cmp_id];
+
+ *right = cmp->rbearing - cmp->pixel_width;
+ *left = - cmp->lbearing;
+ }
}
}
-/* Get face and two-byte form of character C in face FACE_ID on frame
- F. The encoding of C is returned in *CHAR2B. MULTIBYTE_P non-zero
- means we want to display multibyte text. DISPLAY_P non-zero means
- make sure that X resources for the face returned are allocated.
- Value is a pointer to a realized face that is ready for display if
- DISPLAY_P is non-zero. */
-
-static INLINE struct face *
-get_char_face_and_encoding (f, c, face_id, char2b, multibyte_p, display_p)
- struct frame *f;
- int c, face_id;
- XChar2b *char2b;
- int multibyte_p, display_p;
-{
- struct face *face = FACE_FROM_ID (f, face_id);
-
- if (!multibyte_p)
- {
- /* Unibyte case. We don't have to encode, but we have to make
- sure to use a face suitable for unibyte. */
- STORE_XCHAR2B (char2b, 0, c);
- face_id = FACE_FOR_CHAR (f, face, c);
- face = FACE_FROM_ID (f, face_id);
- }
- else if (c < 128)
- {
- /* Case of ASCII in a face known to fit ASCII. */
- STORE_XCHAR2B (char2b, 0, c);
- }
- else
- {
- int c1, c2, charset;
-
- /* Split characters into bytes. If c2 is -1 afterwards, C is
- really a one-byte character so that byte1 is zero. */
- SPLIT_CHAR (c, charset, c1, c2);
- if (c2 > 0)
- STORE_XCHAR2B (char2b, c1, c2);
- else
- STORE_XCHAR2B (char2b, 0, c1);
-
- /* Maybe encode the character in *CHAR2B. */
- if (face->font != NULL)
- {
- struct font_info *font_info
- = FONT_INFO_FROM_ID (f, face->font_info_id);
- if (font_info)
- FRAME_RIF (f)->encode_char (c, char2b, font_info, 0);
- }
- }
-
- /* Make sure X resources of the face are allocated. */
-#ifdef HAVE_X_WINDOWS
- if (display_p)
-#endif
- {
- xassert (face != NULL);
- PREPARE_FACE_FOR_DISPLAY (f, face);
- }
-
- return face;
-}
-
-
/* Set background width of glyph string S. START is the index of the
first glyph following S. LAST_X is the right-most x-position + 1
in the drawing area. */
#define BUILD_CHAR_GLYPH_STRINGS(START, END, HEAD, TAIL, HL, X, LAST_X) \
do \
{ \
- int c, face_id; \
+ int face_id; \
XChar2b *char2b; \
\
- c = (row)->glyphs[area][START].u.ch; \
face_id = (row)->glyphs[area][START].face_id; \
\
s = (struct glyph_string *) alloca (sizeof *s); \
x-position of the drawing area. */
#define BUILD_COMPOSITE_GLYPH_STRING(START, END, HEAD, TAIL, HL, X, LAST_X) \
- do { \
- int cmp_id = (row)->glyphs[area][START].u.cmp_id; \
- int face_id = (row)->glyphs[area][START].face_id; \
- struct face *base_face = FACE_FROM_ID (f, face_id); \
- struct composition *cmp = composition_table[cmp_id]; \
- int glyph_len = cmp->glyph_len; \
- XChar2b *char2b; \
- struct face **faces; \
- struct glyph_string *first_s = NULL; \
- int n; \
- \
- base_face = base_face->ascii_face; \
- char2b = (XChar2b *) alloca ((sizeof *char2b) * glyph_len); \
- faces = (struct face **) alloca ((sizeof *faces) * glyph_len); \
- /* At first, fill in `char2b' and `faces'. */ \
- for (n = 0; n < glyph_len; n++) \
- { \
- int c = COMPOSITION_GLYPH (cmp, n); \
- int this_face_id = FACE_FOR_CHAR (f, base_face, c); \
- faces[n] = FACE_FROM_ID (f, this_face_id); \
- get_char_face_and_encoding (f, c, this_face_id, \
- char2b + n, 1, 1); \
- } \
- \
- /* Make glyph_strings for each glyph sequence that is drawable by \
- the same face, and append them to HEAD/TAIL. */ \
- for (n = 0; n < cmp->glyph_len;) \
- { \
- s = (struct glyph_string *) alloca (sizeof *s); \
- INIT_GLYPH_STRING (s, char2b + n, w, row, area, START, HL); \
- append_glyph_string (&(HEAD), &(TAIL), s); \
- s->cmp = cmp; \
- s->gidx = n; \
- s->x = (X); \
- \
- if (n == 0) \
- first_s = s; \
- \
- n = fill_composite_glyph_string (s, faces, overlaps); \
- } \
- \
- ++START; \
- s = first_s; \
+ do { \
+ int face_id = (row)->glyphs[area][START].face_id; \
+ struct face *base_face = FACE_FROM_ID (f, face_id); \
+ int cmp_id = (row)->glyphs[area][START].u.cmp_id; \
+ struct composition *cmp = composition_table[cmp_id]; \
+ XChar2b *char2b; \
+ struct glyph_string *first_s; \
+ int n; \
+ \
+ char2b = (XChar2b *) alloca ((sizeof *char2b) * cmp->glyph_len); \
+ base_face = base_face->ascii_face; \
+ \
+ /* Make glyph_strings for each glyph sequence that is drawable by \
+ the same face, and append them to HEAD/TAIL. */ \
+ for (n = 0; n < cmp->glyph_len;) \
+ { \
+ s = (struct glyph_string *) alloca (sizeof *s); \
+ INIT_GLYPH_STRING (s, char2b, w, row, area, START, HL); \
+ append_glyph_string (&(HEAD), &(TAIL), s); \
+ s->cmp = cmp; \
+ s->gidx = n; \
+ s->x = (X); \
+ if (n == 0) \
+ first_s = s; \
+ n = fill_composite_glyph_string (s, base_face, overlaps); \
+ } \
+ \
+ ++START; \
+ s = first_s; \
} while (0)
abort (); \
} \
\
- set_glyph_string_background_width (s, START, LAST_X); \
- (X) += s->width; \
+ if (s) \
+ { \
+ set_glyph_string_background_width (s, START, LAST_X); \
+ (X) += s->width; \
+ } \
} \
} \
while (0)
int x;
struct glyph_row *row;
enum glyph_row_area area;
- int start, end;
+ EMACS_INT start, end;
enum draw_glyphs_face hl;
int overlaps;
{
if (i >= 0)
{
clip_tail = tail;
+ i++; /* We must include the Ith glyph. */
BUILD_GLYPH_STRINGS (end, i, h, t,
DRAW_NORMAL_TEXT, x, last_x);
for (s = h; s; s = s->next)
struct face *face;
struct font_info *font_info;
- face_id = lookup_named_face (it->f, face_name, ' ', 0);
+ face_id = lookup_named_face (it->f, face_name, 0);
if (face_id < 0)
return make_number (-1);
if (font == NULL)
return make_number (-1);
- font_info = FONT_INFO_FROM_ID (it->f, face->font_info_id);
+ font_info = FONT_INFO_FROM_FACE (it->f, face);
boff = font_info->baseline_offset;
if (font_info->vertical_centering)
boff = VCENTER_BASELINE_OFFSET (font, it->f) - boff;
/* Maybe translate single-byte characters to multibyte, or the
other way. */
it->char_to_display = it->c;
- if (!ASCII_BYTE_P (it->c))
+ if (!ASCII_BYTE_P (it->c)
+ && ! it->multibyte_p)
{
- if (unibyte_display_via_language_environment
- && SINGLE_BYTE_CHAR_P (it->c)
- && (it->c >= 0240
- || !NILP (Vnonascii_translation_table)))
- {
- it->char_to_display = unibyte_char_to_multibyte (it->c);
- it->multibyte_p = 1;
- it->face_id = FACE_FOR_CHAR (it->f, face, it->char_to_display);
- face = FACE_FROM_ID (it->f, it->face_id);
- }
- else if (!SINGLE_BYTE_CHAR_P (it->c)
- && !it->multibyte_p)
+ if (SINGLE_BYTE_CHAR_P (it->c)
+ && unibyte_display_via_language_environment)
+ it->char_to_display = unibyte_char_to_multibyte (it->c);
+ if (! SINGLE_BYTE_CHAR_P (it->char_to_display))
{
it->multibyte_p = 1;
- it->face_id = FACE_FOR_CHAR (it->f, face, it->char_to_display);
+ it->face_id = FACE_FOR_CHAR (it->f, face, it->char_to_display,
+ -1, Qnil);
face = FACE_FROM_ID (it->f, it->face_id);
}
}
}
else
{
- font_info = FONT_INFO_FROM_ID (it->f, face->font_info_id);
+ font_info = FONT_INFO_FROM_FACE (it->f, face);
boff = font_info->baseline_offset;
if (font_info->vertical_centering)
boff = VCENTER_BASELINE_OFFSET (font, it->f) - boff;
it->nglyphs = 1;
- pcm = FRAME_RIF (it->f)->per_char_metric
- (font, &char2b, FONT_TYPE_FOR_UNIBYTE (font, it->char_to_display));
+ pcm = get_per_char_metric (it->f, font, font_info, &char2b,
+ FONT_TYPE_FOR_UNIBYTE (font, it->char_to_display));
if (it->override_ascent >= 0)
{
/* If we found a font, this font should give us the right
metrics. If we didn't find a font, use the frame's
- default font and calculate the width of the character
- from the charset width; this is what old redisplay code
- did. */
+ default font and calculate the width of the character by
+ multiplying the width of font by the width of the
+ character. */
- pcm = FRAME_RIF (it->f)->per_char_metric (font, &char2b,
- FONT_TYPE_FOR_MULTIBYTE (font, it->c));
+ pcm = get_per_char_metric (it->f, font, font_info, &char2b,
+ FONT_TYPE_FOR_MULTIBYTE (font, it->c));
if (font_not_found_p || !pcm)
{
- int charset = CHAR_CHARSET (it->char_to_display);
+ int char_width = CHAR_WIDTH (it->char_to_display);
+ if (char_width == 0)
+ /* This is a non spacing character. But, as we are
+ going to display an empty box, the box must occupy
+ at least one column. */
+ char_width = 1;
it->glyph_not_available_p = 1;
- it->pixel_width = (FRAME_COLUMN_WIDTH (it->f)
- * CHARSET_WIDTH (charset));
+ it->pixel_width = FRAME_COLUMN_WIDTH (it->f) * char_width;
it->phys_ascent = FONT_BASE (font) + boff;
it->phys_descent = FONT_DESCENT (font) - boff;
}
else if (it->what == IT_COMPOSITION)
{
/* Note: A composition is represented as one glyph in the
- glyph matrix. There are no padding glyphs. */
- XChar2b char2b;
- XFontStruct *font;
+ glyph matrix. There are no padding glyphs.
+
+ Important is that pixel_width, ascent, and descent are the
+ values of what is drawn by draw_glyphs (i.e. the values of
+ the overall glyphs composed). */
struct face *face = FACE_FROM_ID (it->f, it->face_id);
- XCharStruct *pcm;
- int font_not_found_p;
- struct font_info *font_info;
int boff; /* baseline offset */
struct composition *cmp = composition_table[it->cmp_id];
+ int glyph_len = cmp->glyph_len;
+ XFontStruct *font = face->font;
- /* Maybe translate single-byte characters to multibyte. */
- it->char_to_display = it->c;
- if (unibyte_display_via_language_environment
- && SINGLE_BYTE_CHAR_P (it->c)
- && (it->c >= 0240
- || (it->c >= 0200
- && !NILP (Vnonascii_translation_table))))
- {
- it->char_to_display = unibyte_char_to_multibyte (it->c);
- }
-
- /* Get face and font to use. Encode IT->char_to_display. */
- it->face_id = FACE_FOR_CHAR (it->f, face, it->char_to_display);
- face = FACE_FROM_ID (it->f, it->face_id);
- get_char_face_and_encoding (it->f, it->char_to_display, it->face_id,
- &char2b, it->multibyte_p, 0);
- font = face->font;
+ it->nglyphs = 1;
- /* When no suitable font found, use the default font. */
- font_not_found_p = font == NULL;
- if (font_not_found_p)
+#ifdef USE_FONT_BACKEND
+ if (cmp->method == COMPOSITION_WITH_GLYPH_STRING)
{
- font = FRAME_FONT (it->f);
- boff = FRAME_BASELINE_OFFSET (it->f);
- font_info = NULL;
+ if (! cmp->font || cmp->font != font)
+ font_prepare_composition (cmp, it->f);
}
else
- {
- font_info = FONT_INFO_FROM_ID (it->f, face->font_info_id);
- boff = font_info->baseline_offset;
- if (font_info->vertical_centering)
- boff = VCENTER_BASELINE_OFFSET (font, it->f) - boff;
- }
-
- /* There are no padding glyphs, so there is only one glyph to
- produce for the composition. Important is that pixel_width,
- ascent and descent are the values of what is drawn by
- draw_glyphs (i.e. the values of the overall glyphs composed). */
- it->nglyphs = 1;
-
+#endif /* USE_FONT_BACKEND */
/* If we have not yet calculated pixel size data of glyphs of
the composition for the current face font, calculate them
now. Theoretically, we have to check all fonts for the
glyphs, but that requires much time and memory space. So,
here we check only the font of the first glyph. This leads
- to incorrect display very rarely, and C-l (recenter) can
- correct the display anyway. */
- if (cmp->font != (void *) font)
- {
- /* Ascent and descent of the font of the first character of
- this composition (adjusted by baseline offset). Ascent
- and descent of overall glyphs should not be less than
- them respectively. */
- int font_ascent = FONT_BASE (font) + boff;
- int font_descent = FONT_DESCENT (font) - boff;
+ to incorrect display, but it's very rare, and C-l (recenter)
+ can correct the display anyway. */
+ if (! cmp->font || cmp->font != font)
+ {
+ /* Ascent and descent of the font of the first character
+ of this composition (adjusted by baseline offset).
+ Ascent and descent of overall glyphs should not be less
+ than them respectively. */
+ int font_ascent, font_descent, font_height;
/* Bounding box of the overall glyphs. */
int leftmost, rightmost, lowest, highest;
+ int lbearing, rbearing;
int i, width, ascent, descent;
+ int left_padded = 0, right_padded = 0;
+ int face_id;
+ int c;
+ XChar2b char2b;
+ XCharStruct *pcm;
+ int font_not_found_p;
+ struct font_info *font_info;
+ int pos;
+
+ for (glyph_len = cmp->glyph_len; glyph_len > 0; glyph_len--)
+ if ((c = COMPOSITION_GLYPH (cmp, glyph_len - 1)) != '\t')
+ break;
+ if (glyph_len < cmp->glyph_len)
+ right_padded = 1;
+ for (i = 0; i < glyph_len; i++)
+ {
+ if ((c = COMPOSITION_GLYPH (cmp, i)) != '\t')
+ break;
+ cmp->offsets[i * 2] = cmp->offsets[i * 2 + 1] = 0;
+ }
+ if (i > 0)
+ left_padded = 1;
+
+ pos = (STRINGP (it->string) ? IT_STRING_CHARPOS (*it)
+ : IT_CHARPOS (*it));
+ /* When no suitable font found, use the default font. */
+ font_not_found_p = font == NULL;
+ if (font_not_found_p)
+ {
+ face = face->ascii_face;
+ font = face->font;
+ }
+ font_info = FONT_INFO_FROM_FACE (it->f, face);
+ boff = font_info->baseline_offset;
+ if (font_info->vertical_centering)
+ boff = VCENTER_BASELINE_OFFSET (font, it->f) - boff;
+ font_ascent = FONT_BASE (font) + boff;
+ font_descent = FONT_DESCENT (font) - boff;
+ font_height = FONT_HEIGHT (font);
cmp->font = (void *) font;
+ pcm = NULL;
+ if (! font_not_found_p)
+ {
+ get_char_face_and_encoding (it->f, c, it->face_id,
+ &char2b, it->multibyte_p, 0);
+ pcm = get_per_char_metric (it->f, font, font_info, &char2b,
+ FONT_TYPE_FOR_MULTIBYTE (font, c));
+ }
+
/* Initialize the bounding box. */
- if (font_info
- && (pcm = FRAME_RIF (it->f)->per_char_metric (font, &char2b,
- FONT_TYPE_FOR_MULTIBYTE (font, it->c))))
+ if (pcm)
{
width = pcm->width;
ascent = pcm->ascent;
descent = pcm->descent;
+ lbearing = pcm->lbearing;
+ rbearing = pcm->rbearing;
}
else
{
width = FONT_WIDTH (font);
ascent = FONT_BASE (font);
descent = FONT_DESCENT (font);
+ lbearing = 0;
+ rbearing = width;
}
rightmost = width;
+ leftmost = 0;
lowest = - descent + boff;
highest = ascent + boff;
- leftmost = 0;
- if (font_info
+ if (! font_not_found_p
&& font_info->default_ascent
&& CHAR_TABLE_P (Vuse_default_ascent)
&& !NILP (Faref (Vuse_default_ascent,
highest = font_info->default_ascent + boff;
/* Draw the first glyph at the normal position. It may be
- shifted to right later if some other glyphs are drawn at
- the left. */
- cmp->offsets[0] = 0;
- cmp->offsets[1] = boff;
+ shifted to right later if some other glyphs are drawn
+ at the left. */
+ cmp->offsets[i * 2] = 0;
+ cmp->offsets[i * 2 + 1] = boff;
+ cmp->lbearing = lbearing;
+ cmp->rbearing = rbearing;
/* Set cmp->offsets for the remaining glyphs. */
- for (i = 1; i < cmp->glyph_len; i++)
+ for (i++; i < glyph_len; i++)
{
int left, right, btm, top;
int ch = COMPOSITION_GLYPH (cmp, i);
- int face_id = FACE_FOR_CHAR (it->f, face, ch);
+ int face_id;
+ struct face *this_face;
+ int this_boff;
+
+ if (ch == '\t')
+ ch = ' ';
+ face_id = FACE_FOR_CHAR (it->f, face, ch, pos, it->string);
+ this_face = FACE_FROM_ID (it->f, face_id);
+ font = this_face->font;
- face = FACE_FROM_ID (it->f, face_id);
- get_char_face_and_encoding (it->f, ch, face->id,
- &char2b, it->multibyte_p, 0);
- font = face->font;
if (font == NULL)
- {
- font = FRAME_FONT (it->f);
- boff = FRAME_BASELINE_OFFSET (it->f);
- font_info = NULL;
- }
+ pcm = NULL;
else
{
- font_info
- = FONT_INFO_FROM_ID (it->f, face->font_info_id);
- boff = font_info->baseline_offset;
+ font_info = FONT_INFO_FROM_FACE (it->f, this_face);
+ this_boff = font_info->baseline_offset;
if (font_info->vertical_centering)
- boff = VCENTER_BASELINE_OFFSET (font, it->f) - boff;
+ this_boff = VCENTER_BASELINE_OFFSET (font, it->f) - boff;
+ get_char_face_and_encoding (it->f, ch, face_id,
+ &char2b, it->multibyte_p, 0);
+ pcm = get_per_char_metric (it->f, font, font_info, &char2b,
+ FONT_TYPE_FOR_MULTIBYTE (font,
+ ch));
}
-
- if (font_info
- && (pcm = FRAME_RIF (it->f)->per_char_metric (font, &char2b,
- FONT_TYPE_FOR_MULTIBYTE (font, ch))))
+ if (! pcm)
+ cmp->offsets[i * 2] = cmp->offsets[i * 2 + 1] = 0;
+ else
{
width = pcm->width;
ascent = pcm->ascent;
descent = pcm->descent;
- }
- else
- {
- width = FONT_WIDTH (font);
- ascent = 1;
- descent = 0;
- }
+ lbearing = pcm->lbearing;
+ rbearing = pcm->rbearing;
+ if (cmp->method != COMPOSITION_WITH_RULE_ALTCHARS)
+ {
+ /* Relative composition with or without
+ alternate chars. */
+ left = (leftmost + rightmost - width) / 2;
+ btm = - descent + boff;
+ if (font_info->relative_compose
+ && (! CHAR_TABLE_P (Vignore_relative_composition)
+ || NILP (Faref (Vignore_relative_composition,
+ make_number (ch)))))
+ {
- if (cmp->method != COMPOSITION_WITH_RULE_ALTCHARS)
- {
- /* Relative composition with or without
- alternate chars. */
- left = (leftmost + rightmost - width) / 2;
- btm = - descent + boff;
- if (font_info && font_info->relative_compose
- && (! CHAR_TABLE_P (Vignore_relative_composition)
- || NILP (Faref (Vignore_relative_composition,
- make_number (ch)))))
+ if (- descent >= font_info->relative_compose)
+ /* One extra pixel between two glyphs. */
+ btm = highest + 1;
+ else if (ascent <= 0)
+ /* One extra pixel between two glyphs. */
+ btm = lowest - 1 - ascent - descent;
+ }
+ }
+ else
{
+ /* A composition rule is specified by an integer
+ value that encodes global and new reference
+ points (GREF and NREF). GREF and NREF are
+ specified by numbers as below:
+
+ 0---1---2 -- ascent
+ | |
+ | |
+ | |
+ 9--10--11 -- center
+ | |
+ ---3---4---5--- baseline
+ | |
+ 6---7---8 -- descent
+ */
+ int rule = COMPOSITION_RULE (cmp, i);
+ int gref, nref, grefx, grefy, nrefx, nrefy, xoff, yoff;
+
+ COMPOSITION_DECODE_RULE (rule, gref, nref, xoff, yoff);
+ grefx = gref % 3, nrefx = nref % 3;
+ grefy = gref / 3, nrefy = nref / 3;
+ if (xoff)
+ xoff = font_height * (xoff - 128) / 256;
+ if (yoff)
+ yoff = font_height * (yoff - 128) / 256;
+
+ left = (leftmost
+ + grefx * (rightmost - leftmost) / 2
+ - nrefx * width / 2
+ + xoff);
+
+ btm = ((grefy == 0 ? highest
+ : grefy == 1 ? 0
+ : grefy == 2 ? lowest
+ : (highest + lowest) / 2)
+ - (nrefy == 0 ? ascent + descent
+ : nrefy == 1 ? descent - boff
+ : nrefy == 2 ? 0
+ : (ascent + descent) / 2)
+ + yoff);
+ }
+
+ cmp->offsets[i * 2] = left;
+ cmp->offsets[i * 2 + 1] = btm + descent;
- if (- descent >= font_info->relative_compose)
- /* One extra pixel between two glyphs. */
- btm = highest + 1;
- else if (ascent <= 0)
- /* One extra pixel between two glyphs. */
- btm = lowest - 1 - ascent - descent;
+ /* Update the bounding box of the overall glyphs. */
+ if (width > 0)
+ {
+ right = left + width;
+ if (left < leftmost)
+ leftmost = left;
+ if (right > rightmost)
+ rightmost = right;
}
+ top = btm + descent + ascent;
+ if (top > highest)
+ highest = top;
+ if (btm < lowest)
+ lowest = btm;
+
+ if (cmp->lbearing > left + lbearing)
+ cmp->lbearing = left + lbearing;
+ if (cmp->rbearing < left + rbearing)
+ cmp->rbearing = left + rbearing;
}
- else
- {
- /* A composition rule is specified by an integer
- value that encodes global and new reference
- points (GREF and NREF). GREF and NREF are
- specified by numbers as below:
-
- 0---1---2 -- ascent
- | |
- | |
- | |
- 9--10--11 -- center
- | |
- ---3---4---5--- baseline
- | |
- 6---7---8 -- descent
- */
- int rule = COMPOSITION_RULE (cmp, i);
- int gref, nref, grefx, grefy, nrefx, nrefy;
-
- COMPOSITION_DECODE_RULE (rule, gref, nref);
- grefx = gref % 3, nrefx = nref % 3;
- grefy = gref / 3, nrefy = nref / 3;
-
- left = (leftmost
- + grefx * (rightmost - leftmost) / 2
- - nrefx * width / 2);
- btm = ((grefy == 0 ? highest
- : grefy == 1 ? 0
- : grefy == 2 ? lowest
- : (highest + lowest) / 2)
- - (nrefy == 0 ? ascent + descent
- : nrefy == 1 ? descent - boff
- : nrefy == 2 ? 0
- : (ascent + descent) / 2));
- }
-
- cmp->offsets[i * 2] = left;
- cmp->offsets[i * 2 + 1] = btm + descent;
-
- /* Update the bounding box of the overall glyphs. */
- right = left + width;
- top = btm + descent + ascent;
- if (left < leftmost)
- leftmost = left;
- if (right > rightmost)
- rightmost = right;
- if (top > highest)
- highest = top;
- if (btm < lowest)
- lowest = btm;
}
/* If there are glyphs whose x-offsets are negative,
for (i = 0; i < cmp->glyph_len; i++)
cmp->offsets[i * 2] -= leftmost;
rightmost -= leftmost;
+ cmp->lbearing -= leftmost;
+ cmp->rbearing -= leftmost;
+ }
+
+ if (left_padded && cmp->lbearing < 0)
+ {
+ for (i = 0; i < cmp->glyph_len; i++)
+ cmp->offsets[i * 2] -= cmp->lbearing;
+ rightmost -= cmp->lbearing;
+ cmp->rbearing -= cmp->lbearing;
+ cmp->lbearing = 0;
+ }
+ if (right_padded && rightmost < cmp->rbearing)
+ {
+ rightmost = cmp->rbearing;
}
cmp->pixel_width = rightmost;
cmp->descent = font_descent;
}
+ if (it->glyph_row
+ && (cmp->lbearing < 0
+ || cmp->rbearing > cmp->pixel_width))
+ it->glyph_row->contains_overlapping_glyphs_p = 1;
+
it->pixel_width = cmp->pixel_width;
it->ascent = it->phys_ascent = cmp->ascent;
it->descent = it->phys_descent = cmp->descent;
int line_height, shift_by_width, shifted_region_width;
struct glyph_row *row;
struct glyph *glyph;
- int frame_x, frame_y, hpos;
+ int frame_x, frame_y;
+ EMACS_INT hpos;
xassert (updated_window && updated_row);
BLOCK_INPUT;
static int
fast_find_position (w, charpos, hpos, vpos, x, y, stop)
struct window *w;
- int charpos;
+ EMACS_INT charpos;
int *hpos, *vpos, *x, *y;
Lisp_Object stop;
{
static int
fast_find_position (w, pos, hpos, vpos, x, y, stop)
struct window *w;
- int pos;
+ EMACS_INT pos;
int *hpos, *vpos, *x, *y;
Lisp_Object stop;
{
static int
fast_find_string_pos (w, pos, object, hpos, vpos, x, y, right_p)
struct window *w;
- int pos;
+ EMACS_INT pos;
Lisp_Object object;
int *hpos, *vpos, *x, *y;
int right_p;
LAST_OVERLAPPING_ROW is the last such row. */
static void
-expose_overlaps (w, first_overlapping_row, last_overlapping_row)
+expose_overlaps (w, first_overlapping_row, last_overlapping_row, r)
struct window *w;
struct glyph_row *first_overlapping_row;
struct glyph_row *last_overlapping_row;
+ XRectangle *r;
{
struct glyph_row *row;
{
xassert (row->enabled_p && !row->mode_line_p);
+ row->clip = r;
if (row->used[LEFT_MARGIN_AREA])
x_fix_overlapping_area (w, row, LEFT_MARGIN_AREA, OVERLAPS_BOTH);
if (row->used[RIGHT_MARGIN_AREA])
x_fix_overlapping_area (w, row, RIGHT_MARGIN_AREA, OVERLAPS_BOTH);
+ row->clip = NULL;
}
}
last_overlapping_row = row;
}
+ row->clip = fr;
if (expose_line (w, row, &r))
mouse_face_overwritten_p = 1;
+ row->clip = NULL;
+ }
+ else if (row->overlapping_p)
+ {
+ /* We must redraw a row overlapping the exposed area. */
+ if (y0 < r.y
+ ? y0 + row->phys_height > r.y
+ : y0 + row->ascent - row->phys_ascent < r.y +r.height)
+ {
+ if (first_overlapping_row == NULL)
+ first_overlapping_row = row;
+ last_overlapping_row = row;
+ }
}
if (y1 >= yb)
{
/* Fix the display of overlapping rows. */
if (first_overlapping_row)
- expose_overlaps (w, first_overlapping_row, last_overlapping_row);
+ expose_overlaps (w, first_overlapping_row, last_overlapping_row,
+ fr);
/* Draw border between windows. */
x_draw_vertical_border (w);
/* xfaces.c -- "Face" primitives.
Copyright (C) 1993, 1994, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- 2005, 2006, 2007 Free Software Foundation, Inc.
+ 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
This file is part of GNU Emacs.
13. Whether or not a box should be drawn around characters, the box
type, and, for simple boxes, in what color.
- 14. Font or fontset pattern, or nil. This is a special attribute.
+ 14. Font pattern, or nil. This is a special attribute.
When this attribute is specified, the face uses a font opened by
that pattern as is. In addition, all the other font-related
attributes (1st thru 5th) are generated from the opened font name.
and is used to ensure that a font specified on the command line,
for example, can be matched exactly.
+ 17. A fontset name.
+
Faces are frame-local by nature because Emacs allows to define the
same named face (face names are symbols) differently for different
frames. Each frame has an alist of face definitions for all named
is realized, it inherits (thus shares) a fontset of an ASCII face
that has the same attributes other than font-related ones.
- Thus, all realized face have a realized fontset.
+ Thus, all realized faces have a realized fontset.
Unibyte text.
#include <stdio.h> /* This needs to be before termchar.h */
#include "lisp.h"
+#include "character.h"
#include "charset.h"
#include "keyboard.h"
#include "frame.h"
#include "intervals.h"
#include "termchar.h"
+#ifdef HAVE_WINDOW_SYSTEM
+#include "font.h"
+#endif /* HAVE_WINDOW_SYSTEM */
+
#ifdef HAVE_X_WINDOWS
/* Compensate for a bug in Xos.h on some systems, on which it requires
Lisp_Object QCwidth, QCfont, QCbold, QCitalic;
Lisp_Object QCreverse_video;
Lisp_Object QCoverline, QCstrike_through, QCbox, QCinherit;
+Lisp_Object QCfontset;
/* Symbols used for attribute values. */
static int load_pixmap P_ ((struct frame *, Lisp_Object, unsigned *, unsigned *));
static unsigned char *xstrlwr P_ ((unsigned char *));
static struct frame *frame_or_selected_frame P_ ((Lisp_Object, int));
-static void load_face_font P_ ((struct frame *, struct face *, int));
+static void load_face_font P_ ((struct frame *, struct face *));
static void load_face_colors P_ ((struct frame *, struct face *, Lisp_Object *));
static void free_face_colors P_ ((struct frame *, struct face *));
static int face_color_gray_p P_ ((struct frame *, char *));
Lisp_Object, struct font_name **));
static int font_list P_ ((struct frame *, Lisp_Object, Lisp_Object,
Lisp_Object, struct font_name **));
-static int try_font_list P_ ((struct frame *, Lisp_Object *,
- Lisp_Object, Lisp_Object, struct font_name **,
- int));
+static int try_font_list P_ ((struct frame *, Lisp_Object,
+ Lisp_Object, Lisp_Object, struct font_name **));
static int try_alternative_families P_ ((struct frame *f, Lisp_Object,
Lisp_Object, struct font_name **));
static int cmp_font_names P_ ((const void *, const void *));
-static struct face *realize_face P_ ((struct face_cache *, Lisp_Object *, int,
- struct face *, int));
-static struct face *realize_x_face P_ ((struct face_cache *,
- Lisp_Object *, int, struct face *));
-static struct face *realize_tty_face P_ ((struct face_cache *,
- Lisp_Object *, int));
+static struct face *realize_face P_ ((struct face_cache *, Lisp_Object *,
+ int));
+static struct face *realize_non_ascii_face P_ ((struct frame *, int,
+ struct face *));
+static struct face *realize_x_face P_ ((struct face_cache *, Lisp_Object *));
+static struct face *realize_tty_face P_ ((struct face_cache *, Lisp_Object *));
static int realize_basic_faces P_ ((struct frame *));
static int realize_default_face P_ ((struct frame *));
static void realize_named_face P_ ((struct frame *, Lisp_Object, int));
static unsigned lface_hash P_ ((Lisp_Object *));
static int lface_same_font_attributes_p P_ ((Lisp_Object *, Lisp_Object *));
static struct face_cache *make_face_cache P_ ((struct frame *));
-static void free_realized_face P_ ((struct frame *, struct face *));
static void clear_face_gcs P_ ((struct face_cache *));
static void free_face_cache P_ ((struct face_cache *));
static int face_numeric_weight P_ ((Lisp_Object));
static int face_numeric_slant P_ ((Lisp_Object));
static int face_numeric_swidth P_ ((Lisp_Object));
static int face_fontset P_ ((Lisp_Object *));
-static char *choose_face_font P_ ((struct frame *, Lisp_Object *, int, int, int*));
static void merge_face_vectors P_ ((struct frame *, Lisp_Object *, Lisp_Object*,
struct named_merge_point *));
static int merge_face_ref P_ ((struct frame *, Lisp_Object, Lisp_Object *,
int, struct named_merge_point *));
static int set_lface_from_font_name P_ ((struct frame *, Lisp_Object,
Lisp_Object, int, int));
+static void set_lface_from_font_and_fontset P_ ((struct frame *, Lisp_Object,
+ Lisp_Object, int, int));
static Lisp_Object lface_from_face_name P_ ((struct frame *, Lisp_Object, int));
static struct face *make_realized_face P_ ((Lisp_Object *));
-static void free_realized_faces P_ ((struct face_cache *));
static char *best_matching_font P_ ((struct frame *, Lisp_Object *,
struct font_name *, int, int, int *));
static void cache_face P_ ((struct face_cache *, struct face *, unsigned));
{
struct x_display_info *dpyinfo;
+#ifdef USE_FONT_BACKEND
+ if (! enable_font_backend)
+#endif /* USE_FONT_BACKEND */
/* Fonts are common for frames on one display, i.e. on
one X screen. */
for (dpyinfo = x_display_list; dpyinfo; dpyinfo = dpyinfo->next)
#ifdef HAVE_WINDOW_SYSTEM
-/* Load font of face FACE which is used on frame F to display
- character C. The name of the font to load is determined by lface
- and fontset of FACE. */
+/* Load font of face FACE which is used on frame F to display ASCII
+ characters. The name of the font to load is determined by lface. */
static void
-load_face_font (f, face, c)
+load_face_font (f, face)
struct frame *f;
struct face *face;
- int c;
{
struct font_info *font_info = NULL;
char *font_name;
int needs_overstrike;
+#ifdef USE_FONT_BACKEND
+ if (enable_font_backend)
+ abort ();
+#endif /* USE_FONT_BACKEND */
face->font_info_id = -1;
face->font = NULL;
+ face->font_name = NULL;
- font_name = choose_face_font (f, face->lface, face->fontset, c,
- &needs_overstrike);
+ font_name = choose_face_font (f, face->lface, Qnil, &needs_overstrike);
if (!font_name)
return;
BLOCK_INPUT;
- font_info = FS_LOAD_FACE_FONT (f, c, font_name, face);
+ font_info = FS_LOAD_FONT (f, font_name);
UNBLOCK_INPUT;
if (font_info)
color_def->green = 0;
if (*color_name)
- status = tty_lookup_color (f, build_string (color_name), color_def, 0);
+ status = tty_lookup_color (f, build_string (color_name), color_def, NULL);
if (color_def->pixel == FACE_TTY_DEFAULT_COLOR && *color_name)
{
static INLINE int
face_numeric_value (table, dim, symbol)
struct table_entry *table;
- int dim;
+ size_t dim;
Lisp_Object symbol;
{
struct table_entry *p = face_value (table, dim, symbol);
return face_numeric_value (swidth_table, DIM (swidth_table), width);
}
-
#ifdef HAVE_WINDOW_SYSTEM
+#ifdef USE_FONT_BACKEND
+static INLINE Lisp_Object
+face_symbolic_value (table, dim, font_prop)
+ struct table_entry *table;
+ int dim;
+ Lisp_Object font_prop;
+{
+ struct table_entry *p;
+ char *s = SDATA (SYMBOL_NAME (font_prop));
+ int low, mid, high, cmp;
+
+ low = 0;
+ high = dim - 1;
+
+ while (low <= high)
+ {
+ mid = (low + high) / 2;
+ cmp = strcmp (table[mid].name, s);
+
+ if (cmp < 0)
+ low = mid + 1;
+ else if (cmp > 0)
+ high = mid - 1;
+ else
+ return *table[mid].symbol;
+ }
+
+ return Qnil;
+}
+
+static INLINE Lisp_Object
+face_symbolic_weight (weight)
+ Lisp_Object weight;
+{
+ return face_symbolic_value (weight_table, DIM (weight_table), weight);
+}
+
+static INLINE Lisp_Object
+face_symbolic_slant (slant)
+ Lisp_Object slant;
+{
+ return face_symbolic_value (slant_table, DIM (slant_table), slant);
+}
+
+static INLINE Lisp_Object
+face_symbolic_swidth (width)
+ Lisp_Object width;
+{
+ return face_symbolic_value (swidth_table, DIM (swidth_table), width);
+}
+#endif /* USE_FONT_BACKEND */
+
+Lisp_Object
+split_font_name_into_vector (fontname)
+ Lisp_Object fontname;
+{
+ struct font_name font;
+ Lisp_Object vec;
+ int i;
+
+ font.name = LSTRDUPA (fontname);
+ if (! split_font_name (NULL, &font, 0))
+ return Qnil;
+ vec = Fmake_vector (make_number (XLFD_LAST), Qnil);
+ for (i = 0; i < XLFD_LAST; i++)
+ if (font.fields[i][0] != '*')
+ ASET (vec, i, build_string (font.fields[i]));
+ return vec;
+}
+
+Lisp_Object
+build_font_name_from_vector (vec)
+ Lisp_Object vec;
+{
+ struct font_name font;
+ Lisp_Object fontname;
+ char *p;
+ int i;
+
+ for (i = 0; i < XLFD_LAST; i++)
+ {
+ font.fields[i] = (NILP (AREF (vec, i))
+ ? "*" : (char *) SDATA (AREF (vec, i)));
+ if ((i == XLFD_FAMILY || i == XLFD_REGISTRY)
+ && (p = strchr (font.fields[i], '-')))
+ {
+ char *p1 = STRDUPA (font.fields[i]);
+
+ p1[p - font.fields[i]] = '\0';
+ if (i == XLFD_FAMILY)
+ {
+ font.fields[XLFD_FOUNDRY] = p1;
+ font.fields[XLFD_FAMILY] = p + 1;
+ }
+ else
+ {
+ font.fields[XLFD_REGISTRY] = p1;
+ font.fields[XLFD_ENCODING] = p + 1;
+ break;
+ }
+ }
+ }
+
+ p = build_font_name (&font);
+ fontname = build_string (p);
+ xfree (p);
+ return fontname;
+}
+
/* Return non-zero if FONT is the name of a fixed-pitch font. */
static INLINE int
72dpi versions, only.)
Value is the real point size of FONT on frame F, or 0 if it cannot
- be determined. */
+ be determined.
+
+ By side effect, set FONT->numeric[XLFD_PIXEL_SIZE]. */
static INLINE int
xlfd_point_size (f, font)
else
pixel = atoi (pixel_field);
+ font->numeric[XLFD_PIXEL_SIZE] = pixel;
if (pixel == 0)
real_pt = 0;
else
}
-/* Get a sorted list of fonts of family FAMILY on frame F. If PATTERN
- is non-nil list fonts matching that pattern. Otherwise, if
- REGISTRY is non-nil return only fonts with that registry, otherwise
- return fonts of any registry. Set *FONTS to a vector of font_name
- structures allocated from the heap containing the fonts found.
- Value is the number of fonts found. */
+/* Get a sorted list of fonts matching PATTERN on frame F. If PATTERN
+ is nil, list fonts matching FAMILY and REGISTRY. FAMILY is a
+ family name string or nil. REGISTRY is a registry name string.
+ Set *FONTS to a vector of font_name structures allocated from the
+ heap containing the fonts found. Value is the number of fonts
+ found. */
static int
font_list_1 (f, pattern, family, registry, fonts)
/* Get a sorted list of fonts of family FAMILY on frame F.
- If PATTERN is non-nil list fonts matching that pattern.
+ If PATTERN is non-nil, list fonts matching that pattern.
- If REGISTRY is non-nil, return fonts with that registry and the
- alternative registries from Vface_alternative_font_registry_alist.
+ If REGISTRY is non-nil, it is a list of registry (and encoding)
+ names. Return fonts with those registries and the alternative
+ registries from Vface_alternative_font_registry_alist.
If REGISTRY is nil return fonts of any registry.
Lisp_Object pattern, family, registry;
struct font_name **fonts;
{
- int nfonts = font_list_1 (f, pattern, family, registry, fonts);
+ int nfonts;
+ int reg_prio;
+ int i;
+
+ if (NILP (registry))
+ return font_list_1 (f, pattern, family, registry, fonts);
- if (!NILP (registry)
- && CONSP (Vface_alternative_font_registry_alist))
+ for (reg_prio = 0, nfonts = 0; CONSP (registry); registry = XCDR (registry))
{
- Lisp_Object alter;
+ Lisp_Object elt, alter;
+ int nfonts2;
+ struct font_name *fonts2;
- alter = Fassoc (registry, Vface_alternative_font_registry_alist);
- if (CONSP (alter))
+ elt = XCAR (registry);
+ alter = Fassoc (elt, Vface_alternative_font_registry_alist);
+ if (NILP (alter))
+ alter = Fcons (elt, Qnil);
+ for (; CONSP (alter); alter = XCDR (alter), reg_prio++)
{
- int reg_prio, i;
-
- for (alter = XCDR (alter), reg_prio = 1;
- CONSP (alter);
- alter = XCDR (alter), reg_prio++)
- if (STRINGP (XCAR (alter)))
- {
- int nfonts2;
- struct font_name *fonts2;
-
- nfonts2 = font_list_1 (f, pattern, family, XCAR (alter),
- &fonts2);
+ nfonts2 = font_list_1 (f, pattern, family, XCAR (alter), &fonts2);
+ if (nfonts2 > 0)
+ {
+ if (reg_prio > 0)
for (i = 0; i < nfonts2; i++)
fonts2[i].registry_priority = reg_prio;
- *fonts = (nfonts > 0
- ? concat_font_list (*fonts, nfonts, fonts2, nfonts2)
- : fonts2);
- nfonts += nfonts2;
- }
+ if (nfonts > 0)
+ *fonts = concat_font_list (*fonts, nfonts, fonts2, nfonts2);
+ else
+ *fonts = fonts2;
+ nfonts += nfonts2;
+ }
}
}
{
/* This is of limited utility since it works with character
widths. Keep it for compatibility. --gerd. */
- int face_id = lookup_named_face (f, face, 0, 0);
+ int face_id = lookup_named_face (f, face, 0);
struct face *face = (face_id < 0
? NULL
: FACE_FROM_ID (f, face_id));
-#ifdef WINDOWSNT
-/* For historic reasons, FONT_WIDTH refers to average width on W32,
- not maximum as on X. Redefine here. */
-#undef FONT_WIDTH
-#define FONT_WIDTH FONT_MAX_WIDTH
-#endif
-
if (face && face->font)
size = FONT_WIDTH (face->font);
else
#define LFACE_FONT(LFACE) AREF ((LFACE), LFACE_FONT_INDEX)
#define LFACE_INHERIT(LFACE) AREF ((LFACE), LFACE_INHERIT_INDEX)
#define LFACE_AVGWIDTH(LFACE) AREF ((LFACE), LFACE_AVGWIDTH_INDEX)
+#define LFACE_FONTSET(LFACE) AREF ((LFACE), LFACE_FONTSET_INDEX)
/* Non-zero if LFACE is a Lisp face. A Lisp face is a vector of size
LFACE_VECTOR_SIZE which has the symbol `face' in slot 0. */
xassert (UNSPECIFIEDP (attrs[LFACE_FONT_INDEX])
|| IGNORE_DEFFACE_P (attrs[LFACE_FONT_INDEX])
|| NILP (attrs[LFACE_FONT_INDEX])
+#ifdef USE_FONT_BACKEND
+ || FONT_OBJECT_P (attrs[LFACE_FONT_INDEX])
+#endif /* USE_FONT_BACKEND */
|| STRINGP (attrs[LFACE_FONT_INDEX]));
+ xassert (UNSPECIFIEDP (attrs[LFACE_FONTSET_INDEX])
+ || STRINGP (attrs[LFACE_FONTSET_INDEX]));
#endif
}
for (i = 1; i < LFACE_VECTOR_SIZE; ++i)
if (i != LFACE_FONT_INDEX && i != LFACE_INHERIT_INDEX
- && i != LFACE_AVGWIDTH_INDEX)
+ && i != LFACE_AVGWIDTH_INDEX && i != LFACE_FONTSET_INDEX)
if ((UNSPECIFIEDP (attrs[i]) || IGNORE_DEFFACE_P (attrs[i]))
#ifdef MAC_OS
/* MAC_TODO: No stipple support on Mac OS yet, this index is
/* If FONTNAME is actually a fontset name, get ASCII font name of it. */
fontset = fs_query_fontset (fontname, 0);
- if (fontset >= 0)
+
+ if (fontset > 0)
font_name = SDATA (fontset_ascii (fontset));
+ else if (fontset == 0)
+ {
+ if (may_fail_p)
+ return 0;
+ abort ();
+ }
/* Check if FONT_NAME is surely available on the system. Usually
FONT_NAME is already cached for the frame F and FS_LOAD_FONT
caching it now is not futail because we anyway load the font
later. */
BLOCK_INPUT;
- font_info = FS_LOAD_FONT (f, 0, font_name, -1);
+ font_info = FS_LOAD_FONT (f, font_name);
UNBLOCK_INPUT;
if (!font_info)
LFACE_SLANT (lface)
= have_xlfd_p ? xlfd_symbolic_slant (&font) : Qnormal;
- LFACE_FONT (lface) = fontname;
-
+ if (fontset > 0)
+ {
+ LFACE_FONT (lface) = build_string (font_info->full_name);
+ LFACE_FONTSET (lface) = fontset_name (fontset);
+ }
+ else
+ {
+ LFACE_FONT (lface) = fontname;
+ fontset
+ = new_fontset_from_font_name (build_string (font_info->full_name));
+ LFACE_FONTSET (lface) = fontset_name (fontset);
+ }
return 1;
}
+#ifdef USE_FONT_BACKEND
+/* Set font-related attributes of Lisp face LFACE from FONT-OBJECT and
+ FONTSET. If FORCE_P is zero, set only unspecified attributes of
+ LFACE. The exceptions are `font' and `fontset' attributes. They
+ are set regardless of FORCE_P. */
+
+static void
+set_lface_from_font_and_fontset (f, lface, font_object, fontset, force_p)
+ struct frame *f;
+ Lisp_Object lface, font_object;
+ int fontset;
+ int force_p;
+{
+ struct font *font = XSAVE_VALUE (font_object)->pointer;
+ Lisp_Object entity = font->entity;
+ Lisp_Object val;
+
+ /* Set attributes only if unspecified, otherwise face defaults for
+ new frames would never take effect. If the font doesn't have a
+ specific property, set a normal value for that. */
+
+ if (force_p || UNSPECIFIEDP (LFACE_FAMILY (lface)))
+ {
+ Lisp_Object foundry = AREF (entity, FONT_FOUNDRY_INDEX);
+ Lisp_Object family = AREF (entity, FONT_FAMILY_INDEX);
+
+ if (! NILP (foundry))
+ {
+ if (! NILP (family))
+ val = concat3 (SYMBOL_NAME (foundry), build_string ("-"),
+ SYMBOL_NAME (family));
+ else
+ val = concat2 (SYMBOL_NAME (foundry), build_string ("-*"));
+ }
+ else
+ {
+ if (! NILP (family))
+ val = SYMBOL_NAME (family);
+ else
+ val = build_string ("*");
+ }
+ LFACE_FAMILY (lface) = val;
+ }
+
+ if (force_p || UNSPECIFIEDP (LFACE_HEIGHT (lface)))
+ {
+ int pt = pixel_point_size (f, font->pixel_size * 10);
+
+ xassert (pt > 0);
+ LFACE_HEIGHT (lface) = make_number (pt);
+ }
+
+ if (force_p || UNSPECIFIEDP (LFACE_AVGWIDTH (lface)))
+ LFACE_AVGWIDTH (lface) = make_number (font->font.average_width);
+
+ if (force_p || UNSPECIFIEDP (LFACE_WEIGHT (lface)))
+ {
+ Lisp_Object weight = font_symbolic_weight (entity);
+
+ val = NILP (weight) ? Qnormal : face_symbolic_weight (weight);
+ LFACE_WEIGHT (lface) = ! NILP (val) ? val : weight;
+ }
+ if (force_p || UNSPECIFIEDP (LFACE_SLANT (lface)))
+ {
+ Lisp_Object slant = font_symbolic_slant (entity);
+
+ val = NILP (slant) ? Qnormal : face_symbolic_slant (slant);
+ LFACE_SLANT (lface) = ! NILP (val) ? val : slant;
+ }
+ if (force_p || UNSPECIFIEDP (LFACE_SWIDTH (lface)))
+ {
+ Lisp_Object width = font_symbolic_width (entity);
+
+ val = NILP (width) ? Qnormal : face_symbolic_swidth (width);
+ LFACE_SWIDTH (lface) = ! NILP (val) ? val : width;
+ }
+
+ LFACE_FONT (lface) = font_object;
+ LFACE_FONTSET (lface) = fontset_name (fontset);
+}
+#endif /* USE_FONT_BACKEND */
+
#endif /* HAVE_WINDOW_SYSTEM */
LFACE_SWIDTH (lface) = value;
font_related_attr_p = 1;
}
- else if (EQ (attr, QCfont))
+ else if (EQ (attr, QCfont) || EQ (attr, QCfontset))
{
#ifdef HAVE_WINDOW_SYSTEM
if (EQ (frame, Qt) || FRAME_WINDOW_P (XFRAME (frame)))
else
f = check_x_frame (frame);
+#ifdef USE_FONT_BACKEND
+ if (enable_font_backend
+ && !UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value))
+ {
+ int fontset;
+
+ if (EQ (attr, QCfontset))
+ {
+ Lisp_Object fontset_name = Fquery_fontset (value, Qnil);
+
+ if (NILP (fontset_name))
+ signal_error ("Invalid fontset name", value);
+ LFACE_FONTSET (lface) = value;
+ }
+ else
+ {
+ Lisp_Object font_object;
+
+ if (FONT_OBJECT_P (value))
+ {
+ font_object = value;
+ fontset = FRAME_FONTSET (f);
+ }
+ else
+ {
+ CHECK_STRING (value);
+
+ fontset = fs_query_fontset (value, 0);
+ if (fontset >= 0)
+ value = fontset_ascii (fontset);
+ else
+ fontset = FRAME_FONTSET (f);
+ font_object = font_open_by_name (f, SDATA (value));
+ if (NILP (font_object))
+ signal_error ("Invalid font", value);
+ }
+ set_lface_from_font_and_fontset (f, lface, font_object,
+ fontset, 1);
+ }
+ }
+ else
+#endif /* USE_FONT_BACKEND */
if (!UNSPECIFIEDP (value) && !IGNORE_DEFFACE_P (value))
{
CHECK_STRING (value);
tmp = Fquery_fontset (value, Qnil);
if (!NILP (tmp))
value = tmp;
+ else if (EQ (attr, QCfontset))
+ signal_error ("Invalid fontset name", value);
- if (!set_lface_from_font_name (f, lface, value, 1, 1))
- signal_error ("Invalid font or fontset name", value);
+ if (EQ (attr, QCfont))
+ {
+ if (!set_lface_from_font_name (f, lface, value, 1, 1))
+ signal_error ("Invalid font or fontset name", value);
+ }
+ else
+ LFACE_FONTSET (lface) = value;
}
font_attr_p = 1;
if (!EQ (frame, Qt)
&& NILP (Fget (face, Qface_no_inherit))
&& (EQ (attr, QCfont)
+ || EQ (attr, QCfontset)
|| NILP (Fequal (old_value, value))))
{
++face_change_count;
#ifdef HAVE_WINDOW_SYSTEM
/* Set the `font' frame parameter of FRAME determined from `default'
- face attributes LFACE. If a face or fontset name is explicitely
+ face attributes LFACE. If a font name is explicitely
specfied in LFACE, use it as is. Otherwise, determine a font name
from the other font-related atrributes of LFACE. In that case, if
there's no matching font, signals an error. */
if (STRINGP (LFACE_FONT (lface)))
font_name = LFACE_FONT (lface);
+#ifdef USE_FONT_BACKEND
+ else if (enable_font_backend)
+ {
+ /* We set FONT_NAME to a font-object. */
+ if (FONT_OBJECT_P (LFACE_FONT (lface)))
+ font_name = LFACE_FONT (lface);
+ else
+ {
+ font_name = font_find_for_lface (f, &AREF (lface, 0), Qnil, -1);
+ if (NILP (font_name))
+ error ("No font matches the specified attribute");
+ font_name = font_open_for_lface (f, font_name, &AREF (lface, 0),
+ Qnil);
+ if (NILP (font_name))
+ error ("No font matches the specified attribute");
+ }
+ }
+#endif
else
{
/* Choose a font name that reflects LFACE's attributes and has
the registry and encoding pattern specified in the default
fontset (3rd arg: -1) for ASCII characters (4th arg: 0). */
- font = choose_face_font (f, XVECTOR (lface)->contents, -1, 0, 0);
+ font = choose_face_font (f, XVECTOR (lface)->contents, Qnil, NULL);
if (!font)
error ("No font matches the specified attribute");
font_name = build_string (font);
value = LFACE_INHERIT (lface);
else if (EQ (keyword, QCfont))
value = LFACE_FONT (lface);
+ else if (EQ (keyword, QCfontset))
+ value = LFACE_FONTSET (lface);
else
signal_error ("Invalid face attribute name", keyword);
return fonts with the same size as the font of a face. This is
done in fontset.el. */
-DEFUN ("face-font", Fface_font, Sface_font, 1, 2, 0,
+DEFUN ("face-font", Fface_font, Sface_font, 1, 3, 0,
doc: /* Return the font name of face FACE, or nil if it is unspecified.
+The font name is, by default, for ASCII characters.
If the optional argument FRAME is given, report on face FACE in that frame.
If FRAME is t, report on the defaults for face FACE (for new frames).
The font default for a face is either nil, or a list
of the form (bold), (italic) or (bold italic).
-If FRAME is omitted or nil, use the selected frame. */)
- (face, frame)
- Lisp_Object face, frame;
+If FRAME is omitted or nil, use the selected frame. And, in this case,
+if the optional third argument CHARACTER is given,
+return the font name used for CHARACTER. */)
+ (face, frame, character)
+ Lisp_Object face, frame, character;
{
if (EQ (frame, Qt))
{
else
{
struct frame *f = frame_or_selected_frame (frame, 1);
- int face_id = lookup_named_face (f, face, 0, 1);
+ int face_id = lookup_named_face (f, face, 1);
struct face *face = FACE_FROM_ID (f, face_id);
- return face ? build_string (face->font_name) : Qnil;
+
+ if (! face)
+ return Qnil;
+#ifdef HAVE_WINDOW_SYSTEM
+ if (FRAME_WINDOW_P (f) && !NILP (character))
+ {
+ CHECK_CHARACTER (character);
+ face_id = FACE_FOR_CHAR (f, face, XINT (character), -1, Qnil);
+ face = FACE_FROM_ID (f, face_id);
+ return (face->font && face->font_name
+ ? build_string (face->font_name)
+ : Qnil);
+ }
+#endif
+ return build_string (face->font_name);
}
}
/* Return non-zero if LFACE1 and LFACE2 specify the same font (without
considering charsets/registries). They do if they specify the same
- family, point size, weight, width, slant, and fontset. Both LFACE1
- and LFACE2 must be fully-specified. */
+ family, point size, weight, width, slant, font, and fontset. Both
+ LFACE1 and LFACE2 must be fully-specified. */
static INLINE int
lface_same_font_attributes_p (lface1, lface2)
&& (EQ (lface1[LFACE_FONT_INDEX], lface2[LFACE_FONT_INDEX])
|| (STRINGP (lface1[LFACE_FONT_INDEX])
&& STRINGP (lface2[LFACE_FONT_INDEX])
- && xstricmp (SDATA (lface1[LFACE_FONT_INDEX]),
- SDATA (lface2[LFACE_FONT_INDEX])))));
+ && ! xstricmp (SDATA (lface1[LFACE_FONT_INDEX]),
+ SDATA (lface2[LFACE_FONT_INDEX]))))
+ && (EQ (lface1[LFACE_FONTSET_INDEX], lface2[LFACE_FONTSET_INDEX])
+ || (STRINGP (lface1[LFACE_FONTSET_INDEX])
+ && STRINGP (lface2[LFACE_FONTSET_INDEX])
+ && ! xstricmp (SDATA (lface1[LFACE_FONTSET_INDEX]),
+ SDATA (lface2[LFACE_FONTSET_INDEX]))))
+ );
}
/* Free realized face FACE, including its X resources. FACE may
be null. */
-static void
+void
free_realized_face (f, face)
struct frame *f;
struct face *face;
if (face->gc)
{
BLOCK_INPUT;
+#ifdef USE_FONT_BACKEND
+ if (enable_font_backend && face->font_info)
+ font_done_for_face (f, face);
+#endif /* USE_FONT_BACKEND */
x_free_gc (f, face->gc);
face->gc = 0;
UNBLOCK_INPUT;
}
#endif
face->gc = x_create_gc (f, mask, &xgcv);
+#ifdef USE_FONT_BACKEND
+ if (enable_font_backend && face->font)
+ font_prepare_for_face (f, face);
+#endif /* USE_FONT_BACKEND */
UNBLOCK_INPUT;
}
#endif /* HAVE_WINDOW_SYSTEM */
if (face && face->gc)
{
BLOCK_INPUT;
+#ifdef USE_FONT_BACKEND
+ if (enable_font_backend && face->font_info)
+ font_done_for_face (c->f, face);
+#endif /* USE_FONT_BACKEND */
x_free_gc (c->f, face->gc);
face->gc = 0;
UNBLOCK_INPUT;
}
-/* Free all faces realized for multibyte characters on frame F that
- has FONTSET. */
+/* Free all realized faces that are using FONTSET on frame F. */
void
-free_realized_multibyte_face (f, fontset)
+free_realized_faces_for_fontset (f, fontset)
struct frame *f;
int fontset;
{
{
face = cache->faces_by_id[i];
if (face
- && face != face->ascii_face
&& face->fontset == fontset)
{
uncache_face (cache, face);
/* Cache realized face FACE in face cache C. HASH is the hash value
- of FACE. If FACE->fontset >= 0, add the new face to the end of the
- collision list of the face hash table of C. This is done because
- otherwise lookup_face would find FACE for every character, even if
- faces with the same attributes but for specific characters exist. */
+ of FACE. If FACE is for ASCII characters (i.e. FACE->ascii_face ==
+ FACE), insert the new face to the beginning of the collision list
+ of the face hash table of C. Otherwise, add the new face to the
+ end of the collision list. This way, lookup_face can quickly find
+ that a requested face is not cached. */
static void
cache_face (c, face, hash)
face->hash = hash;
- if (face->fontset >= 0)
+ if (face->ascii_face != face)
{
struct face *last = c->buckets[i];
if (last)
/* Look up a realized face with face attributes ATTR in the face cache
- of frame F. The face will be used to display character C. Value
- is the ID of the face found. If no suitable face is found, realize
- a new one. In that case, if C is a multibyte character, BASE_FACE
- is a face that has the same attributes. */
+ of frame F. The face will be used to display ASCII characters.
+ Value is the ID of the face found. If no suitable face is found,
+ realize a new one. */
INLINE int
-lookup_face (f, attr, c, base_face)
+lookup_face (f, attr)
struct frame *f;
Lisp_Object *attr;
- int c;
- struct face *base_face;
{
struct face_cache *cache = FRAME_FACE_CACHE (f);
unsigned hash;
i = hash % FACE_CACHE_BUCKETS_SIZE;
for (face = cache->buckets[i]; face; face = face->next)
- if (face->hash == hash
- && (!FRAME_WINDOW_P (f)
- || FACE_SUITABLE_FOR_CHAR_P (face, c))
- && lface_equal_p (face->lface, attr))
- break;
+ {
+ if (face->ascii_face != face)
+ {
+ /* There's no more ASCII face. */
+ face = NULL;
+ break;
+ }
+ if (face->hash == hash
+ && lface_equal_p (face->lface, attr))
+ break;
+ }
/* If not found, realize a new face. */
if (face == NULL)
- face = realize_face (cache, attr, c, base_face, -1);
+ face = realize_face (cache, attr, -1);
#if GLYPH_DEBUG
xassert (face == FACE_FROM_ID (f, face->id));
+#endif /* GLYPH_DEBUG */
-/* When this function is called from face_for_char (in this case, C is
- a multibyte character), a fontset of a face returned by
- realize_face is not yet set, i.e. FACE_SUITABLE_FOR_CHAR_P (FACE,
- C) is not sutisfied. The fontset is set for this face by
- face_for_char later. */
-#if 0
- if (FRAME_WINDOW_P (f))
- xassert (FACE_SUITABLE_FOR_CHAR_P (face, c));
-#endif
+ return face->id;
+}
+
+#ifdef HAVE_WINDOW_SYSTEM
+/* Look up a realized face that has the same attributes as BASE_FACE
+ except for the font in the face cache of frame F. If FONT_ID is
+ not negative, it is an ID number of an already opened font that is
+ used by the face. If FONT_ID is negative, the face has no font.
+ Value is the ID of the face found. If no suitable face is found,
+ realize a new one. */
+
+int
+lookup_non_ascii_face (f, font_id, base_face)
+ struct frame *f;
+ int font_id;
+ struct face *base_face;
+{
+ struct face_cache *cache = FRAME_FACE_CACHE (f);
+ unsigned hash;
+ int i;
+ struct face *face;
+
+ xassert (cache != NULL);
+ base_face = base_face->ascii_face;
+ hash = lface_hash (base_face->lface);
+ i = hash % FACE_CACHE_BUCKETS_SIZE;
+
+ for (face = cache->buckets[i]; face; face = face->next)
+ {
+ if (face->ascii_face == face)
+ continue;
+ if (face->ascii_face == base_face
+ && face->font_info_id == font_id)
+ break;
+ }
+
+ /* If not found, realize a new face. */
+ if (face == NULL)
+ face = realize_non_ascii_face (f, font_id, base_face);
+
+#if GLYPH_DEBUG
+ xassert (face == FACE_FROM_ID (f, face->id));
#endif /* GLYPH_DEBUG */
return face->id;
}
+#ifdef USE_FONT_BACKEND
+int
+face_for_font (f, font, base_face)
+ struct frame *f;
+ struct font *font;
+ struct face *base_face;
+{
+ struct face_cache *cache = FRAME_FACE_CACHE (f);
+ unsigned hash;
+ int i;
+ struct face *face;
+
+ xassert (cache != NULL);
+ base_face = base_face->ascii_face;
+ hash = lface_hash (base_face->lface);
+ i = hash % FACE_CACHE_BUCKETS_SIZE;
+
+ for (face = cache->buckets[i]; face; face = face->next)
+ {
+ if (face->ascii_face == face)
+ continue;
+ if (face->ascii_face == base_face
+ && face->font == font->font.font
+ && face->font_info == (struct font_info *) font)
+ return face->id;
+ }
+
+ /* If not found, realize a new face. */
+ face = realize_non_ascii_face (f, -1, base_face);
+ face->font = font->font.font;
+ face->font_info = (struct font_info *) font;
+ face->font_info_id = 0;
+ face->font_name = font->font.full_name;
+ return face->id;
+}
+#endif /* USE_FONT_BACKEND */
+
+#endif /* HAVE_WINDOW_SYSTEM */
/* Return the face id of the realized face for named face SYMBOL on
- frame F suitable for displaying character C. Value is -1 if the
- face couldn't be determined, which might happen if the default face
- isn't realized and cannot be realized. */
+ frame F suitable for displaying ASCII characters. Value is -1 if
+ the face couldn't be determined, which might happen if the default
+ face isn't realized and cannot be realized. */
int
-lookup_named_face (f, symbol, c, signal_p)
+lookup_named_face (f, symbol, signal_p)
struct frame *f;
Lisp_Object symbol;
- int c;
int signal_p;
{
Lisp_Object attrs[LFACE_VECTOR_SIZE];
bcopy (default_face->lface, attrs, sizeof attrs);
merge_face_vectors (f, symbol_attrs, attrs, 0);
- return lookup_face (f, attrs, c, NULL);
+ return lookup_face (f, attrs);
}
if (lface_id >= 0 && lface_id < lface_id_to_name_size)
{
Lisp_Object face_name = lface_id_to_name[lface_id];
- face_id = lookup_named_face (f, face_name, 0, 1);
+ face_id = lookup_named_face (f, face_name, 1);
}
else
face_id = -1;
/* Look up a face for a slightly smaller/larger font. */
pt += delta;
attrs[LFACE_HEIGHT_INDEX] = make_number (pt);
- new_face_id = lookup_face (f, attrs, 0, NULL);
+ new_face_id = lookup_face (f, attrs);
new_face = FACE_FROM_ID (f, new_face_id);
/* If height changes, count that as one step. */
face = FACE_FROM_ID (f, face_id);
bcopy (face->lface, attrs, sizeof attrs);
attrs[LFACE_HEIGHT_INDEX] = make_number (height);
- face_id = lookup_face (f, attrs, 0, NULL);
+ face_id = lookup_face (f, attrs);
#endif /* HAVE_WINDOW_SYSTEM */
return face_id;
/* Return the face id of the realized face for named face SYMBOL on
- frame F suitable for displaying character C, and use attributes of
- the face FACE_ID for attributes that aren't completely specified by
- SYMBOL. This is like lookup_named_face, except that the default
- attributes come from FACE_ID, not from the default face. FACE_ID
- is assumed to be already realized. */
+ frame F suitable for displaying ASCII characters, and use
+ attributes of the face FACE_ID for attributes that aren't
+ completely specified by SYMBOL. This is like lookup_named_face,
+ except that the default attributes come from FACE_ID, not from the
+ default face. FACE_ID is assumed to be already realized. */
int
-lookup_derived_face (f, symbol, c, face_id, signal_p)
+lookup_derived_face (f, symbol, face_id, signal_p)
struct frame *f;
Lisp_Object symbol;
- int c;
int face_id;
int signal_p;
{
get_lface_attributes (f, symbol, symbol_attrs, signal_p);
bcopy (default_face->lface, attrs, sizeof attrs);
merge_face_vectors (f, symbol_attrs, attrs, 0);
- return lookup_face (f, attrs, c, default_face);
+ return lookup_face (f, attrs);
}
DEFUN ("face-attributes-as-vector", Fface_attributes_as_vector,
|| !UNSPECIFIEDP (attrs[LFACE_SWIDTH_INDEX])
|| !UNSPECIFIEDP (attrs[LFACE_AVGWIDTH_INDEX]))
{
+ int face_id;
struct face *face;
Lisp_Object merged_attrs[LFACE_VECTOR_SIZE];
merge_face_vectors (f, attrs, merged_attrs, 0);
- face = FACE_FROM_ID (f, lookup_face (f, merged_attrs, 0, 0));
+ face_id = lookup_face (f, merged_attrs);
+ face = FACE_FROM_ID (f, face_id);
if (! face)
error ("Cannot make face");
Font selection
***********************************************************************/
-DEFUN ("internal-set-font-selection-order",
+ DEFUN ("internal-set-font-selection-order",
Finternal_set_font_selection_order,
Sinternal_set_font_selection_order, 1, 1, 0,
doc: /* Set font selection order for face font selection to ORDER.
free_all_realized_faces (Qnil);
}
+#ifdef USE_FONT_BACKEND
+ font_update_sort_order (font_sort_order);
+#endif /* USE_FONT_BACKEND */
+
return Qnil;
}
double resy = FRAME_X_DISPLAY_INFO (f)->resy;
double pt;
+ if (font->numeric[XLFD_PIXEL_SIZE] != 0
+ || font->numeric[XLFD_POINT_SIZE] != 0)
+ /* This is a scalable font but is requested for a specific size.
+ We should not change that size. */
+ return build_font_name (font);
+
/* If scalable font is for a specific resolution, compute
the point size we must specify from the resolution of
the display and the specified resolution of the font. */
/* Get a list of matching fonts on frame F.
- FAMILY, if a string, specifies a font family derived from the fontset.
- It is only used if the face does not specify any family in ATTRS or
- if we cannot find any font of the face's family.
+ PATTERN, if a string, specifies a font name pattern to match while
+ ignoring FAMILY and REGISTRY.
- REGISTRY, if a string, specifies a font registry and encoding to
- match. A value of nil means include fonts of any registry and
- encoding.
+ FAMILY, if a list, specifies a list of font families to try.
- If PREFER_FACE_FAMILY is nonzero, perfer face's family to FAMILY.
- Otherwise, prefer FAMILY.
+ REGISTRY, if a list, specifies a list of font registries and
+ encodinging to try.
Return in *FONTS a pointer to a vector of font_name structures for
the fonts matched. Value is the number of fonts found. */
static int
-try_font_list (f, attrs, family, registry, fonts, prefer_face_family)
+try_font_list (f, pattern, family, registry, fonts)
struct frame *f;
- Lisp_Object *attrs;
- Lisp_Object family, registry;
+ Lisp_Object pattern, family, registry;
struct font_name **fonts;
- int prefer_face_family;
{
int nfonts = 0;
- Lisp_Object face_family = attrs[LFACE_FAMILY_INDEX];
- Lisp_Object try_family;
-
- try_family = (prefer_face_family || NILP (family)) ? face_family : family;
- if (STRINGP (try_family))
- nfonts = try_alternative_families (f, try_family, registry, fonts);
-
-#ifdef MAC_OS
- if (nfonts == 0 && STRINGP (try_family) && STRINGP (registry))
- {
- if (xstricmp (SDATA (registry), "mac-roman") == 0)
- /* When realizing the default face and a font spec does not
- matched exactly, Emacs looks for ones with the same registry
- as the default font. On the Mac, this is mac-roman, which
- does not work if the family is -etl-fixed, e.g. The
- following widens the choices and fixes that problem. */
- nfonts = try_alternative_families (f, try_family, Qnil, fonts);
- else if (SBYTES (try_family) > 0
- && SREF (try_family, SBYTES (try_family) - 1) != '*')
- /* Some Central European/Cyrillic font family names have the
- Roman counterpart name as their prefix. */
- nfonts = try_alternative_families (f, concat2 (try_family,
- build_string ("*")),
- registry, fonts);
+ if (STRINGP (pattern))
+ {
+ nfonts = font_list (f, pattern, Qnil, Qnil, fonts);
+ if (nfonts == 0 && ! EQ (Vscalable_fonts_allowed, Qt))
+ {
+ int count = SPECPDL_INDEX ();
+ specbind (Qscalable_fonts_allowed, Qt);
+ nfonts = font_list (f, pattern, Qnil, Qnil, fonts);
+ unbind_to (count, Qnil);
+ }
}
-#endif
+ else
+ {
+ Lisp_Object tail;
- if (EQ (try_family, family))
- family = face_family;
+ if (NILP (family))
+ nfonts = font_list (f, Qnil, Qnil, registry, fonts);
+ else
+ for (tail = family; ! nfonts && CONSP (tail); tail = XCDR (tail))
+ nfonts = try_alternative_families (f, XCAR (tail), registry, fonts);
- if (nfonts == 0 && STRINGP (family))
- nfonts = try_alternative_families (f, family, registry, fonts);
+ /* Try font family of the default face or "fixed". */
+ if (nfonts == 0 && !NILP (family))
+ {
+ struct face *default_face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
+ if (default_face)
+ family = default_face->lface[LFACE_FAMILY_INDEX];
+ else
+ family = build_string ("fixed");
+ nfonts = try_alternative_families (f, family, registry, fonts);
+ }
- /* Try font family of the default face or "fixed". */
- if (nfonts == 0)
- {
- struct face *default_face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
- if (default_face)
- family = default_face->lface[LFACE_FAMILY_INDEX];
- else
- family = build_string ("fixed");
- nfonts = font_list (f, Qnil, family, registry, fonts);
+ /* Try any family with the given registry. */
+ if (nfonts == 0 && !NILP (family))
+ nfonts = try_alternative_families (f, Qnil, registry, fonts);
}
- /* Try any family with the given registry. */
- if (nfonts == 0)
- nfonts = try_alternative_families (f, Qnil, registry, fonts);
-
return nfonts;
}
{
Lisp_Object name;
- name = attrs[LFACE_FONT_INDEX];
+ name = attrs[LFACE_FONTSET_INDEX];
if (!STRINGP (name))
return -1;
return fs_query_fontset (name, 0);
}
-/* Choose a name of font to use on frame F to display character C with
+/* Choose a name of font to use on frame F to display characters with
Lisp face attributes specified by ATTRS. The font name is
- determined by the font-related attributes in ATTRS and the name
- pattern for C in FONTSET. Value is the font name which is
- allocated from the heap and must be freed by the caller, or NULL if
- we can get no information about the font name of C. It is assured
- that we always get some information for a single byte
- character.
+ determined by the font-related attributes in ATTRS and FONT-SPEC
+ (if specified).
- If NEEDS_OVERSTRIKE is non-zero, a boolean is returned in it to
- indicate whether the resulting font should be drawn using overstrike
- to simulate bold-face. */
+ When we are choosing a font for ASCII characters, FONT-SPEC is
+ always nil. Otherwise FONT-SPEC is an object created by
+ `font-spec' or a string specifying a font name pattern.
-static char *
-choose_face_font (f, attrs, fontset, c, needs_overstrike)
+ If NEEDS_OVERSTRIKE is not NULL, a boolean is returned in it to
+ indicate whether the resulting font should be drawn using
+ overstrike to simulate bold-face.
+
+ Value is the font name which is allocated from the heap and must be
+ freed by the caller. */
+
+char *
+choose_face_font (f, attrs, font_spec, needs_overstrike)
struct frame *f;
Lisp_Object *attrs;
- int fontset, c;
+ Lisp_Object font_spec;
int *needs_overstrike;
{
- Lisp_Object pattern;
+ Lisp_Object pattern, family, adstyle, registry;
char *font_name = NULL;
struct font_name *fonts;
- int nfonts, width_ratio;
+ int nfonts;
if (needs_overstrike)
*needs_overstrike = 0;
- /* Get (foundry and) family name and registry (and encoding) name of
- a font for C. */
- pattern = fontset_font_pattern (f, fontset, c);
- if (NILP (pattern))
+ /* If we are choosing an ASCII font and a font name is explicitly
+ specified in ATTRS, return it. */
+ if (NILP (font_spec) && STRINGP (attrs[LFACE_FONT_INDEX]))
+ return xstrdup (SDATA (attrs[LFACE_FONT_INDEX]));
+
+ if (NILP (attrs[LFACE_FAMILY_INDEX]))
+ family = Qnil;
+ else
+ family = Fcons (attrs[LFACE_FAMILY_INDEX], Qnil);
+
+ /* Decide FAMILY, ADSTYLE, and REGISTRY from FONT_SPEC. But,
+ ADSTYLE is not used in the font selector for the moment. */
+ if (VECTORP (font_spec))
{
- xassert (!SINGLE_BYTE_CHAR_P (c));
- return NULL;
+ pattern = Qnil;
+ if (! NILP (AREF (font_spec, FONT_FAMILY_INDEX)))
+ family = Fcons (SYMBOL_NAME (AREF (font_spec, FONT_FAMILY_INDEX)),
+ family);
+ adstyle = AREF (font_spec, FONT_ADSTYLE_INDEX);
+ registry = Fcons (SYMBOL_NAME (AREF (font_spec, FONT_REGISTRY_INDEX)),
+ Qnil);
+ }
+ else if (STRINGP (font_spec))
+ {
+ pattern = font_spec;
+ family = Qnil;
+ adstyle = Qnil;
+ registry = Qnil;
+ }
+ else
+ {
+ /* We are choosing an ASCII font. By default, use the registry
+ name "iso8859-1". But, if the registry name of the ASCII
+ font specified in the fontset of ATTRS is not "iso8859-1"
+ (e.g "iso10646-1"), use also that name with higher
+ priority. */
+ int fontset = face_fontset (attrs);
+ Lisp_Object ascii;
+ int len;
+ struct font_name font;
+
+ pattern = Qnil;
+ adstyle = Qnil;
+ registry = Fcons (build_string ("iso8859-1"), Qnil);
+
+ ascii = fontset_ascii (fontset);
+ len = SBYTES (ascii);
+ if (len < 9
+ || strcmp (SDATA (ascii) + len - 9, "iso8859-1"))
+ {
+ font.name = LSTRDUPA (ascii);
+ /* Check if the name is in XLFD. */
+ if (split_font_name (f, &font, 0))
+ {
+ font.fields[XLFD_ENCODING][-1] = '-';
+ registry = Fcons (build_string (font.fields[XLFD_REGISTRY]),
+ registry);
+ }
+ }
}
-
- /* If what we got is a name pattern, return it. */
- if (STRINGP (pattern))
- return xstrdup (SDATA (pattern));
/* Get a list of fonts matching that pattern and choose the
best match for the specified face attributes from it. */
- nfonts = try_font_list (f, attrs, XCAR (pattern), XCDR (pattern), &fonts,
- (SINGLE_BYTE_CHAR_P (c)
- || CHAR_CHARSET (c) == charset_latin_iso8859_1));
- width_ratio = (SINGLE_BYTE_CHAR_P (c)
- ? 1
- : CHARSET_WIDTH (CHAR_CHARSET (c)));
- font_name = best_matching_font (f, attrs, fonts, nfonts, width_ratio,
+ nfonts = try_font_list (f, pattern, family, registry, &fonts);
+ font_name = best_matching_font (f, attrs, fonts, nfonts, NILP (font_spec),
needs_overstrike);
return font_name;
}
#ifdef HAVE_WINDOW_SYSTEM
if (FRAME_WINDOW_P (f))
{
+#ifdef USE_FONT_BACKEND
+ if (enable_font_backend)
+ {
+ frame_font = font_find_object (FRAME_FONT_OBJECT (f));
+ xassert (FONT_OBJECT_P (frame_font));
+ set_lface_from_font_and_fontset (f, lface, frame_font,
+ FRAME_FONTSET (f),
+ f->default_face_done_p);
+ }
+ else
+ {
+#endif /* USE_FONT_BACKEND */
/* Set frame_font to the value of the `font' frame parameter. */
frame_font = Fassq (Qfont, f->param_alist);
xassert (CONSP (frame_font) && STRINGP (XCDR (frame_font)));
frame_font = XCDR (frame_font);
set_lface_from_font_name (f, lface, frame_font,
f->default_face_done_p, 1);
+#ifdef USE_FONT_BACKEND
+ }
+#endif /* USE_FONT_BACKEND */
f->default_face_done_p = 1;
}
#endif /* HAVE_WINDOW_SYSTEM */
xassert (lface_fully_specified_p (XVECTOR (lface)->contents));
check_lface (lface);
bcopy (XVECTOR (lface)->contents, attrs, sizeof attrs);
- face = realize_face (c, attrs, 0, NULL, DEFAULT_FACE_ID);
+ face = realize_face (c, attrs, DEFAULT_FACE_ID);
#ifdef HAVE_WINDOW_SYSTEM
#ifdef HAVE_X_WINDOWS
merge_face_vectors (f, symbol_attrs, attrs, 0);
/* Realize the face. */
- new_face = realize_face (c, attrs, 0, NULL, id);
+ new_face = realize_face (c, attrs, id);
}
/* Realize the fully-specified face with attributes ATTRS in face
- cache CACHE for character C. If C is a multibyte character,
- BASE_FACE is a face that has the same attributes. Otherwise,
- BASE_FACE is ignored. If FORMER_FACE_ID is non-negative, it is an
- ID of face to remove before caching the new face. Value is a
- pointer to the newly created realized face. */
+ cache CACHE for ASCII characters. If FORMER_FACE_ID is
+ non-negative, it is an ID of face to remove before caching the new
+ face. Value is a pointer to the newly created realized face. */
static struct face *
-realize_face (cache, attrs, c, base_face, former_face_id)
+realize_face (cache, attrs, former_face_id)
struct face_cache *cache;
Lisp_Object *attrs;
- int c;
- struct face *base_face;
int former_face_id;
{
struct face *face;
}
if (FRAME_WINDOW_P (cache->f))
- face = realize_x_face (cache, attrs, c, base_face);
+ face = realize_x_face (cache, attrs);
else if (FRAME_TERMCAP_P (cache->f) || FRAME_MSDOS_P (cache->f))
- face = realize_tty_face (cache, attrs, c);
+ face = realize_tty_face (cache, attrs);
else if (FRAME_INITIAL_P (cache->f))
{
/* Create a dummy face. */
/* Insert the new face. */
cache_face (cache, face, lface_hash (attrs));
+ return face;
+}
+
+
#ifdef HAVE_WINDOW_SYSTEM
- if (FRAME_WINDOW_P (cache->f) && face->font == NULL)
- load_face_font (cache->f, face, c);
-#endif /* HAVE_WINDOW_SYSTEM */
+/* Realize the fully-specified face that has the same attributes as
+ BASE_FACE except for the font on frame F. If FONT_ID is not
+ negative, it is an ID number of an already opened font that should
+ be used by the face. If FONT_ID is negative, the face has no font,
+ i.e., characters are displayed by empty boxes. */
+
+static struct face *
+realize_non_ascii_face (f, font_id, base_face)
+ struct frame *f;
+ int font_id;
+ struct face *base_face;
+{
+ struct face_cache *cache = FRAME_FACE_CACHE (f);
+ struct face *face;
+ struct font_info *font_info;
+
+ face = (struct face *) xmalloc (sizeof *face);
+ *face = *base_face;
+ face->gc = 0;
+#ifdef USE_FONT_BACKEND
+ face->extra = NULL;
+#endif
+
+ /* Don't try to free the colors copied bitwise from BASE_FACE. */
+ face->colors_copied_bitwise_p = 1;
+
+ face->font_info_id = font_id;
+ if (font_id >= 0)
+ {
+ font_info = FONT_INFO_FROM_ID (f, font_id);
+ face->font = font_info->font;
+ face->font_name = font_info->full_name;
+ }
+ else
+ {
+ face->font = NULL;
+ face->font_name = NULL;
+ }
+
+ face->gc = 0;
+
+ cache_face (cache, face, face->hash);
+
return face;
}
+#endif /* HAVE_WINDOW_SYSTEM */
/* Realize the fully-specified face with attributes ATTRS in face
- cache CACHE for character C. Do it for X frame CACHE->f. If C is
- a multibyte character, BASE_FACE is a face that has the same
- attributes. Otherwise, BASE_FACE is ignored. If the new face
- doesn't share font with the default face, a fontname is allocated
- from the heap and set in `font_name' of the new face, but it is not
- yet loaded here. Value is a pointer to the newly created realized
- face. */
+ cache CACHE for ASCII characters. Do it for X frame CACHE->f. If
+ the new face doesn't share font with the default face, a fontname
+ is allocated from the heap and set in `font_name' of the new face,
+ but it is not yet loaded here. Value is a pointer to the newly
+ created realized face. */
static struct face *
-realize_x_face (cache, attrs, c, base_face)
+realize_x_face (cache, attrs)
struct face_cache *cache;
Lisp_Object *attrs;
- int c;
- struct face *base_face;
{
struct face *face = NULL;
#ifdef HAVE_WINDOW_SYSTEM
Lisp_Object stipple, overline, strike_through, box;
xassert (FRAME_WINDOW_P (cache->f));
- xassert (SINGLE_BYTE_CHAR_P (c)
- || base_face);
/* Allocate a new realized face. */
face = make_realized_face (attrs);
+ face->ascii_face = face;
f = cache->f;
- /* If C is a multibyte character, we share all face attirbutes with
- BASE_FACE including the realized fontset. But, we must load a
- different font. */
- if (!SINGLE_BYTE_CHAR_P (c))
- {
- bcopy (base_face, face, sizeof *face);
- face->gc = 0;
-
- /* Don't try to free the colors copied bitwise from BASE_FACE. */
- face->colors_copied_bitwise_p = 1;
-
- /* to force realize_face to load font */
- face->font = NULL;
- return face;
- }
-
- /* Now we are realizing a face for ASCII (and unibyte) characters. */
-
/* Determine the font to use. Most of the time, the font will be
the same as the font of the default face, so try that first. */
default_face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
if (default_face
- && FACE_SUITABLE_FOR_CHAR_P (default_face, c)
&& lface_same_font_attributes_p (default_face->lface, attrs))
{
face->font = default_face->font;
- face->fontset = default_face->fontset;
face->font_info_id = default_face->font_info_id;
+#ifdef USE_FONT_BACKEND
+ face->font_info = default_face->font_info;
+#endif /* USE_FONT_BACKEND */
face->font_name = default_face->font_name;
- face->ascii_face = face;
-
- /* But, as we can't share the fontset, make a new realized
- fontset that has the same base fontset as of the default
- face. */
face->fontset
- = make_fontset_for_ascii_face (f, default_face->fontset);
+ = make_fontset_for_ascii_face (f, default_face->fontset, face);
}
else
{
are constructed from ATTRS. */
int fontset = face_fontset (attrs);
- if ((fontset == -1) && default_face)
+ /* If we are realizing the default face, ATTRS should specify a
+ fontset. In other words, if FONTSET is -1, we are not
+ realizing the default face, thus the default face should have
+ already been realized. */
+ if (fontset == -1)
fontset = default_face->fontset;
- face->fontset = make_fontset_for_ascii_face (f, fontset);
- face->font = NULL; /* to force realize_face to load font */
+ if (fontset == -1)
+ abort ();
+#ifdef USE_FONT_BACKEND
+ if (enable_font_backend)
+ font_load_for_face (f, face);
+ else
+#endif /* USE_FONT_BACKEND */
+ load_face_font (f, face);
+ if (face->font)
+ face->fontset = make_fontset_for_ascii_face (f, fontset, face);
+ else
+ face->fontset = -1;
}
/* Load colors, and set remaining attributes. */
stipple = attrs[LFACE_STIPPLE_INDEX];
if (!NILP (stipple))
face->stipple = load_pixmap (f, stipple, &face->pixmap_w, &face->pixmap_h);
-
- xassert (FACE_SUITABLE_FOR_CHAR_P (face, c));
#endif /* HAVE_WINDOW_SYSTEM */
+
return face;
}
/* Realize the fully-specified face with attributes ATTRS in face
- cache CACHE for character C. Do it for TTY frame CACHE->f. Value is a
- pointer to the newly created realized face. */
+ cache CACHE for ASCII characters. Do it for TTY frame CACHE->f.
+ Value is a pointer to the newly created realized face. */
static struct face *
-realize_tty_face (cache, attrs, c)
+realize_tty_face (cache, attrs)
struct face_cache *cache;
Lisp_Object *attrs;
- int c;
{
struct face *face;
int weight, slant;
if (NILP (prop))
{
struct face *face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
- face_id = FACE_FOR_CHAR (f, face, ch);
+ face_id = FACE_FOR_CHAR (f, face, ch, -1, Qnil);
}
else
{
struct face *default_face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
bcopy (default_face->lface, attrs, sizeof attrs);
merge_face_ref (f, prop, attrs, 1, 0);
- face_id = lookup_face (f, attrs, ch, NULL);
+ face_id = lookup_face (f, attrs);
}
return face_id;
/* Look up a realized face with the given face attributes,
or realize a new one for ASCII characters. */
- return lookup_face (f, attrs, 0, NULL);
+ return lookup_face (f, attrs);
}
/* Return the face ID at buffer position POS for displaying ASCII
/* Look up a realized face with the given face attributes,
or realize a new one for ASCII characters. */
- return lookup_face (f, attrs, 0, NULL);
+ return lookup_face (f, attrs);
}
/* Look up a realized face with the given face attributes,
or realize a new one for ASCII characters. */
- return lookup_face (f, attrs, 0, NULL);
+ return lookup_face (f, attrs);
}
if (face_id < 0 || face_id >= lface_id_to_name_size)
return base_face_id;
face_name = lface_id_to_name[face_id];
- face_id = lookup_derived_face (f, face_name, 0, base_face_id, 1);
+ face_id = lookup_derived_face (f, face_name, base_face_id, 1);
if (face_id >= 0)
return face_id;
return base_face_id;
/* Look up a realized face with the given face attributes,
or realize a new one for ASCII characters. */
- return lookup_face (f, attrs, 0, NULL);
+ return lookup_face (f, attrs);
}
\f
face->underline_p,
SDATA (Fsymbol_name (face->lface[LFACE_UNDERLINE_INDEX])));
fprintf (stderr, "hash: %d\n", face->hash);
- fprintf (stderr, "charset: %d\n", face->charset);
}
staticpro (&QCwidth);
QCfont = intern (":font");
staticpro (&QCfont);
+ QCfontset = intern (":fontset");
+ staticpro (&QCfontset);
QCbold = intern (":bold");
staticpro (&QCbold);
QCitalic = intern (":italic");
/* Functions for the X window system.
Copyright (C) 1989, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
- 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
+ Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include "keyboard.h"
#include "blockinput.h"
#include <epaths.h>
+#include "character.h"
#include "charset.h"
#include "coding.h"
#include "fontset.h"
#include "atimer.h"
#include "termchar.h"
+#ifdef USE_FONT_BACKEND
+#include "font.h"
+#endif /* USE_FONT_BACKEND */
+
#ifdef HAVE_X_WINDOWS
#include <ctype.h>
if (wdesc == None) return 0;
- for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
+ for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
{
frame = XCAR (tail);
- if (!GC_FRAMEP (frame))
+ if (!FRAMEP (frame))
continue;
f = XFRAME (frame);
if (!FRAME_X_P (f) || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
if (wdesc == None) return NULL;
found = NULL;
- for (tail = Vframe_list; GC_CONSP (tail) && !found; tail = XCDR (tail))
+ for (tail = Vframe_list; CONSP (tail) && !found; tail = XCDR (tail))
{
frame = XCAR (tail);
- if (!GC_FRAMEP (frame))
+ if (!FRAMEP (frame))
continue;
f = XFRAME (frame);
if (wdesc == None) return 0;
- for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
+ for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
{
frame = XCAR (tail);
- if (!GC_FRAMEP (frame))
+ if (!FRAMEP (frame))
continue;
f = XFRAME (frame);
if (!FRAME_X_P (f) || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
if (wdesc == None) return 0;
- for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
+ for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
{
frame = XCAR (tail);
- if (!GC_FRAMEP (frame))
+ if (!FRAMEP (frame))
continue;
f = XFRAME (frame);
if (!FRAME_X_P (f) || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
if (wdesc == None) return 0;
- for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
+ for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
{
frame = XCAR (tail);
- if (!GC_FRAMEP (frame))
+ if (!FRAMEP (frame))
continue;
f = XFRAME (frame);
if (!FRAME_X_P (f) || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
\f
+static void x_default_font_parameter P_ ((struct frame *, Lisp_Object));
+
static Lisp_Object unwind_create_frame P_ ((Lisp_Object));
static Lisp_Object unwind_create_tip_frame P_ ((Lisp_Object));
int selectionp;
int *freep;
{
- unsigned char *str = SDATA (string);
- int chars = SCHARS (string);
- int bytes = SBYTES (string);
- int charset_info;
- int bufsize;
- unsigned char *buf;
+ int result = string_xstring_p (string);
struct coding_system coding;
- extern Lisp_Object Qcompound_text_with_extensions;
- charset_info = find_charset_in_text (str, chars, bytes, NULL, Qnil);
- if (charset_info == 0)
+ if (result == 0)
{
/* No multibyte character in OBJ. We need not encode it. */
- *text_bytes = bytes;
+ *text_bytes = SBYTES (string);
*stringp = 1;
*freep = 0;
- return str;
+ return SDATA (string);
}
setup_coding_system (coding_system, &coding);
- if (selectionp
- && SYMBOLP (coding.pre_write_conversion)
- && !NILP (Ffboundp (coding.pre_write_conversion)))
- {
- struct gcpro gcpro1;
- /* We don't need to GCPRO string. */
- GCPRO1 (coding_system);
- string = run_pre_post_conversion_on_str (string, &coding, 1);
- UNGCPRO;
- str = SDATA (string);
- chars = SCHARS (string);
- bytes = SBYTES (string);
- }
- coding.src_multibyte = 1;
- coding.dst_multibyte = 0;
- coding.mode |= CODING_MODE_LAST_BLOCK;
- if (coding.type == coding_type_iso2022)
- coding.flags |= CODING_FLAG_ISO_SAFE;
+ coding.mode |= (CODING_MODE_SAFE_ENCODING | CODING_MODE_LAST_BLOCK);
/* We suppress producing escape sequences for composition. */
- coding.composing = COMPOSITION_DISABLED;
- bufsize = encoding_buffer_size (&coding, bytes);
- buf = (unsigned char *) xmalloc (bufsize);
- encode_coding (&coding, str, buf, bytes, bufsize);
+ coding.common_flags &= ~CODING_ANNOTATION_MASK;
+ coding.dst_bytes = SCHARS (string) * 2;
+ coding.destination = (unsigned char *) xmalloc (coding.dst_bytes);
+ encode_coding_object (&coding, string, 0, 0,
+ SCHARS (string), SBYTES (string), Qnil);
*text_bytes = coding.produced;
- *stringp = (charset_info == 1
- || (!EQ (coding_system, Qcompound_text)
- && !EQ (coding_system, Qcompound_text_with_extensions)));
+ *stringp = (result == 1 || !EQ (coding_system, Qcompound_text));
*freep = 1;
- return buf;
+ return coding.destination;
}
\f
#ifdef HAVE_X_I18N
static XFontSet xic_create_xfontset P_ ((struct frame *, char *));
+static XFontSet xic_create_xfontset2 P_ ((struct frame *));
static XIMStyle best_xim_style P_ ((XIMStyles *, XIMStyles *));
return fontsetname;
}
+#ifdef DEBUG_XIC_FONTSET
+static void
+print_fontset_result (xfs, name, missing_list, missing_count)
+ XFontSet xfs;
+ char *name;
+ char **missing_list;
+ int missing_count;
+{
+ if (xfs)
+ fprintf (stderr, "XIC Fontset created: %s\n", name);
+ else
+ {
+ fprintf (stderr, "XIC Fontset failed: %s\n", name);
+ while (missing_count-- > 0)
+ {
+ fprintf (stderr, " missing: %s\n", *missing_list);
+ missing_list++;
+ }
+ }
+
+}
+#endif
+
static XFontSet
xic_create_xfontset (f, base_fontname)
struct frame *f;
xfs = XCreateFontSet (FRAME_X_DISPLAY (f),
fontsetname, &missing_list,
&missing_count, &def_string);
+#ifdef DEBUG_XIC_FONTSET
+ print_fontset_result (xfs, fontsetname, missing_list, missing_count);
+#endif
if (missing_list)
XFreeStringList (missing_list);
if (! xfs)
xfs = XCreateFontSet (FRAME_X_DISPLAY (f),
p0, &missing_list,
&missing_count, &def_string);
+#ifdef DEBUG_XIC_FONTSET
+ print_fontset_result (xfs, p0, missing_list, missing_count);
+#endif
if (missing_list)
XFreeStringList (missing_list);
if (xfs)
}
}
xfree (fontsetname);
+ if (! xfs && base_fontname != xic_defaut_fontset)
+ {
+ /* Try the default fontset name at a last resort. */
+ fontsetname = xic_create_fontsetname (xic_defaut_fontset, False);
+ xfs = XCreateFontSet (FRAME_X_DISPLAY (f),
+ fontsetname, &missing_list,
+ &missing_count, &def_string);
+#ifdef DEBUG_XIC_FONTSET
+ print_fontset_result (xfs, fontsetname, missing_list, missing_count);
+#endif
+ if (missing_list)
+ XFreeStringList (missing_list);
+ xfree (fontsetname);
+ }
}
if (FRAME_XIC_BASE_FONTNAME (f))
return xfs;
}
+#ifdef USE_FONT_BACKEND
+
+static XFontSet
+xic_create_xfontset2 (f)
+ struct frame *f;
+{
+ XFontSet xfs = NULL;
+ struct font *font = FRAME_FONT_OBJECT (f);
+ int pixel_size = font->pixel_size;
+ Lisp_Object rest, frame;
+
+ /* See if there is another frame already using same fontset. */
+ FOR_EACH_FRAME (rest, frame)
+ {
+ struct frame *cf = XFRAME (frame);
+
+ if (cf != f && FRAME_LIVE_P (f) && FRAME_X_P (cf)
+ && FRAME_X_DISPLAY_INFO (cf) == FRAME_X_DISPLAY_INFO (f)
+ && FRAME_FONT_OBJECT (f)
+ && FRAME_FONT_OBJECT (f)->pixel_size == pixel_size)
+ {
+ xfs = FRAME_XIC_FONTSET (cf);
+ break;
+ }
+ }
+
+ if (! xfs)
+ {
+ char buf[256];
+ char **missing_list;
+ int missing_count;
+ char *def_string;
+ char *xlfd_format = "-*-*-medium-r-normal--%d-*-*-*-*-*";
+
+ sprintf (buf, xlfd_format, pixel_size);
+ missing_list = NULL;
+ xfs = XCreateFontSet (FRAME_X_DISPLAY (f), buf,
+ &missing_list, &missing_count, &def_string);
+#ifdef DEBUG_XIC_FONTSET
+ print_fontset_result (xfs, buf, missing_list, missing_count);
+#endif
+ if (missing_list)
+ XFreeStringList (missing_list);
+ if (! xfs)
+ {
+ /* List of pixel sizes most likely available. Find one that
+ is closest to pixel_size. */
+ int sizes[] = {0, 8, 10, 11, 12, 14, 17, 18, 20, 24, 26, 34, 0};
+ int *smaller, *larger;
+
+ for (smaller = sizes; smaller[1]; smaller++)
+ if (smaller[1] >= pixel_size)
+ break;
+ larger = smaller + 1;
+ if (*larger == pixel_size)
+ larger++;
+ while (*smaller || *larger)
+ {
+ int this_size;
+
+ if (! *larger)
+ this_size = *smaller--;
+ else if (! *smaller)
+ this_size = *larger++;
+ else if (pixel_size - *smaller < *larger - pixel_size)
+ this_size = *smaller--;
+ else
+ this_size = *larger++;
+ sprintf (buf, xlfd_format, this_size);
+ missing_list = NULL;
+ xfs = XCreateFontSet (FRAME_X_DISPLAY (f), buf,
+ &missing_list, &missing_count, &def_string);
+#ifdef DEBUG_XIC_FONTSET
+ print_fontset_result (xfs, buf, missing_list, missing_count);
+#endif
+ if (missing_list)
+ XFreeStringList (missing_list);
+ if (xfs)
+ break;
+ }
+ }
+ if (! xfs)
+ {
+ char *last_resort = "-*-*-*-r-normal--*-*-*-*-*-*";
+
+ missing_list = NULL;
+ xfs = XCreateFontSet (FRAME_X_DISPLAY (f), last_resort,
+ &missing_list, &missing_count, &def_string);
+#ifdef DEBUG_XIC_FONTSET
+ print_fontset_result (xfs, last_resort, missing_list, missing_count);
+#endif
+ if (missing_list)
+ XFreeStringList (missing_list);
+ }
+
+ }
+
+ return xfs;
+}
+#endif /* USE_FONT_BACKEND */
+
/* Free the X fontset of frame F if it is the last frame using it. */
void
return;
/* Create X fontset. */
+#ifdef USE_FONT_BACKEND
+ if (enable_font_backend)
+ xfs = xic_create_xfontset2 (f);
+ else
+#endif
xfs = xic_create_xfontset
(f, (FRAME_FONTSET (f) < 0) ? NULL
: (char *) SDATA (fontset_ascii (FRAME_FONTSET (f))));
xic_free_xfontset (f);
+#ifdef USE_FONT_BACKEND
+ if (enable_font_backend)
+ xfs = xic_create_xfontset2 (f);
+ else
+#endif
xfs = xic_create_xfontset (f, base_fontname);
attr = XVaCreateNestedList (0, XNFontSet, xfs, NULL);
return Qnil;
}
+#ifdef USE_FONT_BACKEND
+static void
+x_default_font_parameter (f, parms)
+ struct frame *f;
+ Lisp_Object parms;
+{
+ struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
+ Lisp_Object font = x_get_arg (dpyinfo, parms, Qfont, "font", "Font",
+ RES_TYPE_STRING);
+
+ if (! STRINGP (font))
+ {
+ char *names[]
+ = { "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1",
+ "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1",
+ "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1",
+ /* This was formerly the first thing tried, but it finds
+ too many fonts and takes too long. */
+ "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1",
+ /* If those didn't work, look for something which will
+ at least work. */
+ "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1",
+ "fixed",
+ NULL };
+ int i;
+
+ for (i = 0; names[i]; i++)
+ {
+ font = font_open_by_name (f, names[i]);
+ if (! NILP (font))
+ break;
+ }
+ if (NILP (font))
+ error ("No suitable font was found");
+ }
+ x_default_parameter (f, parms, Qfont, font, "font", "Font", RES_TYPE_STRING);
+}
+#endif /* USE_FONT_BACKEND */
DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
1, 1, 0,
specbind (Qx_resource_name, name);
}
+ f->resx = dpyinfo->resx;
+ f->resy = dpyinfo->resy;
+
+#ifdef USE_FONT_BACKEND
+ if (enable_font_backend)
+ {
+ /* Perhaps, we must allow frame parameter, say `font-backend',
+ to specify which font backends to use. */
+#ifdef HAVE_FREETYPE
+#ifdef HAVE_XFT
+ register_font_driver (&xftfont_driver, f);
+#else /* not HAVE_XFT */
+ register_font_driver (&ftxfont_driver, f);
+#endif /* not HAVE_XFT */
+#endif /* HAVE_FREETYPE */
+ register_font_driver (&xfont_driver, f);
+
+ x_default_parameter (f, parms, Qfont_backend, Qnil,
+ "fontBackend", "FontBackend", RES_TYPE_STRING);
+ }
+#endif /* USE_FONT_BACKEND */
+
/* Extract the window parameters from the supplied values
that are needed to determine window geometry. */
+#ifdef USE_FONT_BACKEND
+ if (enable_font_backend)
+ x_default_font_parameter (f, parms);
+else
+#endif /* USE_FONT_BACKEND */
{
Lisp_Object font;
font = x_get_arg (dpyinfo, parms, Qfont, "font", "Font", RES_TYPE_STRING);
- BLOCK_INPUT;
- /* First, try whatever font the caller has specified. */
- if (STRINGP (font))
- {
- tem = Fquery_fontset (font, Qnil);
- if (STRINGP (tem))
- font = x_new_fontset (f, SDATA (tem));
- else
- font = x_new_font (f, SDATA (font));
- }
-
- /* Try out a font which we hope has bold and italic variations. */
- if (!STRINGP (font))
- font = x_new_font (f, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
+ /* If the caller has specified no font, try out fonts which we
+ hope have bold and italic variations. */
if (!STRINGP (font))
- font = x_new_font (f, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
- if (! STRINGP (font))
- font = x_new_font (f, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
- if (! STRINGP (font))
- /* This was formerly the first thing tried, but it finds too many fonts
- and takes too long. */
- font = x_new_font (f, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
- /* If those didn't work, look for something which will at least work. */
- if (! STRINGP (font))
- font = x_new_font (f, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
- UNBLOCK_INPUT;
- if (! STRINGP (font))
- font = build_string ("fixed");
+ {
+ char *names[]
+ = { "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1",
+ "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1",
+ "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1",
+ /* This was formerly the first thing tried, but it finds
+ too many fonts and takes too long. */
+ "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1",
+ /* If those didn't work, look for something which will
+ at least work. */
+ "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1",
+ NULL };
+ int i;
+
+ BLOCK_INPUT;
+ for (i = 0; names[i]; i++)
+ {
+ Lisp_Object list;
- x_set_frame_parameters (f, Fcons (Fcons (Qfont, font), Qnil));
+ list = x_list_fonts (f, build_string (names[i]), 0, 1);
+ if (CONSP (list))
+ {
+ font = XCAR (list);
+ break;
+ }
+ }
+ UNBLOCK_INPUT;
+ if (! STRINGP (font))
+ font = build_string ("fixed");
+ }
+ x_default_parameter (f, parms, Qfont, font,
+ "font", "Font", RES_TYPE_STRING);
}
#ifdef USE_LUCID
specbind (Qx_resource_name, name);
}
+ f->resx = dpyinfo->resx;
+ f->resy = dpyinfo->resy;
+
+#ifdef USE_FONT_BACKEND
+ if (enable_font_backend)
+ {
+ /* Perhaps, we must allow frame parameter, say `font-backend',
+ to specify which font backends to use. */
+#ifdef HAVE_FREETYPE
+#ifdef HAVE_XFT
+ register_font_driver (&xftfont_driver, f);
+#else /* not HAVE_XFT */
+ register_font_driver (&ftxfont_driver, f);
+#endif /* not HAVE_XFT */
+#endif /* HAVE_FREETYPE */
+ register_font_driver (&xfont_driver, f);
+
+ x_default_parameter (f, parms, Qfont_backend, Qnil,
+ "fontBackend", "FontBackend", RES_TYPE_STRING);
+ }
+#endif /* USE_FONT_BACKEND */
+
/* Extract the window parameters from the supplied values that are
needed to determine window geometry. */
+#ifdef USE_FONT_BACKEND
+ if (enable_font_backend)
+ x_default_font_parameter (f, parms);
+else
+#endif /* USE_FONT_BACKEND */
{
Lisp_Object font;
{
tem = Fquery_fontset (font, Qnil);
if (STRINGP (tem))
- font = x_new_fontset (f, SDATA (tem));
+ font = x_new_fontset (f, tem);
else
font = x_new_font (f, SDATA (font));
}
if (! STRINGP (font))
font = build_string ("fixed");
- x_default_parameter (f, parms, Qfont, font,
- "font", "Font", RES_TYPE_STRING);
+ x_set_frame_parameters (f, Fcons (Fcons (Qfont, font), Qnil));
}
x_default_parameter (f, parms, Qborder_width, make_number (2),
x_set_fringe_width,
x_set_wait_for_wm,
x_set_fullscreen,
+#ifdef USE_FONT_BACKEND
+ x_set_font_backend
+#endif /* USE_FONT_BACKEND */
};
void
find_ccl_program_func = x_find_ccl_program;
query_font_func = x_query_font;
set_frame_fontset_func = x_set_font;
+ get_font_repertory_func = x_get_font_repertory;
check_window_system_func = check_x;
hourglass_atimer = NULL;
/* X Communication module for terminals which understand the X protocol.
Copyright (C) 1986, 1988, 1993, 1994, 1996, 1999, 2000, 2001, 2002, 2003,
- 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
This file is part of GNU Emacs.
Lisp_Object tail, frame;
FRAME_PTR f;
- for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
+ for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
{
frame = XCAR (tail);
- if (!GC_FRAMEP (frame))
+ if (!FRAMEP (frame))
continue;
f = XFRAME (frame);
if (!FRAME_WINDOW_P (f))
xt_or_gtk_widget frame_widget = XtParent (widget);
Lisp_Object tail;
- for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
+ for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
{
frame = XCAR (tail);
- if (GC_FRAMEP (frame)
+ if (FRAMEP (frame)
&& (f = XFRAME (frame),
FRAME_X_P (f) && f->output_data.x->widget == frame_widget))
break;
static void
find_and_call_menu_selection (f, menu_bar_items_used, vector, client_data)
FRAME_PTR f;
- int menu_bar_items_used;
+ EMACS_INT menu_bar_items_used;
Lisp_Object vector;
void *client_data;
{
/* Deal with the X Resource Manager.
Copyright (C) 1990, 1993, 1994, 2000, 2001, 2002, 2003, 2004,
- 2005, 2006, 2007 Free Software Foundation, Inc.
+ 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#endif /* not USE_MOTIF */
+#ifdef HAVE_X_I18N
+ {
+#ifdef USE_MOTIF
+ Bool motif = True;
+#else /* not USE_MOTIF */
+ Bool motif = False;
+#endif /* not USE_MOTIF */
+ /* Setup the default fontSet resource. */
+ extern char *xic_create_fontsetname P_ ((char *base_fontname, Bool motif));
+ char *fontsetname = xic_create_fontsetname (helv, motif);
+ int len = strlen (fontsetname);
+ char *buf = line;
+
+ /* fontsetname may be very long. */
+ if (len + 16 > 256)
+ buf = alloca (len + 16);
+ sprintf (buf, "Emacs*fontSet: %s", fontsetname);
+ XrmPutLineResource (&rdb, buf);
+ if (fontsetname != helv)
+ xfree (fontsetname);
+ }
+#endif /* HAVE_X_I18N */
+
user_database = get_user_db (display);
/* Figure out what the "customization string" is, so we can use it
/* X Selection processing for Emacs.
Copyright (C) 1993, 1994, 1995, 1996, 1997, 2000, 2001, 2002, 2003,
- 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
This file is part of GNU Emacs.
static Lisp_Object Vx_lost_selection_functions;
static Lisp_Object Vx_sent_selection_functions;
-/* Coding system for communicating with other X clients via selection
- and clipboard. */
-static Lisp_Object Vselection_coding_system;
-
-/* Coding system for the next communicating with other X clients. */
-static Lisp_Object Vnext_selection_coding_system;
-
static Lisp_Object Qforeign_selection;
/* If this is a smaller number than the max-request-size of the display,
it merely informs you that they have happened. */);
Vx_sent_selection_functions = Qnil;
- DEFVAR_LISP ("selection-coding-system", &Vselection_coding_system,
- doc: /* Coding system for communicating with other X clients.
-
-When sending text via selection and clipboard, if the requested
-data-type is not "UTF8_STRING", the text is encoded by this coding
-system.
-
-When receiving text, if the data-type of the received text is not
-"UTF8_STRING", it is decoded by this coding system.
-
-See also the documentation of the variable `x-select-request-type' how
-to control which data-type to request for receiving text.
-
-The default value is `compound-text-with-extensions'. */);
- Vselection_coding_system = intern ("compound-text-with-extensions");
-
- DEFVAR_LISP ("next-selection-coding-system", &Vnext_selection_coding_system,
- doc: /* Coding system for the next communication with other X clients.
-Usually, `selection-coding-system' is used for communicating with
-other X clients. But, if this variable is set, it is used for the
-next communication only. After the communication, this variable is
-set to nil. */);
- Vnext_selection_coding_system = Qnil;
-
DEFVAR_INT ("x-selection-timeout", &x_selection_timeout,
doc: /* Number of milliseconds to wait for a selection reply.
If the selection owner doesn't reply in this time, we give up.
/* X Communication module for terminals which understand the X protocol.
Copyright (C) 1989, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001,
- 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ 2002, 2003, 2004, 2005, 2006, 2007, 2008
+ Free Software Foundation, Inc.
This file is part of GNU Emacs.
/* #include <sys/param.h> */
#include "charset.h"
+#include "character.h"
#include "coding.h"
#include "ccl.h"
#include "frame.h"
#include "gtkutil.h"
#endif
+#ifdef USE_FONT_BACKEND
+#include "font.h"
+#endif /* USE_FONT_BACKEND */
+
#ifdef USE_LUCID
extern int xlwmenu_window_p P_ ((Widget w, Window window));
extern void xlwmenu_redisplay P_ ((Widget));
/* Function prototypes of this page. */
-static int x_encode_char P_ ((int, XChar2b *, struct font_info *, int *));
+static int x_encode_char P_ ((int, XChar2b *, struct font_info *,
+ struct charset *, int *));
/* Get metrics of character CHAR2B in FONT. Value is null if CHAR2B
the two-byte form of C. Encoding is returned in *CHAR2B. */
static int
-x_encode_char (c, char2b, font_info, two_byte_p)
+x_encode_char (c, char2b, font_info, charset, two_byte_p)
int c;
XChar2b *char2b;
struct font_info *font_info;
+ struct charset *charset;
int *two_byte_p;
{
- int charset = CHAR_CHARSET (c);
XFontStruct *font = font_info->font;
/* FONT_INFO may define a scheme by which to encode byte1 and byte2.
check_ccl_update (ccl);
if (CHARSET_DIMENSION (charset) == 1)
{
- ccl->reg[0] = charset;
+ ccl->reg[0] = CHARSET_ID (charset);
ccl->reg[1] = char2b->byte2;
ccl->reg[2] = -1;
}
else
{
- ccl->reg[0] = charset;
+ ccl->reg[0] = CHARSET_ID (charset);
ccl->reg[1] = char2b->byte1;
ccl->reg[2] = char2b->byte2;
}
- ccl_driver (ccl, NULL, NULL, 0, 0, NULL);
+ ccl_driver (ccl, NULL, NULL, 0, 0, Qnil);
/* We assume that MSBs are appropriately set/reset by CCL
program. */
if (font->max_byte1 == 0) /* 1-byte font */
- char2b->byte1 = 0, char2b->byte2 = ccl->reg[1];
+ STORE_XCHAR2B (char2b, 0, ccl->reg[1]);
else
- char2b->byte1 = ccl->reg[1], char2b->byte2 = ccl->reg[2];
+ STORE_XCHAR2B (char2b, ccl->reg[1], ccl->reg[2]);
}
- else if (font_info->encoding[charset])
+ else if (font_info->encoding_type)
{
/* Fixed encoding scheme. See fontset.h for the meaning of the
encoding numbers. */
- int enc = font_info->encoding[charset];
+ unsigned char enc = font_info->encoding_type;
if ((enc == 1 || enc == 2)
&& CHARSET_DIMENSION (charset) == 2)
face = FACE_FROM_ID (s->f, MOUSE_FACE_ID);
if (s->first_glyph->type == CHAR_GLYPH)
- face_id = FACE_FOR_CHAR (s->f, face, s->first_glyph->u.ch);
+ face_id = FACE_FOR_CHAR (s->f, face, s->first_glyph->u.ch, -1, Qnil);
else
- face_id = FACE_FOR_CHAR (s->f, face, 0);
+ face_id = FACE_FOR_CHAR (s->f, face, 0, -1, Qnil);
s->face = FACE_FROM_ID (s->f, face_id);
PREPARE_FACE_FOR_DISPLAY (s->f, s->face);
/* If font in this face is same as S->font, use it. */
if (s->font == s->face->font)
s->gc = s->face->gc;
+#ifdef USE_FONT_BACKEND
+ else if (enable_font_backend)
+ /* No need of setting a font for s->gc. */
+ s->gc = s->face->gc;
+#endif /* USE_FONT_BACKEND */
else
{
/* Otherwise construct scratch_cursor_gc with values from FACE
static INLINE void
x_set_glyph_string_clipping (s)
struct glyph_string *s;
+{
+#ifdef USE_FONT_BACKEND
+ XRectangle *r = s->clip;
+#else
+ XRectangle r[2];
+#endif
+ int n = get_glyph_string_clip_rects (s, r, 2);
+
+ if (n > 0)
+ XSetClipRectangles (s->display, s->gc, 0, 0, r, n, Unsorted);
+#ifdef USE_FONT_BACKEND
+ s->num_clips = n;
+#endif
+}
+
+
+/* Set SRC's clipping for output of glyph string DST. This is called
+ when we are drawing DST's left_overhang or right_overhang only in
+ the area of SRC. */
+
+static void
+x_set_glyph_string_clipping_exactly (src, dst)
+ struct glyph_string *src, *dst;
{
XRectangle r;
- get_glyph_string_clip_rect (s, &r);
- XSetClipRectangles (s->display, s->gc, 0, 0, &r, 1, Unsorted);
+
+#ifdef USE_FONT_BACKEND
+ if (enable_font_backend)
+ {
+ r.x = src->x;
+ r.width = src->width;
+ r.y = src->y;
+ r.height = src->height;
+ dst->clip[0] = r;
+ dst->num_clips = 1;
+ }
+ else
+ {
+#endif /* USE_FONT_BACKEND */
+ struct glyph_string *clip_head = src->clip_head;
+ struct glyph_string *clip_tail = src->clip_tail;
+
+ /* This foces clipping just this glyph string. */
+ src->clip_head = src->clip_tail = src;
+ get_glyph_string_clip_rect (src, &r);
+ src->clip_head = clip_head, src->clip_tail = clip_tail;
+#ifdef USE_FONT_BACKEND
+ }
+#endif /* USE_FONT_BACKEND */
+ XSetClipRectangles (dst->display, dst->gc, 0, 0, &r, 1, Unsorted);
}
/* RIF:
- Compute left and right overhang of glyph string S. If S is a glyph
- string for a composition, assume overhangs don't exist. */
+ Compute left and right overhang of glyph string S. */
static void
x_compute_glyph_string_overhangs (s)
{
XCharStruct cs;
int direction, font_ascent, font_descent;
+
+#ifdef USE_FONT_BACKEND
+ if (enable_font_backend)
+ {
+ unsigned *code = alloca (sizeof (unsigned) * s->nchars);
+ struct font *font = (struct font *) s->font_info;
+ struct font_metrics metrics;
+ int i;
+
+ for (i = 0; i < s->nchars; i++)
+ code[i] = (s->char2b[i].byte1 << 8) | s->char2b[i].byte2;
+ font->driver->text_extents (font, code, s->nchars, &metrics);
+ cs.rbearing = metrics.rbearing;
+ cs.lbearing = metrics.lbearing;
+ cs.width = metrics.width;
+ }
+ else
+#endif /* USE_FONT_BACKEND */
XTextExtents16 (s->font, s->char2b, s->nchars, &direction,
&font_ascent, &font_descent, &cs);
s->right_overhang = cs.rbearing > cs.width ? cs.rbearing - cs.width : 0;
s->left_overhang = cs.lbearing < 0 ? -cs.lbearing : 0;
}
+ else if (s->cmp)
+ {
+ s->right_overhang = s->cmp->rbearing - s->cmp->pixel_width;
+ s->left_overhang = - s->cmp->lbearing;
+ }
}
x += g->pixel_width;
}
}
+#ifdef USE_FONT_BACKEND
+ else if (enable_font_backend)
+ {
+ int boff = s->font_info->baseline_offset;
+ struct font *font = (struct font *) s->font_info;
+ int y;
+
+ if (s->font_info->vertical_centering)
+ boff = VCENTER_BASELINE_OFFSET (s->font, s->f) - boff;
+
+ y = s->ybase - boff;
+ if (s->for_overlaps
+ || (s->background_filled_p && s->hl != DRAW_CURSOR))
+ font->driver->draw (s, 0, s->nchars, x, y, 0);
+ else
+ font->driver->draw (s, 0, s->nchars, x, y, 1);
+ if (s->face->overstrike)
+ font->driver->draw (s, 0, s->nchars, x + 1, y, 0);
+ }
+#endif /* USE_FONT_BACKEND */
else
{
char *char1b = (char *) s->char2b;
x_draw_composite_glyph_string_foreground (s)
struct glyph_string *s;
{
- int i, x;
+ int i, j, x;
/* If first glyph of S has a left box line, start drawing the text
of S to the right of that box line. */
- if (s->face->box != FACE_NO_BOX
+ if (s->face && s->face->box != FACE_NO_BOX
&& s->first_glyph->left_box_line_p)
x = s->x + eabs (s->face->box_line_width);
else
XDrawRectangle (s->display, s->window, s->gc, x, s->y,
s->width - 1, s->height - 1);
}
- else
+#ifdef USE_FONT_BACKEND
+ else if (enable_font_backend)
{
- for (i = 0; i < s->nchars; i++, ++s->gidx)
+ struct font *font = (struct font *) s->font_info;
+ int y = s->ybase;
+ int width = 0;
+
+ if (s->cmp->method == COMPOSITION_WITH_GLYPH_STRING)
{
- XDrawString16 (s->display, s->window, s->gc,
- x + s->cmp->offsets[s->gidx * 2],
- s->ybase - s->cmp->offsets[s->gidx * 2 + 1],
- s->char2b + i, 1);
- if (s->face->overstrike)
- XDrawString16 (s->display, s->window, s->gc,
- x + s->cmp->offsets[s->gidx * 2] + 1,
- s->ybase - s->cmp->offsets[s->gidx * 2 + 1],
- s->char2b + i, 1);
+ Lisp_Object gstring = AREF (XHASH_TABLE (composition_hash_table)
+ ->key_and_value,
+ s->cmp->hash_index * 2);
+ int from;
+
+ for (i = from = 0; i < s->nchars; i++)
+ {
+ Lisp_Object g = LGSTRING_GLYPH (gstring, i);
+ Lisp_Object adjustment = LGLYPH_ADJUSTMENT (g);
+ int xoff, yoff, wadjust;
+
+ if (! VECTORP (adjustment))
+ {
+ width += LGLYPH_WIDTH (g);
+ continue;
+ }
+ if (from < i)
+ {
+ font->driver->draw (s, from, i, x, y, 0);
+ x += width;
+ }
+ xoff = XINT (AREF (adjustment, 0));
+ yoff = XINT (AREF (adjustment, 1));
+ wadjust = XINT (AREF (adjustment, 2));
+
+ font->driver->draw (s, i, i + 1, x + xoff, y + yoff, 0);
+ x += wadjust;
+ from = i + 1;
+ width = 0;
+ }
+ if (from < i)
+ font->driver->draw (s, from, i, x, y, 0);
+ }
+ else
+ {
+ for (i = 0, j = s->gidx; i < s->nchars; i++, j++)
+ if (COMPOSITION_GLYPH (s->cmp, j) != '\t')
+ {
+ int xx = x + s->cmp->offsets[j * 2];
+ int yy = y - s->cmp->offsets[j * 2 + 1];
+
+ font->driver->draw (s, j, j + 1, xx, yy, 0);
+ if (s->face->overstrike)
+ font->driver->draw (s, j, j + 1, xx + 1, yy, 0);
+ }
}
}
+#endif /* USE_FONT_BACKEND */
+ else
+ {
+ for (i = 0, j = s->gidx; i < s->nchars; i++, j++)
+ if (s->face)
+ {
+ XDrawString16 (s->display, s->window, s->gc,
+ x + s->cmp->offsets[j * 2],
+ s->ybase - s->cmp->offsets[j * 2 + 1],
+ s->char2b + j, 1);
+ if (s->face->overstrike)
+ XDrawString16 (s->display, s->window, s->gc,
+ x + s->cmp->offsets[j * 2] + 1,
+ s->ybase - s->cmp->offsets[j * 2 + 1],
+ s->char2b + j, 1);
+ }
+ }
}
/* Look for a frame with that top-level widget. Allocate the color
on that frame to get the right gamma correction value. */
- for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
- if (GC_FRAMEP (XCAR (tail))
+ for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
+ if (FRAMEP (XCAR (tail))
&& (f = XFRAME (XCAR (tail)),
(FRAME_X_P (f)
&& f->output_data.nothing != 1
{
int relief_drawn_p = 0;
- /* If S draws into the background of its successor, draw the
- background of the successor first so that S can draw into it.
+ /* If S draws into the background of its successors, draw the
+ background of the successors first so that S can draw into it.
This makes S->next use XDrawString instead of XDrawImageString. */
if (s->next && s->right_overhang && !s->for_overlaps)
{
- xassert (s->next->img == NULL);
- x_set_glyph_string_gc (s->next);
- x_set_glyph_string_clipping (s->next);
- x_draw_glyph_string_background (s->next, 1);
+ int width;
+ struct glyph_string *next;
+
+ for (width = 0, next = s->next; next;
+ width += next->width, next = next->next)
+ if (next->first_glyph->type != IMAGE_GLYPH)
+ {
+ x_set_glyph_string_gc (next);
+ x_set_glyph_string_clipping (next);
+ x_draw_glyph_string_background (next, 1);
+#ifdef USE_FONT_BACKEND
+ next->num_clips = 0;
+#endif /* USE_FONT_BACKEND */
+ }
}
/* Set up S->gc, set clipping and draw S. */
x_set_glyph_string_clipping (s);
relief_drawn_p = 1;
}
+ else if ((s->prev && s->prev->hl != s->hl && s->left_overhang)
+ || (s->next && s->next->hl != s->hl && s->right_overhang))
+ /* We must clip just this glyph. left_overhang part has already
+ drawn when s->prev was drawn, and right_overhang part will be
+ drawn later when s->next is drawn. */
+ x_set_glyph_string_clipping_exactly (s, s);
else
x_set_glyph_string_clipping (s);
int y;
/* Get the underline thickness. Default is 1 pixel. */
+#ifdef USE_FONT_BACKEND
+ if (enable_font_backend)
+ /* In the future, we must use information of font. */
+ h = 1;
+ else
+#endif /* USE_FONT_BACKEND */
if (!XGetFontProperty (s->font, XA_UNDERLINE_THICKNESS, &h))
h = 1;
- y = s->y + s->height - h;
- if (!x_underline_at_descent_line)
- {
- /* Get the underline position. This is the recommended
- vertical offset in pixels from the baseline to the top of
- the underline. This is a signed value according to the
- specs, and its default is
-
- ROUND ((maximum descent) / 2), with
- ROUND(x) = floor (x + 0.5) */
-
- if (x_use_underline_position_properties
- && XGetFontProperty (s->font, XA_UNDERLINE_POSITION, &tem))
- y = s->ybase + (long) tem;
- else if (s->face->font)
- y = s->ybase + (s->face->font->max_bounds.descent + 1) / 2;
- }
+#ifdef USE_FONT_BACKEND
+ if (enable_font_backend)
+ {
+ if (s->face->font)
+ /* In the future, we must use information of font. */
+ y = s->ybase + (s->face->font->max_bounds.descent + 1) / 2;
+ else
+ y = s->y + s->height - h;
+ }
+ else
+#endif
+ {
+ y = s->y + s->height - h;
+ if (!x_underline_at_descent_line)
+ {
+ /* Get the underline position. This is the recommended
+ vertical offset in pixels from the baseline to the top of
+ the underline. This is a signed value according to the
+ specs, and its default is
+
+ ROUND ((maximum descent) / 2), with
+ ROUND(x) = floor (x + 0.5) */
+
+ if (x_use_underline_position_properties
+ && XGetFontProperty (s->font, XA_UNDERLINE_POSITION, &tem))
+ y = s->ybase + (long) tem;
+ else if (s->face->font)
+ y = s->ybase + (s->face->font->max_bounds.descent + 1) / 2;
+ }
+ }
if (s->face->underline_defaulted_p)
XFillRectangle (s->display, s->window, s->gc,
/* Draw relief if not yet drawn. */
if (!relief_drawn_p && s->face->box != FACE_NO_BOX)
x_draw_glyph_string_box (s);
+
+ if (s->prev)
+ {
+ struct glyph_string *prev;
+
+ for (prev = s->prev; prev; prev = prev->prev)
+ if (prev->hl != s->hl
+ && prev->x + prev->width + prev->right_overhang > s->x)
+ {
+ /* As prev was drawn while clipped to its own area, we
+ must draw the right_overhang part using s->hl now. */
+ enum draw_glyphs_face save = prev->hl;
+
+ prev->hl = s->hl;
+ x_set_glyph_string_gc (prev);
+ x_set_glyph_string_clipping_exactly (s, prev);
+ if (prev->first_glyph->type == CHAR_GLYPH)
+ x_draw_glyph_string_foreground (prev);
+ else
+ x_draw_composite_glyph_string_foreground (prev);
+ XSetClipMask (prev->display, prev->gc, None);
+ prev->hl = save;
+#ifdef USE_FONT_BACKEND
+ prev->num_clips = 0;
+#endif /* USE_FONT_BACKEND */
+ }
+ }
+
+ if (s->next)
+ {
+ struct glyph_string *next;
+
+ for (next = s->next; next; next = next->next)
+ if (next->hl != s->hl
+ && next->x - next->left_overhang < s->x + s->width)
+ {
+ /* As next will be drawn while clipped to its own area,
+ we must draw the left_overhang part using s->hl now. */
+ enum draw_glyphs_face save = next->hl;
+
+ next->hl = s->hl;
+ x_set_glyph_string_gc (next);
+ x_set_glyph_string_clipping_exactly (s, next);
+ if (next->first_glyph->type == CHAR_GLYPH)
+ x_draw_glyph_string_foreground (next);
+ else
+ x_draw_composite_glyph_string_foreground (next);
+ XSetClipMask (next->display, next->gc, None);
+ next->hl = save;
+#ifdef USE_FONT_BACKEND
+ next->num_clips = 0;
+#endif /* USE_FONT_BACKEND */
+ }
+ }
}
/* Reset clipping. */
XSetClipMask (s->display, s->gc, None);
+#ifdef USE_FONT_BACKEND
+ s->num_clips = 0;
+#endif /* USE_FONT_BACKEND */
}
/* Shift display to make room for inserted glyphs. */
/* Don't stop displaying the initial startup message
for a switch-frame event we don't need. */
- if (GC_NILP (Vterminal_frame)
- && GC_CONSP (Vframe_list)
- && !GC_NILP (XCDR (Vframe_list)))
+ if (NILP (Vterminal_frame)
+ && CONSP (Vframe_list)
+ && !NILP (XCDR (Vframe_list)))
{
bufp->kind = FOCUS_IN_EVENT;
XSETFRAME (bufp->frame_or_window, frame);
if (dpyinfo->x_focus_frame)
{
dpyinfo->x_highlight_frame
- = ((GC_FRAMEP (FRAME_FOCUS_FRAME (dpyinfo->x_focus_frame)))
+ = ((FRAMEP (FRAME_FOCUS_FRAME (dpyinfo->x_focus_frame)))
? XFRAME (FRAME_FOCUS_FRAME (dpyinfo->x_focus_frame))
: dpyinfo->x_focus_frame);
if (! FRAME_LIVE_P (dpyinfo->x_highlight_frame))
window_id = (Window) xg_get_scroll_id_for_window (display, window_id);
#endif /* USE_GTK && USE_TOOLKIT_SCROLL_BARS */
- for (tail = Vframe_list;
- XGCTYPE (tail) == Lisp_Cons;
- tail = XCDR (tail))
+ for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
{
Lisp_Object frame, bar, condemned;
frame = XCAR (tail);
/* All elements of Vframe_list should be frames. */
- if (! GC_FRAMEP (frame))
+ if (! FRAMEP (frame))
abort ();
if (! FRAME_X_P (XFRAME (frame)))
for (bar = FRAME_SCROLL_BARS (XFRAME (frame));
/* This trick allows us to search both the ordinary and
condemned scroll bar lists with one loop. */
- ! GC_NILP (bar) || (bar = condemned,
+ ! NILP (bar) || (bar = condemned,
condemned = Qnil,
- ! GC_NILP (bar));
+ ! NILP (bar));
bar = XSCROLL_BAR (bar)->next)
if (XSCROLL_BAR (bar)->x_window == window_id &&
FRAME_X_DISPLAY (XFRAME (frame)) == display)
{
Lisp_Object tail;
- for (tail = Vframe_list;
- XGCTYPE (tail) == Lisp_Cons;
- tail = XCDR (tail))
+ for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
{
if (FRAME_X_P (XFRAME (XCAR (tail))))
{
XEvent *event;
struct input_event *emacs_event;
{
- if (! GC_WINDOWP (bar->window))
+ if (! WINDOWP (bar->window))
abort ();
emacs_event->kind = SCROLL_BAR_CLICK_EVENT;
XSETVECTOR (last_mouse_scroll_bar, bar);
/* If we're dragging the bar, display it. */
- if (! GC_NILP (bar->dragging))
+ if (! NILP (bar->dragging))
{
/* Where should the handle be now? */
int new_start = event->xmotion.y - XINT (bar->dragging);
goto done_keysym;
}
- /* Keysyms directly mapped to supported Unicode characters. */
- if ((keysym >= 0x01000000 && keysym <= 0x010033ff)
- || (keysym >= 0x0100e000 && keysym <= 0x0100ffff))
+ /* Keysyms directly mapped to Unicode characters. */
+ if (keysym >= 0x01000000 && keysym <= 0x0110FFFF)
{
- int code = keysym & 0xFFFF, charset_id, c1, c2;
-
- if (code < 0x80)
- {
- inev.ie.kind = ASCII_KEYSTROKE_EVENT;
- inev.ie.code = code;
- }
- else if (code < 0x100)
- {
- if (code < 0xA0)
- charset_id = CHARSET_8_BIT_CONTROL;
- else
- charset_id = charset_latin_iso8859_1;
- inev.ie.kind = MULTIBYTE_CHAR_KEYSTROKE_EVENT;
- inev.ie.code = MAKE_CHAR (charset_id, code, 0);
- }
+ if (keysym < 0x01000080)
+ inev.ie.kind = ASCII_KEYSTROKE_EVENT;
else
- {
- if (code < 0x2500)
- charset_id = charset_mule_unicode_0100_24ff,
- code -= 0x100;
- else if (code < 0xE000)
- charset_id = charset_mule_unicode_2500_33ff,
- code -= 0x2500;
- else
- charset_id = charset_mule_unicode_e000_ffff,
- code -= 0xE000;
- c1 = (code / 96) + 32, c2 = (code % 96) + 32;
- inev.ie.kind = MULTIBYTE_CHAR_KEYSTROKE_EVENT;
- inev.ie.code = MAKE_CHAR (charset_id, c1, c2);
- }
+ inev.ie.kind = MULTIBYTE_CHAR_KEYSTROKE_EVENT;
+ inev.ie.code = keysym & 0xFFFFFF;
goto done_keysym;
}
register int c;
int nchars, len;
- /* The input should be decoded with `coding_system'
- which depends on which X*LookupString function
- we used just above and the locale. */
- setup_coding_system (coding_system, &coding);
- coding.src_multibyte = 0;
- coding.dst_multibyte = 1;
- /* The input is converted to events, thus we can't
- handle composition. Anyway, there's no XIM that
- gives us composition information. */
- coding.composing = COMPOSITION_DISABLED;
-
- if (nbytes > 0)
+ for (i = 0, nchars = 0; i < nbytes; i++)
+ {
+ if (ASCII_BYTE_P (copy_bufptr[i]))
+ nchars++;
+ STORE_KEYSYM_FOR_DEBUG (copy_bufptr[i]);
+ }
+
+ if (nchars < nbytes)
{
/* Decode the input data. */
int require;
unsigned char *p;
- for (i = 0; i < nbytes; i++)
- {
- STORE_KEYSYM_FOR_DEBUG (copy_bufptr[i]);
- }
-
- require = decoding_buffer_size (&coding, nbytes);
- p = (unsigned char *) alloca (require);
+ /* The input should be decoded with `coding_system'
+ which depends on which X*LookupString function
+ we used just above and the locale. */
+ setup_coding_system (coding_system, &coding);
+ coding.src_multibyte = 0;
+ coding.dst_multibyte = 1;
+ /* The input is converted to events, thus we can't
+ handle composition. Anyway, there's no XIM that
+ gives us composition information. */
+ coding.common_flags &= ~CODING_ANNOTATION_MASK;
+
+ require = MAX_MULTIBYTE_LENGTH * nbytes;
+ coding.destination = alloca (require);
+ coding.dst_bytes = require;
coding.mode |= CODING_MODE_LAST_BLOCK;
- /* We explicitly disable composition handling because
- key data should not contain any composition sequence. */
- coding.composing = COMPOSITION_DISABLED;
- decode_coding (&coding, copy_bufptr, p, nbytes, require);
+ decode_coding_c_string (&coding, copy_bufptr, nbytes, Qnil);
nbytes = coding.produced;
nchars = coding.produced_char;
- copy_bufptr = p;
+ copy_bufptr = coding.destination;
+ }
- /* Convert the input data to a sequence of
- character events. */
- for (i = 0; i < nbytes; i += len)
- {
- if (nchars == nbytes)
- c = copy_bufptr[i], len = 1;
- else
- c = STRING_CHAR_AND_LENGTH (copy_bufptr + i,
- nbytes - i, len);
- inev.ie.kind = (SINGLE_BYTE_CHAR_P (c)
- ? ASCII_KEYSTROKE_EVENT
- : MULTIBYTE_CHAR_KEYSTROKE_EVENT);
- inev.ie.code = c;
- kbd_buffer_store_event_hold (&inev.ie, hold_quit);
- }
+ /* Convert the input data to a sequence of
+ character events. */
+ for (i = 0; i < nbytes; i += len)
+ {
+ if (nchars == nbytes)
+ c = copy_bufptr[i], len = 1;
+ else
+ c = STRING_CHAR_AND_LENGTH (copy_bufptr + i,
+ nbytes - i, len);
+ inev.ie.kind = (SINGLE_BYTE_CHAR_P (c)
+ ? ASCII_KEYSTROKE_EVENT
+ : MULTIBYTE_CHAR_KEYSTROKE_EVENT);
+ inev.ie.code = c;
+ kbd_buffer_store_event_hold (&inev.ie, hold_quit);
}
/* Previous code updated count by nchars rather than nbytes,
register char *fontname;
{
struct font_info *fontp
- = FS_LOAD_FONT (f, 0, fontname, -1);
+ = FS_LOAD_FONT (f, fontname);
if (!fontp)
return Qnil;
+ if (FRAME_FONT (f) == (XFontStruct *) (fontp->font))
+ /* This font is already set in frame F. There's nothing more to
+ do. */
+ return build_string (fontp->full_name);
+
FRAME_FONT (f) = (XFontStruct *) (fontp->font);
FRAME_BASELINE_OFFSET (f) = fontp->baseline_offset;
FRAME_FONTSET (f) = -1;
return build_string (fontp->full_name);
}
-/* Give frame F the fontset named FONTSETNAME as its default font, and
- return the full name of that fontset. FONTSETNAME may be a wildcard
- pattern; in that case, we choose some fontset that fits the pattern.
- The return value shows which fontset we chose. */
+/* Give frame F the fontset named FONTSETNAME as its default fontset,
+ and return the full name of that fontset. FONTSETNAME may be a
+ wildcard pattern; in that case, we choose some fontset that fits
+ the pattern. FONTSETNAME may be a font name for ASCII characters;
+ in that case, we create a fontset from that font name.
+
+ The return value shows which fontset we chose.
+ If FONTSETNAME specifies the default fontset, return Qt.
+ If an ASCII font in the specified fontset can't be loaded, return
+ Qnil. */
Lisp_Object
x_new_fontset (f, fontsetname)
struct frame *f;
- char *fontsetname;
+ Lisp_Object fontsetname;
{
- int fontset = fs_query_fontset (build_string (fontsetname), 0);
+ int fontset = fs_query_fontset (fontsetname, 0);
Lisp_Object result;
- if (fontset < 0)
- return Qnil;
-
- if (FRAME_FONTSET (f) == fontset)
+ if (fontset > 0 && f->output_data.x->fontset == fontset)
/* This fontset is already set in frame F. There's nothing more
to do. */
return fontset_name (fontset);
+ else if (fontset == 0)
+ /* The default fontset can't be the default font. */
+ return Qt;
- result = x_new_font (f, (SDATA (fontset_ascii (fontset))));
+ if (fontset > 0)
+ result = x_new_font (f, (SDATA (fontset_ascii (fontset))));
+ else
+ result = x_new_font (f, SDATA (fontsetname));
if (!STRINGP (result))
/* Can't load ASCII font. */
return Qnil;
+ if (fontset < 0)
+ fontset = new_fontset_from_font_name (result);
+
/* Since x_new_font doesn't update any fontset information, do it now. */
FRAME_FONTSET (f) = fontset;
xic_set_xfontset (f, SDATA (fontset_ascii (fontset)));
#endif
- return build_string (fontsetname);
+ return fontset_name (fontset);
}
+#ifdef USE_FONT_BACKEND
+Lisp_Object
+x_new_fontset2 (f, fontset, font_object)
+ struct frame *f;
+ int fontset;
+ Lisp_Object font_object;
+{
+ struct font *font = XSAVE_VALUE (font_object)->pointer;
+
+ if (FRAME_FONT_OBJECT (f) == font)
+ /* This font is already set in frame F. There's nothing more to
+ do. */
+ return fontset_name (fontset);
+
+ BLOCK_INPUT;
+
+ FRAME_FONT_OBJECT (f) = font;
+ FRAME_FONT (f) = font->font.font;
+ FRAME_BASELINE_OFFSET (f) = font->font.baseline_offset;
+ FRAME_FONTSET (f) = fontset;
+
+ FRAME_COLUMN_WIDTH (f) = font->font.average_width;
+ FRAME_SPACE_WIDTH (f) = font->font.space_width;
+ FRAME_LINE_HEIGHT (f) = font->font.height;
+
+ compute_fringe_widths (f, 1);
+
+ /* Compute the scroll bar width in character columns. */
+ if (FRAME_CONFIG_SCROLL_BAR_WIDTH (f) > 0)
+ {
+ int wid = FRAME_COLUMN_WIDTH (f);
+ FRAME_CONFIG_SCROLL_BAR_COLS (f)
+ = (FRAME_CONFIG_SCROLL_BAR_WIDTH (f) + wid - 1) / wid;
+ }
+ else
+ {
+ int wid = FRAME_COLUMN_WIDTH (f);
+ FRAME_CONFIG_SCROLL_BAR_COLS (f) = (14 + wid - 1) / wid;
+ }
+
+ /* Now make the frame display the given font. */
+ if (FRAME_X_WINDOW (f) != 0)
+ {
+ /* Don't change the size of a tip frame; there's no point in
+ doing it because it's done in Fx_show_tip, and it leads to
+ problems because the tip frame has no widget. */
+ if (NILP (tip_frame) || XFRAME (tip_frame) != f)
+ x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
+ }
+
+#ifdef HAVE_X_I18N
+ if (FRAME_XIC (f)
+ && (FRAME_XIC_STYLE (f) & (XIMPreeditPosition | XIMStatusArea)))
+ xic_set_xfontset (f, SDATA (fontset_ascii (fontset)));
+#endif
+
+ UNBLOCK_INPUT;
+
+ return fontset_name (fontset);
+}
+#endif /* USE_FONT_BACKEND */
+
\f
/***********************************************************************
X Input Methods
commands to the X server. */
if (dpyinfo->display)
{
+#ifdef USE_FONT_BACKEND
+ /* We must free faces before destroying windows because some
+ font-driver (e.g. xft) access a window while finishing a
+ face. */
+ if (enable_font_backend
+ && FRAME_FACE_CACHE (f))
+ free_frame_faces (f);
+#endif /* USE_FONT_BACKEND */
+
if (f->output_data.x->icon_desc)
XDestroyWindow (FRAME_X_DISPLAY (f), f->output_data.x->icon_desc);
If SIZE is > 0, it is the size (maximum bounds width) of fonts
to be listed.
- SIZE < 0 means include scalable fonts.
+ SIZE < 0 means include auto scaled fonts.
Frame F null means we have not yet created any frame on X, and
consult the first display in x_display_list. MAXNAMES sets a limit
xassert (font != NULL);
+#ifdef USE_FONT_BACKEND
+ if (enable_font_backend)
+ /* Fixme: Perhaps we should check all cached fonts. */
+ return;
+#endif
for (i = 0; i < dpyinfo->n_fonts; i++)
if (dpyinfo->font_table[i].name
&& font == dpyinfo->font_table[i].font)
bzero (fontp, sizeof (*fontp));
fontp->font = font;
fontp->font_idx = i;
+ fontp->charset = -1; /* fs_load_font sets it. */
fontp->name = (char *) xmalloc (strlen (fontname) + 1);
bcopy (fontname, fontp->name, strlen (fontname) + 1);
the font code-points (0:0x20..0x7F, 1:0xA0..0xFF), or
(0:0x2020..0x7F7F, 1:0xA0A0..0xFFFF, 3:0x20A0..0x7FFF,
2:0xA020..0xFF7F). For the moment, we don't know which charset
- uses this font. So, we set information in fontp->encoding[1]
+ uses this font. So, we set information in fontp->encoding_type
which is never used by any charset. If mapping can't be
decided, set FONT_ENCODING_NOT_DECIDED. */
- fontp->encoding[1]
+ fontp->encoding_type
= (font->max_byte1 == 0
/* 1-byte font */
? (font->min_char_or_byte2 < 0x80
}
+/* Return a char-table whose elements are t if the font FONT_INFO
+ contains a glyph for the corresponding character, and nil if
+ not. */
+
+Lisp_Object
+x_get_font_repertory (f, font_info)
+ FRAME_PTR f;
+ struct font_info *font_info;
+{
+ XFontStruct *font = (XFontStruct *) font_info->font;
+ Lisp_Object table;
+ int min_byte1, max_byte1, min_byte2, max_byte2;
+ int c;
+ struct charset *charset = CHARSET_FROM_ID (font_info->charset);
+ int offset = CHARSET_OFFSET (charset);
+
+ table = Fmake_char_table (Qnil, Qnil);
+
+ min_byte1 = font->min_byte1;
+ max_byte1 = font->max_byte1;
+ min_byte2 = font->min_char_or_byte2;
+ max_byte2 = font->max_char_or_byte2;
+ if (min_byte1 == 0 && max_byte1 == 0)
+ {
+ if (! font->per_char || font->all_chars_exist == True)
+ {
+ if (offset >= 0)
+ char_table_set_range (table, offset + min_byte2,
+ offset + max_byte2, Qt);
+ else
+ for (; min_byte2 <= max_byte2; min_byte2++)
+ {
+ c = DECODE_CHAR (charset, min_byte2);
+ CHAR_TABLE_SET (table, c, Qt);
+ }
+ }
+ else
+ {
+ XCharStruct *pcm = font->per_char;
+ int from = -1;
+ int i;
+
+ for (i = min_byte2; i <= max_byte2; i++, pcm++)
+ {
+ if (pcm->width == 0 && pcm->rbearing == pcm->lbearing)
+ {
+ if (from >= 0)
+ {
+ if (offset >= 0)
+ char_table_set_range (table, offset + from,
+ offset + i - 1, Qt);
+ else
+ for (; from < i; from++)
+ {
+ c = DECODE_CHAR (charset, from);
+ CHAR_TABLE_SET (table, c, Qt);
+ }
+ from = -1;
+ }
+ }
+ else if (from < 0)
+ from = i;
+ }
+ if (from >= 0)
+ {
+ if (offset >= 0)
+ char_table_set_range (table, offset + from, offset + i - 1,
+ Qt);
+ else
+ for (; from < i; from++)
+ {
+ c = DECODE_CHAR (charset, from);
+ CHAR_TABLE_SET (table, c, Qt);
+ }
+ }
+ }
+ }
+ else
+ {
+ if (! font->per_char || font->all_chars_exist == True)
+ {
+ int i, j;
+
+ if (offset >= 0)
+ for (i = min_byte1; i <= max_byte1; i++)
+ char_table_set_range
+ (table, offset + ((i << 8) | min_byte2),
+ offset + ((i << 8) | max_byte2), Qt);
+ else
+ for (i = min_byte1; i <= max_byte1; i++)
+ for (j = min_byte2; j <= max_byte2; j++)
+ {
+ unsigned code = (i << 8) | j;
+ c = DECODE_CHAR (charset, code);
+ CHAR_TABLE_SET (table, c, Qt);
+ }
+ }
+ else
+ {
+ XCharStruct *pcm = font->per_char;
+ int i;
+
+ for (i = min_byte1; i <= max_byte1; i++)
+ {
+ int from = -1;
+ int j;
+
+ for (j = min_byte2; j <= max_byte2; j++, pcm++)
+ {
+ if (pcm->width == 0 && pcm->rbearing == pcm->lbearing)
+ {
+ if (from >= 0)
+ {
+ if (offset >= 0)
+ char_table_set_range
+ (table, offset + ((i << 8) | from),
+ offset + ((i << 8) | (j - 1)), Qt);
+ else
+ {
+ for (; from < j; from++)
+ {
+ unsigned code = (i << 8) | from;
+ c = ENCODE_CHAR (charset, code);
+ CHAR_TABLE_SET (table, c, Qt);
+ }
+ }
+ from = -1;
+ }
+ }
+ else if (from < 0)
+ from = j;
+ }
+ if (from >= 0)
+ {
+ if (offset >= 0)
+ char_table_set_range
+ (table, offset + ((i << 8) | from),
+ offset + ((i << 8) | (j - 1)), Qt);
+ else
+ {
+ for (; from < j; from++)
+ {
+ unsigned code = (i << 8) | from;
+ c = DECODE_CHAR (charset, code);
+ CHAR_TABLE_SET (table, c, Qt);
+ }
+ }
+ }
+ }
+ }
+ }
+
+ return table;
+}
\f
/***********************************************************************
Initialization
xim_close_dpy (dpyinfo);
#endif
+#ifdef USE_FONT_BACKEND
+ if (! enable_font_backend)
+ {
+#endif
/* Free the font names in the font table. */
for (i = 0; i < dpyinfo->n_fonts; i++)
if (dpyinfo->font_table[i].name)
xfree (dpyinfo->font_table->font_encoder);
xfree (dpyinfo->font_table);
}
+#ifdef USE_FONT_BACKEND
+ }
+#endif
+
if (dpyinfo->x_id_name)
xfree (dpyinfo->x_id_name);
if (dpyinfo->color_cells)
return;
BLOCK_INPUT;
+#ifdef USE_FONT_BACKEND
+ if (! enable_font_backend)
+#endif
/* Free the fonts in the font table. */
for (i = 0; i < dpyinfo->n_fonts; i++)
if (dpyinfo->font_table[i].name)
staticpro (&Qvendor_specific_keysyms);
Qvendor_specific_keysyms = intern ("vendor-specific-keysyms");
- staticpro (&Qutf_8);
- Qutf_8 = intern ("utf-8");
staticpro (&Qlatin_1);
Qlatin_1 = intern ("latin-1");
/* Definitions and headers for communication with X protocol.
Copyright (C) 1989, 1993, 1994, 1998, 1999, 2000, 2001, 2002, 2003,
- 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
This file is part of GNU Emacs.
extern struct font_info *x_load_font P_ ((struct frame *, char *, int));
extern struct font_info *x_query_font P_ ((struct frame *, char *));
extern void x_find_ccl_program P_ ((struct font_info *));
+extern Lisp_Object x_get_font_repertory P_ ((struct frame *,
+ struct font_info *));
+
\f
/* Each X frame object points to its own struct x_output object
in the output_data.x field. The x_output structure contains
/* Default ASCII font of this frame. */
XFontStruct *font;
+#ifdef USE_FONT_BACKEND
+ struct font *fontp;
+#endif /* USE_FONT_BACKEND */
+
/* The baseline offset of the default ASCII font. */
int baseline_offset;
#define FRAME_TOOLBAR_HEIGHT(f) ((f)->output_data.x->toolbar_height)
#define FRAME_BASELINE_OFFSET(f) ((f)->output_data.x->baseline_offset)
+#ifdef USE_FONT_BACKEND
+#define FRAME_FONT_OBJECT(f) ((f)->output_data.x->fontp)
+#endif /* USE_FONT_BACKEND */
+
/* This gives the x_display_info structure for the display F is on. */
#define FRAME_X_DISPLAY_INFO(f) ((f)->output_data.x->display_info)